Line data Source code
1 : module cam_budget
2 : !----------------------------------------------------------------------------
3 : !
4 : ! Adds support for energy and mass snapshots and budgets using cam_history api.
5 : !
6 : ! Public functions/subroutines:
7 : !
8 : ! cam_budget_init
9 : ! cam_budget_em_snapshot
10 : ! cam_budget_em_register
11 : ! cam_budget_get_global
12 : ! cam_budget_readnl
13 : ! budget_ind_byname
14 : ! is_cam_budget
15 : !-----------------------------------------------------------------------
16 :
17 : use cam_abortutils, only: endrun
18 : use cam_history, only: addfld, add_default, horiz_only
19 : use cam_history_support, only: max_fieldname_len
20 : use cam_logfile, only: iulog
21 : use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, &
22 : thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx
23 : use shr_kind_mod, only: r8 => shr_kind_r8
24 : use shr_kind_mod, only: cl => shr_kind_cl
25 : use spmd_utils, only: masterproc, masterprocid, mpicom
26 :
27 : implicit none
28 : private
29 : save
30 :
31 : ! Public interfaces
32 : public :: &
33 : cam_budget_init, &! initialize budget variables
34 : cam_budget_em_snapshot, &! define a snapshot and add to history buffer
35 : cam_budget_em_register, &! define a budget and add to history buffer
36 : cam_budget_get_global, &! get global budget from history buffer
37 : cam_budget_readnl, &! read budget namelist setting
38 : is_cam_budget ! return logical if budget_defined
39 :
40 : ! Private
41 : real(r8) :: dstepsize
42 : integer, parameter :: budget_array_max = 500 ! max number of budgets
43 : character*3 :: budget_optype(budget_array_max) = '' ! allows 'dif' or 'sum'
44 : character*3 :: budget_pkgtype(budget_array_max) = '' ! allows 'phy' or 'dyn'
45 :
46 : ! Public data
47 : integer, public, protected :: budget_num = 0 ! current number of defined budgets.
48 : character(cl), public, protected :: budget_name(budget_array_max) = '' ! budget names
49 : character(cl), public, protected :: budget_longname(budget_array_max) = '' ! descriptive name of budget
50 : character(cl), public, protected :: budget_stagename(budget_array_max)= '' ! shortname of both of the 3 char snapshot components
51 : character(cl), public, protected :: budget_stg1name(budget_array_max) = '' ! The 1st of 2 snapshots used to calculate a budget
52 : character(cl), public, protected :: budget_stg2name(budget_array_max) = '' ! The 2nd of 2 snapshots used to calculate a budget
53 :
54 : integer, public, protected :: thermo_budget_histfile_num = 1 ! The history tape number for budget fields
55 : logical, public, protected :: thermo_budget_history = .false. ! Turn budgeting on or off
56 :
57 :
58 : !==============================================================================================
59 : CONTAINS
60 : !==============================================================================================
61 : !
62 : ! Read namelist variables.
63 1536 : subroutine cam_budget_readnl(nlfile)
64 : use dycore, only: dycore_is
65 : use namelist_utils, only: find_group_name
66 : use spmd_utils, only: mpi_character, mpi_logical, mpi_integer, mpi_success
67 : use shr_string_mod, only: shr_string_toUpper
68 : use string_utils, only: int2str
69 :
70 : ! Dummy argument: filepath for file containing namelist input
71 : character(len=*), intent(in) :: nlfile
72 :
73 : ! Local variables
74 : integer :: unitn, ierr
75 : character(len=*), parameter :: subname = 'cam_budget_readnl :: '
76 :
77 : namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num
78 : !-----------------------------------------------------------------------
79 :
80 1536 : if (masterproc) then
81 2 : open(newunit=unitn, file=trim(nlfile), status='old')
82 2 : call find_group_name(unitn, 'thermo_budget_nl', status=ierr)
83 2 : if (ierr == 0) then
84 0 : read(unitn, thermo_budget_nl, iostat=ierr)
85 0 : if (ierr /= 0) then
86 0 : call endrun(subname//'ERROR reading namelist, thermo_budget_nl, errcode = '//int2str(ierr))
87 : end if
88 : end if
89 2 : close(unitn)
90 : end if
91 :
92 : ! Broadcast namelist variables
93 1536 : call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr)
94 1536 : if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history")
95 1536 : call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr)
96 1536 : if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num")
97 :
98 : ! Write out thermo_budget options
99 1536 : if (masterproc) then
100 2 : if (thermo_budget_history) then
101 0 : if (dycore_is('EUL').or.dycore_is('FV').or.dycore_is('FV3')) then
102 0 : call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore')
103 : else
104 0 : write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',&
105 0 : thermo_budget_histfile_num
106 : end if
107 : end if
108 : end if
109 1536 : end subroutine cam_budget_readnl
110 :
111 : !==============================================================================================
112 :
113 1536 : subroutine cam_budget_init()
114 : use time_manager, only: get_step_size
115 :
116 1536 : dstepsize=get_step_size()
117 :
118 1536 : end subroutine cam_budget_init
119 :
120 : !==============================================================================================
121 :
122 0 : subroutine cam_budget_em_snapshot (name, pkgtype, longname)
123 1536 : use dycore, only: dycore_is
124 : use cam_grid_support, only: cam_grid_id
125 :
126 : character(len=*), intent(in) :: &
127 : name ! budget name used as variable name in history file output (8 char max)
128 : character(len=*), intent(in) :: &
129 : pkgtype ! budget type either phy or dyn
130 : character(len=*), intent(in) :: &
131 : longname ! value for long_name attribute in netcdf output (128 char max, defaults to name)
132 :
133 : character (cl) :: errmsg
134 : character (len=max_fieldname_len) :: name_str
135 : character (cl) :: desc_str, units_str
136 : character (cl) :: gridname
137 : integer :: ivars
138 : character(len=*), parameter :: sub='cam_budget_em_snapshot'
139 : logical :: use_cslam ! using cslam transport for mass tracers
140 : !-----------------------------------------------------------------------
141 :
142 0 : if (thermo_budget_history) then
143 : ! FVM grid is only registered when using cslam
144 0 : use_cslam=cam_grid_id('FVM')>0
145 :
146 0 : do ivars=1, thermo_budget_num_vars
147 0 : write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name))
148 0 : write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", &
149 0 : TRIM(ADJUSTL(longname))
150 0 : write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars)))
151 :
152 0 : if (budget_num < budget_array_max) then
153 0 : budget_num = budget_num + 1
154 : else
155 0 : write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter '
156 0 : call endrun(errmsg)
157 : end if
158 : ! set budget name and constants
159 0 : budget_name(budget_num) = trim(name_str)
160 0 : budget_longname(budget_num) = trim(desc_str)
161 :
162 0 : budget_pkgtype(budget_num)=pkgtype
163 0 : budget_stagename(budget_num)= trim(name)
164 :
165 0 : if (pkgtype=='phy') then
166 0 : gridname='physgrid'
167 : else
168 0 : if (dycore_is('SE')) then
169 0 : if (use_cslam .and. thermo_budget_vars_massv(ivars)) then
170 0 : gridname='FVM'
171 : else
172 0 : gridname='GLL'
173 : end if
174 0 : else if (dycore_is('MPAS')) then
175 0 : gridname='mpas_cell'
176 : else
177 0 : write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores'
178 0 : call endrun(errmsg)
179 : end if
180 : end if
181 : call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)), &
182 0 : TRIM(ADJUSTL(desc_str)), gridname=trim(gridname))
183 0 : call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N')
184 : end do
185 : end if
186 0 : end subroutine cam_budget_em_snapshot
187 :
188 : !==============================================================================
189 :
190 0 : subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname)
191 0 : use dycore, only: dycore_is
192 : use cam_grid_support, only: cam_grid_id
193 :
194 : ! Register a budget.
195 :
196 : character(len=*), intent(in) :: &
197 : name,stg1name,stg2name ! budget name used as variable name in history file output (8 char max)
198 :
199 : character(len=*), intent(in) :: &
200 : pkgtype ! budget type either phy or dyn
201 :
202 : character(len=*), intent(in) :: &
203 : optype ! dif (difference) or sum
204 :
205 : character(len=*), intent(in) :: &
206 : longname ! value for long_name attribute in netcdf output (128 char max, defaults to name)
207 :
208 : character(len=*), parameter :: sub='cam_budget_em_register'
209 : character(cl) :: errmsg
210 : character(len=1) :: opchar
211 : character (len=max_fieldname_len) :: name_str
212 : character (cl) :: desc_str, units_str
213 : character (cl) :: gridname
214 : character (cl) :: strstg1, strstg2
215 : integer :: ivars
216 : logical :: use_cslam ! true => use cslam to transport mass variables
217 : !-----------------------------------------------------------------------
218 :
219 0 : if (thermo_budget_history) then
220 : ! the FVM gridname is only defined when use_cslam is true.
221 0 : use_cslam=cam_grid_id('FVM')>0
222 :
223 : ! register history budget variables
224 0 : do ivars=1, thermo_budget_num_vars
225 0 : write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name))
226 0 : write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name))
227 0 : write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name))
228 0 : write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", &
229 0 : TRIM(ADJUSTL(longname))
230 0 : write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars)))
231 :
232 0 : if (budget_num < budget_array_max) then
233 0 : budget_num = budget_num + 1
234 : else
235 0 : write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter '
236 0 : call endrun(errmsg)
237 : end if
238 0 : budget_pkgtype(budget_num)=pkgtype
239 :
240 : ! set budget name and constants
241 0 : budget_name(budget_num) = trim(name_str)
242 0 : budget_longname(budget_num) = trim(desc_str)
243 :
244 0 : if (optype=='dif') then
245 0 : opchar='-'
246 0 : else if (optype=='sum') then
247 0 : opchar='+'
248 : else
249 0 : write(errmsg,*) sub, ': FATAL: unknown operation type, expecting "sum" or "dif":', optype
250 0 : call endrun(errmsg)
251 : end if
252 0 : budget_stg1name(budget_num) = trim(adjustl(strstg1))
253 0 : budget_stg2name(budget_num) = trim(adjustl(strstg2))
254 0 : budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2))
255 0 : budget_optype(budget_num)=optype
256 :
257 0 : if (pkgtype=='phy') then
258 0 : gridname='physgrid'
259 : else
260 0 : if (dycore_is('SE')) then
261 0 : if (use_cslam .and. thermo_budget_vars_massv(ivars)) then
262 0 : gridname='FVM'
263 : else
264 0 : gridname='GLL'
265 : end if
266 0 : else if (dycore_is('MPAS')) then
267 0 : gridname='mpas_cell'
268 : else
269 0 : write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores'
270 0 : call endrun(errmsg)
271 : end if
272 : end if
273 : call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), &
274 0 : gridname=gridname,optype=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2)))
275 0 : call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N')
276 : end do
277 : end if
278 0 : end subroutine cam_budget_em_register
279 :
280 : !==============================================================================
281 :
282 0 : subroutine cam_budget_get_global (name, me_idx, global)
283 :
284 0 : use cam_history, only: get_field_properties
285 : use cam_history_support, only: active_entry,ptapes
286 : use cam_thermo, only: thermo_budget_vars_massv
287 :
288 : ! Get the global integral of a budget. Endrun will be called
289 : ! when name is not found.
290 : !-----------------------------Arguments---------------------------------
291 : character(len=*), intent(in) :: name ! budget name
292 : integer, intent(in) :: me_idx ! mass energy variable index
293 : real(r8), intent(out) :: global ! global integral of the budget field
294 :
295 : !---------------------------Local workspace-----------------------------
296 0 : type (active_entry), pointer :: tape(:) ! history tapes
297 : character (len=max_fieldname_len) :: name_str
298 : character(cl) :: errmsg
299 : integer :: b_ind ! budget index
300 : integer :: h_ind(ptapes) ! hentry index
301 : integer :: m_ind ! masterlist index
302 : integer :: idx,pidx,midx,uidx ! substring index for sum dif char
303 : integer :: m ! budget index
304 : logical :: found ! true if global integral found
305 :
306 : character(len=*), parameter :: sub='cam_budget_get_global'
307 : !-----------------------------------------------------------------------
308 : ! Initialize tape pointer here to avoid initialization only on first invocation
309 0 : nullify(tape)
310 :
311 0 : name_str=''
312 0 : write(name_str,*) TRIM(ADJUSTL(name))
313 :
314 0 : midx=index(name_str, '-')
315 0 : pidx=index(name_str, '+')
316 0 : idx=midx+pidx
317 :
318 : ! check for budget using stagename short format (stg1//op//stg2) where stg1 is name without thermo string appended
319 0 : if (idx /= 0 .and. (midx==0 .or. pidx==0)) then
320 0 : write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:idx)))// &
321 0 : TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(name_str(idx+1:)))
322 : end if
323 :
324 0 : uidx=index(name_str, '_')
325 0 : if (uidx == 0) then
326 : !This is a stage name need to append the type of thermo variable using input index
327 0 : write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:)))
328 : end if
329 :
330 0 : b_ind=budget_ind_byname(trim(adjustl(name_str)))
331 :
332 0 : if (b_ind < 0) call endrun(sub//': FATAL field name '//name//' not found'//' looked for '//trim(adjustl(name_str)))
333 :
334 0 : write(name_str,*) TRIM(ADJUSTL(budget_name(b_ind)))
335 :
336 : ! Find budget name in list and return global value
337 0 : call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=m_ind, f_out=h_ind)
338 :
339 0 : if (found.and.h_ind(thermo_budget_histfile_num)>0) then
340 0 : call tape(thermo_budget_histfile_num)%hlist(h_ind(thermo_budget_histfile_num))%get_global(global)
341 0 : if (.not. thermo_budget_vars_massv(me_idx)) &
342 0 : global=global/dstepsize
343 : else
344 0 : write(errmsg,*) sub, ': FATAL: name not found: ', trim(name)
345 0 : call endrun(errmsg)
346 : end if
347 :
348 : CONTAINS
349 0 : pure function budget_ind_byname (name)
350 : !
351 : ! Get the index of a budget. Ret -1 for not found
352 : !-----------------------------Arguments---------------------------------
353 : character(len=*), intent(in) :: name ! budget name
354 :
355 : !---------------------------Local workspace-----------------------------
356 : integer :: budget_ind_byname ! function return
357 : integer :: m ! budget index
358 : !-----------------------------------------------------------------------
359 : ! Find budget name in list
360 0 : budget_ind_byname = -1
361 0 : do m = 1, budget_num
362 0 : if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. &
363 0 : trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then
364 0 : budget_ind_byname = m
365 0 : return
366 : end if
367 : end do
368 0 : end function budget_ind_byname
369 : end subroutine cam_budget_get_global
370 : !==============================================================================
371 :
372 0 : pure function is_cam_budget(name)
373 :
374 : ! Get the index of a budget.
375 :
376 : !-----------------------------Arguments---------------------------------
377 : character(len=*), intent(in) :: name ! budget name
378 :
379 : !---------------------------Local workspace-----------------------------
380 : logical :: is_cam_budget ! function return
381 : integer :: m ! budget index
382 : !-----------------------------------------------------------------------
383 :
384 : ! Find budget name in list of defined budgets
385 :
386 0 : is_cam_budget = .false.
387 0 : do m = 1, budget_num
388 0 : if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. &
389 0 : trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then
390 0 : is_cam_budget = .true.
391 0 : return
392 : end if
393 : end do
394 0 : end function is_cam_budget
395 :
396 : !===========================================================================
397 :
398 : end module cam_budget
|
