Newer
Older
!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!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
! P. Wautelet 17/08/2020: treat LES budgets correctly
! P. Wautelet 05/03/2021: measure cpu_time for budgets
WAUTELET Philippe
committed
! J.Escobar 06/10/2021: for bit reproductiblity use MPPDB_CHECK if LCHECK=T
!-----------------------------------------------------------------
!#################
module mode_budget
!#################
use modd_budget, only: cbutype, nbutime, tbudgetdata, xtime_bu, xtime_bu_process
use modd_les_budget, only: xtime_les_bu, xtime_les_bu_process
WAUTELET Philippe
committed
use mode_msg
use modi_cart_compress, only: Cart_compress
use modi_mask_compress, only: Mask_compress
use modi_second_mnh, only: Second_mnh
implicit none
private
RODIER Quentin
committed
public :: Budget_store_init
public :: Budget_store_end
public :: Budget_store_add
real :: ztime1, ztime2
contains
subroutine Budget_store_init( tpbudget, hsource, pvars )
WAUTELET Philippe
committed
use modd_conf, only: lcheck
use modd_les, only: lles_call
use mode_mppdb
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
WAUTELET Philippe
committed
character(len=:), allocatable :: hbudget
integer :: iid ! Reference number of the current source term
WAUTELET Philippe
committed
hbudget = trim( tpbudget%cname )//':'//trim( hsource )
call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', hbudget )
if ( lcheck ) call Mppdb_check3d( pvars, 'BUD_INI::' // hbudget, precision )
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
if ( lles_call ) then
call Second_mnh( ztime1 )
if ( allocated( tpbudget%xtmplesstore ) ) then
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'xtmplesstore already allocated' )
else
allocate( tpbudget%xtmplesstore( Size( pvars, 1 ), Size( pvars, 2 ), Size ( pvars, 3 ) ) )
end if
tpbudget%xtmplesstore(:, :, :) = pvars(:, :, :)
tpbudget%clessource = hsource
call Second_mnh( ztime2 )
xtime_les_bu = xtime_les_bu + ztime2 - ztime1
xtime_les_bu_process = xtime_les_bu_process + ztime2 - ztime1
end if
! Nothing else to do if budgets are not enabled
if ( .not. tpbudget%lenabled ) return
call Second_mnh( ztime1 )
call Budget_source_id_find( tpbudget, hsource, iid )
if ( tpbudget%ntmpstoresource /= 0 ) then
cmnhmsg(1) = 'ntmpstoresource already set (previous call to '//'Budget_store_end missing?)'
cmnhmsg(2) = 'Set for: ' // Trim( tpbudget%cname ) // ':' // Trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname )
cmnhmsg(3) = 'Working on: ' // Trim( tpbudget%cname ) // ':' // Trim( hsource )
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init' )
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
call Second_mnh( ztime2 )
xtime_bu = xtime_bu + ztime2 - ztime1
xtime_bu_process = xtime_bu_process + ztime2 - ztime1
end subroutine Budget_store_init
subroutine Budget_store_end( tpbudget, hsource, pvars )
WAUTELET Philippe
committed
use modd_conf, only: lcheck
use modd_les, only: lles_call
WAUTELET Philippe
committed
use mode_mppdb
use modi_les_budget, only: Les_budget
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
WAUTELET Philippe
committed
character(len=:), allocatable :: hbudget
integer :: iid ! Reference number of the current source term
integer :: igroup ! Number of the group where to store the source term
real, dimension(:,:,:), allocatable :: zvars_add
WAUTELET Philippe
committed
hbudget = trim( tpbudget%cname )//':'//trim( hsource )
call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', hbudget )
if ( lcheck ) call Mppdb_check3d( pvars, 'BUD_INI::' // hbudget, precision )
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
if ( lles_call ) then
if ( hsource /= tpbudget%clessource ) &
call Print_msg( NVERB_FATAL, 'BUD', 'Budget_store_end', 'hsource not the same as in Budget_store_init (' &
// Trim( hsource ) // ' / ' // Trim( tpbudget%clessource ) // ')' )
tpbudget%clessource = 'reset'
if ( allocated( tpbudget%xtmplesstore ) ) then
! Do the call to Les_budget with oadd=.true.
! This is necessary when the call to Budget_store_init was done with pvars not strictly
! equal to the source term
Allocate( zvars_add( Size( pvars, 1 ), Size( pvars, 2 ), Size ( pvars, 3 ) ) )
zvars_add(:, :, :) = pvars(:, :, :) - tpbudget%xtmplesstore(:, :, :)
call Les_budget( zvars_add, tpbudget%nid, hsource, oadd = .true. )
Deallocate( zvars_add )
Deallocate( tpbudget%xtmplesstore )
else
call Les_budget( pvars, tpbudget%nid, hsource, oadd = .false. )
end if
end if
! Nothing to do if budgets are not enabled
if ( .not. tpbudget%lenabled ) return
call Second_mnh( ztime1 )
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
call Second_mnh( ztime2 )
xtime_bu = xtime_bu + ztime2 - ztime1
xtime_bu_process = xtime_bu_process + ztime2 - ztime1
end subroutine Budget_store_end
subroutine Budget_store_add( tpbudget, hsource, pvars )
use modd_les, only: lles_call
use modi_les_budget, only: Les_budget
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 ) )
if ( tpbudget%ntmpstoresource /= 0 ) &
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'inside a Budget_store_init/Budget_store_end zone' )
if ( lles_call ) call Les_budget( pvars, tpbudget%nid, hsource, oadd = .true. )
! Nothing to do if budgets are not enabled
if ( .not. tpbudget%lenabled ) return
call Second_mnh( ztime1 )
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
call Second_mnh( ztime2 )
xtime_bu = xtime_bu + ztime2 - ztime1
xtime_bu_process = xtime_bu_process + ztime2 - ztime1
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
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
!Search also in the non-available source term list
do ji = tpbudget%nsources + 1, tpbudget%nsourcesmax
if ( trim( hsource ) == trim( tpbudget%tsources(ji)%cmnhname ) ) then
iid = ji
exit
end if
end do
if ( iid == 0 ) then
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource )//' not found' )
else
cmnhmsg(1) = Trim( tpbudget%cname ) // ':' // Trim( hsource ) // ' found'
cmnhmsg(2) = 'in non-available source term list.'
cmnhmsg(3) = 'Check availability condition in Ini_budget.'
call Print_msg( NVERB_ERROR, 'BUD', 'Budget_source_id_find' )
end if
end if
kid = iid
end subroutine Budget_source_id_find
end module mode_budget