From 8a1ce168eb6326bc589b7b2958639eb4310e435b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 11 Feb 2020 15:16:52 +0100
Subject: [PATCH] Philippe 11/02/2020: budget: add Budget_store_add subroutine
---
src/MNH/budget.f90 | 86 +++++++++++++++++++++++++++++++---------------
1 file changed, 59 insertions(+), 27 deletions(-)
diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90
index 334f1ce3c..22d11c624 100644
--- a/src/MNH/budget.f90
+++ b/src/MNH/budget.f90
@@ -24,6 +24,7 @@ private
public :: Budget_store_init
public :: Budget_store_end
+public :: Budget_store_add
contains
@@ -63,9 +64,9 @@ subroutine Budget_store_init( tpbudget, hsource, pvars )
!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(:, :, : ) )
+ tpbudget%xtmpstore(:, :, :) = Cart_compress( pvars(:, :, :) )
else if ( cbutype == 'MASK' ) then
- tpbudget%xtmpstore(:, nbutime, : ) = Mask_compress( pvars(:, :, : ) )
+ tpbudget%xtmpstore(:, nbutime, :) = Mask_compress( pvars(:, :, :) )
else
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'unknown cbutype: '//trim( cbutype ) )
end if
@@ -75,7 +76,6 @@ 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
@@ -87,8 +87,8 @@ use modd_budget,only:nbusil,NBUSJL,NBUKL
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%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 ) )
@@ -105,39 +105,39 @@ use modd_budget,only:nbusil,NBUSJL,NBUKL
!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(:, :, : ) )
+ 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(:, :, : ) )
+ 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(:, :, : )
+ 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(:, :, : )
+ 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(:, :, : ) )
+ 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(:, :, : ) )
+ 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, : )
+ 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, : )
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = tpbudget%tgroups(igroup)%xdata(:, nbutime, :) &
+ + Mask_compress( pvars(:, :, :) ) &
+ - tpbudget%xtmpstore(:, nbutime, :)
end if
end if
else
@@ -151,6 +151,38 @@ use modd_budget,only:nbusil,NBUSJL,NBUKL
end subroutine Budget_store_end
+subroutine Budget_store_add( 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
+ integer :: igroup ! Number of the group where to store the source term
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_add', trim( tpbudget%cname )//':'//trim( hsource ) )
+
+ call Budget_source_id_find( tpbudget, hsource, iid )
+
+ if ( tpbudget%tsources(iid)%lenabled ) then
+ if ( tpbudget%tsources(iid)%loverwrite ) &
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'loverwrite=.true. is not allowed' )
+
+ !Store data into the budget array
+ igroup = tpbudget%tsources(iid)%ngroup
+ if ( cbutype == 'CART' ) then
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = tpbudget%tgroups(igroup)%xdata(:, :, :) &
+ + Cart_compress( pvars(:, :, :) )
+ else if ( cbutype == 'MASK' ) then
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = tpbudget%tgroups(igroup)%xdata(:, nbutime, :) &
+ + Mask_compress( pvars(:, :, :) )
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'unknown cbutype: '//trim( cbutype ) )
+ end if
+ end if
+
+end subroutine Budget_store_add
+
+
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
--
GitLab