From 1238e1e968291c77da8c7c6884a834f978975325 Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Tue, 28 Jan 2020 14:37:45 +0100 Subject: [PATCH] Philippe 28/01/2020: budgets: new subroutines: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget --- src/MNH/budget.f90 | 178 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90 index fcb659224..77c35cd61 100644 --- a/src/MNH/budget.f90 +++ b/src/MNH/budget.f90 @@ -3,6 +3,184 @@ !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- +! Modifications +! P. Wautelet 28/01/2020: new subroutines: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget +!----------------------------------------------------------------- + +!################# +module mode_budget +!################# + +use modd_budget, only: cbutype, nbutime, tbudgetdata + +use modi_cart_compress, only: Cart_compress +use modi_mask_compress, only: Mask_compress + +use mode_msg + +implicit none + +private + +public :: Budget_store_init +public :: Budget_store_end + + +contains + +subroutine Budget_store_init( tpbudget, hsource, pvars ) + type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure + character(len=*), intent(in) :: hsource ! Name of the source term + real, dimension(:,:,:), intent(in) :: pvars ! Current value to be stored + + integer :: iid ! Reference number of the current source term + + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', trim( tpbudget%cname )//':'//trim( hsource ) ) + + call Budget_source_id_find( tpbudget, hsource, iid ) + + if ( tpbudget%ntmpstoresource /= 0 ) then + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'ntmpstoresource already set (previous call to ' & + //'Budget_store_end missing?) for '//trim( tpbudget%cname )//':'//trim( hsource ) ) + end if + + if ( tpbudget%tsources(iid)%ldonotinit ) then + ! If ldonotinit is set, this subroutine should not be called + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'should not be called for ' & + //trim( tpbudget%cname )//':'//trim( hsource ) ) + return + end if + + if ( tpbudget%tsources(iid)%lenabled ) then + if ( tpbudget%ntmpstoresource /= 0 ) then + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'xtmpstore already used by ' & + //trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname ) ) + return + end if + + tpbudget%ntmpstoresource = iid + + !Store data into the budget temporary array + !This value will be subtracted from the next one (in Budget_store_end) to get the evolution of the array between the 2 calls + if ( cbutype == 'CART' ) then + tpbudget%xtmpstore(:, :, : ) = Cart_compress( pvars(:, :, : ) ) + else if ( cbutype == 'MASK' ) then + tpbudget%xtmpstore(:, nbutime, : ) = Mask_compress( pvars(:, :, : ) ) + else + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'unknown cbutype: '//trim( cbutype ) ) + end if + end if + +end subroutine Budget_store_init + + +subroutine Budget_store_end( tpbudget, hsource, pvars ) +use modd_budget,only:nbusil,NBUSJL,NBUKL + type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure + character(len=*), intent(in) :: hsource ! Name of the source term + real, dimension(:,:,:), intent(in) :: pvars ! Current value to be stored + + integer :: iid ! Reference number of the current source term + integer :: igroup ! Number of the group where to store the source term + + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', trim( tpbudget%cname )//':'//trim( hsource ) ) + + call Budget_source_id_find( tpbudget, hsource, iid ) + + if ( tpbudget%tsources(iid )%lenabled ) then + if ( iid /= tpbudget%ntmpstoresource .and. .not.tpbudget%tsources(iid )%ldonotinit ) then + if ( tpbudget%ntmpstoresource == 0 ) then + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'ntmpstoresource not set for ' & + //trim( tpbudget%tsources(iid)%cmnhname ) ) + else + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'xtmpstore used by an other source: ' & + //trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname )//', expected: ' & + //trim( tpbudget%tsources(iid)%cmnhname ) ) + end if + end if + + !Store data into the budget array + !The values are computed by the difference between the values stored in the temporary array (filled in Budget_store_init) + !and the current values added to the already stored ones. + !Except if ldonotinit is true. In that case, overwrite the array. + igroup = tpbudget%tsources(iid)%ngroup + if ( cbutype == 'CART' ) then + if ( tpbudget%tsources(iid )%ldonotinit ) then + if ( tpbudget%tsources(iid )%loverwrite ) then + tpbudget%tgroups(igroup )%xdata(:, :, : ) = Cart_compress( pvars(:, :, : ) ) + else + tpbudget%tgroups(igroup )%xdata(:, :, : ) = tpbudget%tgroups(igroup )%xdata(:, :, : ) & + + Cart_compress( pvars(:, :, : ) ) + end if + else + if ( tpbudget%tsources(iid )%loverwrite ) then + tpbudget%tgroups(igroup )%xdata(:, :, : ) = Cart_compress( pvars(:, :, : ) ) & + - tpbudget%xtmpstore(:, :, : ) + else + tpbudget%tgroups(igroup )%xdata(:, :, : ) = tpbudget%tgroups(igroup )%xdata(:, :, : ) & + + Cart_compress( pvars(:, :, : ) ) & + - tpbudget%xtmpstore(:, :, : ) + end if + end if + else if ( cbutype == 'MASK' ) then + if ( tpbudget%tsources(iid )%ldonotinit ) then + if ( tpbudget%tsources(iid )%loverwrite ) then + tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) = Mask_compress( pvars(:, :, : ) ) + else + tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) = tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) & + + Mask_compress( pvars(:, :, : ) ) + end if + else + if ( tpbudget%tsources(iid )%loverwrite ) then + tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) = Mask_compress( pvars(:, :, : ) ) & + - tpbudget%xtmpstore(:, nbutime, : ) + else + tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) = tpbudget%tgroups(igroup )%xdata(:, nbutime, : ) & + + Mask_compress( pvars(:, :, : ) ) & + - tpbudget%xtmpstore(:, nbutime, : ) + end if + end if + else + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'unknown cbutype: '//trim( cbutype ) ) + end if + + ! Release the budget temporary array + tpbudget%ntmpstoresource = 0 + end if + +end subroutine Budget_store_end + + +subroutine Budget_source_id_find( tpbudget, hsource, kid ) + type(tbudgetdata), intent(in) :: tpbudget ! Budget datastructure + character(len=*), intent(in) :: hsource ! Name of the source term + integer, intent(out) :: kid ! Reference number of the current source term + + integer :: iid + integer :: ji + + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource ) ) + + iid = 0 + do ji = 1, tpbudget%nsources + if ( trim( hsource ) == trim( tpbudget%tsources(ji)%cmnhname ) ) then + iid = ji + exit + end if + end do + + if ( iid > 0 ) then + call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource )//' found' ) + else + call Print_msg( NVERB_ERROR, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource )//' not found' ) + end if + + kid = iid +end subroutine Budget_source_id_find + +end module mode_budget + + !################## MODULE MODI_BUDGET !################## -- GitLab