Line data Source code
1 : !-------------------------------------------------------------------
2 : ! manages reading and interpolation of offline tracer fields
3 : ! Created by: Francis Vitt -- 2 May 2006
4 : !-------------------------------------------------------------------
5 : module tracer_cnst
6 :
7 : use shr_kind_mod, only : r8 => shr_kind_r8
8 : use cam_abortutils, only : endrun
9 : use spmd_utils, only : masterproc
10 : use tracer_data, only : trfld,trfile,MAXTRCRS
11 : use cam_logfile, only : iulog
12 :
13 : implicit none
14 :
15 : private ! all unless made public
16 : save
17 :
18 : public :: tracer_cnst_init
19 : public :: num_tracer_cnst
20 : public :: tracer_cnst_flds
21 : public :: tracer_cnst_adv
22 : public :: get_cnst_data
23 : public :: get_cnst_data_ptr
24 : public :: write_tracer_cnst_restart
25 : public :: read_tracer_cnst_restart
26 : public :: tracer_cnst_defaultopts
27 : public :: tracer_cnst_setopts
28 : public :: init_tracer_cnst_restart
29 :
30 : type(trfld), pointer :: fields(:) => null()
31 : type(trfile) :: file
32 :
33 : integer :: num_tracer_cnst
34 : character(len=16), pointer :: tracer_cnst_flds(:) => null()
35 : real(r8), allocatable, target, dimension(:,:,:,:) :: data_q ! constituent mass mixing ratios
36 :
37 : character(len=64) :: specifier(MAXTRCRS) = ''
38 : character(len=256) :: filename = 'tracer_cnst_file'
39 : character(len=256) :: filelist = ''
40 : character(len=256) :: datapath = ''
41 : character(len=32) :: data_type = 'SERIAL'
42 : logical :: rmv_file = .false.
43 : integer :: cycle_yr = 0
44 : integer :: fixed_ymd = 0
45 : integer :: fixed_tod = 0
46 :
47 : contains
48 :
49 : !-------------------------------------------------------------------
50 : !-------------------------------------------------------------------
51 0 : subroutine tracer_cnst_init()
52 :
53 : use mo_chem_utls,only : get_inv_ndx
54 : use tracer_data, only : trcdata_init
55 : use cam_history, only : addfld
56 : use error_messages, only: handle_err
57 : use ppgrid, only: pcols, pver, begchunk, endchunk
58 : use physics_buffer, only : physics_buffer_desc
59 :
60 : implicit none
61 :
62 : integer :: i ,ndx, istat
63 :
64 0 : allocate(file%in_pbuf(size(specifier)))
65 0 : file%in_pbuf(:) = .false.
66 : call trcdata_init( specifier, filename, filelist, datapath, fields, file, &
67 0 : rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type)
68 :
69 0 : num_tracer_cnst = 0
70 0 : if (associated(fields)) num_tracer_cnst = size( fields )
71 :
72 0 : if( num_tracer_cnst < 1 ) then
73 0 : if ( masterproc ) then
74 0 : write(iulog,*) 'There are no offline invariant species'
75 0 : write(iulog,*) ' '
76 : endif
77 : return
78 : end if
79 :
80 0 : allocate( tracer_cnst_flds(num_tracer_cnst), stat=istat)
81 0 : call handle_err(istat, 'tracer_cnst_init: ERROR allocating tracer_cnst_flds')
82 :
83 :
84 0 : do i = 1, num_tracer_cnst
85 :
86 0 : ndx = get_inv_ndx( fields(i)%fldnam )
87 :
88 0 : if (ndx < 1) then
89 0 : write(iulog,*) fields(i)%fldnam//' is not an invariant'
90 0 : call endrun('tracer_cnst_init')
91 : endif
92 :
93 0 : tracer_cnst_flds(i) = fields(i)%fldnam
94 :
95 0 : call addfld(trim(fields(i)%fldnam), (/ 'lev' /), &
96 0 : 'I','mol/mol', 'prescribed tracer constituent' )
97 : enddo
98 :
99 0 : allocate(data_q(pcols,pver,num_tracer_cnst,begchunk:endchunk), stat=istat)
100 0 : call handle_err(istat, 'tracer_cnst_init: ERROR allocating data_q')
101 :
102 0 : end subroutine tracer_cnst_init
103 :
104 : !-------------------------------------------------------------------
105 : !-------------------------------------------------------------------
106 0 : subroutine tracer_cnst_setopts( &
107 : tracer_cnst_file_in, &
108 : tracer_cnst_filelist_in, &
109 : tracer_cnst_datapath_in, &
110 : tracer_cnst_type_in, &
111 0 : tracer_cnst_specifier_in, &
112 : tracer_cnst_rmfile_in, &
113 : tracer_cnst_cycle_yr_in, &
114 : tracer_cnst_fixed_ymd_in, &
115 : tracer_cnst_fixed_tod_in &
116 : )
117 :
118 : implicit none
119 :
120 : character(len=*), intent(in), optional :: tracer_cnst_file_in
121 : character(len=*), intent(in), optional :: tracer_cnst_filelist_in
122 : character(len=*), intent(in), optional :: tracer_cnst_datapath_in
123 : character(len=*), intent(in), optional :: tracer_cnst_type_in
124 : character(len=*), intent(in), optional :: tracer_cnst_specifier_in(:)
125 : logical, intent(in), optional :: tracer_cnst_rmfile_in
126 : integer, intent(in), optional :: tracer_cnst_cycle_yr_in
127 : integer, intent(in), optional :: tracer_cnst_fixed_ymd_in
128 : integer, intent(in), optional :: tracer_cnst_fixed_tod_in
129 :
130 0 : if ( present(tracer_cnst_file_in) ) then
131 0 : filename = tracer_cnst_file_in
132 : endif
133 0 : if ( present(tracer_cnst_filelist_in) ) then
134 0 : filelist = tracer_cnst_filelist_in
135 : endif
136 0 : if ( present(tracer_cnst_datapath_in) ) then
137 0 : datapath = tracer_cnst_datapath_in
138 : endif
139 0 : if ( present(tracer_cnst_type_in) ) then
140 0 : data_type = tracer_cnst_type_in
141 : endif
142 0 : if ( present(tracer_cnst_specifier_in) ) then
143 0 : specifier = tracer_cnst_specifier_in
144 : endif
145 0 : if ( present(tracer_cnst_rmfile_in) ) then
146 0 : rmv_file = tracer_cnst_rmfile_in
147 : endif
148 0 : if ( present(tracer_cnst_cycle_yr_in) ) then
149 0 : cycle_yr = tracer_cnst_cycle_yr_in
150 : endif
151 0 : if ( present(tracer_cnst_fixed_ymd_in) ) then
152 0 : fixed_ymd = tracer_cnst_fixed_ymd_in
153 : endif
154 0 : if ( present(tracer_cnst_fixed_tod_in) ) then
155 0 : fixed_tod = tracer_cnst_fixed_tod_in
156 : endif
157 :
158 0 : endsubroutine tracer_cnst_setopts
159 :
160 : !-------------------------------------------------------------------
161 : !-------------------------------------------------------------------
162 0 : subroutine tracer_cnst_defaultopts( &
163 : tracer_cnst_file_out, &
164 : tracer_cnst_filelist_out, &
165 : tracer_cnst_datapath_out, &
166 : tracer_cnst_type_out, &
167 0 : tracer_cnst_specifier_out,&
168 : tracer_cnst_rmfile_out, &
169 : tracer_cnst_cycle_yr_out, &
170 : tracer_cnst_fixed_ymd_out,&
171 : tracer_cnst_fixed_tod_out &
172 : )
173 :
174 : implicit none
175 :
176 : character(len=*), intent(out), optional :: tracer_cnst_file_out
177 : character(len=*), intent(out), optional :: tracer_cnst_filelist_out
178 : character(len=*), intent(out), optional :: tracer_cnst_datapath_out
179 : character(len=*), intent(out), optional :: tracer_cnst_type_out
180 : character(len=*), intent(out), optional :: tracer_cnst_specifier_out(:)
181 : logical, intent(out), optional :: tracer_cnst_rmfile_out
182 : integer, intent(out), optional :: tracer_cnst_cycle_yr_out
183 : integer, intent(out), optional :: tracer_cnst_fixed_ymd_out
184 : integer, intent(out), optional :: tracer_cnst_fixed_tod_out
185 :
186 0 : if ( present(tracer_cnst_file_out) ) then
187 0 : tracer_cnst_file_out = filename
188 : endif
189 0 : if ( present(tracer_cnst_filelist_out) ) then
190 0 : tracer_cnst_filelist_out = filelist
191 : endif
192 0 : if ( present(tracer_cnst_datapath_out) ) then
193 0 : tracer_cnst_datapath_out = datapath
194 : endif
195 0 : if ( present(tracer_cnst_type_out) ) then
196 0 : tracer_cnst_type_out = data_type
197 : endif
198 0 : if ( present(tracer_cnst_specifier_out) ) then
199 0 : tracer_cnst_specifier_out = specifier
200 : endif
201 0 : if ( present(tracer_cnst_rmfile_out) ) then
202 0 : tracer_cnst_rmfile_out = rmv_file
203 : endif
204 0 : if ( present(tracer_cnst_cycle_yr_out) ) then
205 0 : tracer_cnst_cycle_yr_out = cycle_yr
206 : endif
207 0 : if ( present(tracer_cnst_fixed_ymd_out) ) then
208 0 : tracer_cnst_fixed_ymd_out = fixed_ymd
209 : endif
210 0 : if ( present(tracer_cnst_fixed_tod_out) ) then
211 0 : tracer_cnst_fixed_tod_out = fixed_tod
212 : endif
213 :
214 0 : endsubroutine tracer_cnst_defaultopts
215 :
216 : !-------------------------------------------------------------------
217 : !-------------------------------------------------------------------
218 0 : subroutine tracer_cnst_adv( pbuf2d, state )
219 :
220 : use physics_buffer, only : physics_buffer_desc
221 : use tracer_data, only : advance_trcdata
222 : use physics_types,only : physics_state
223 : use ppgrid, only : begchunk, endchunk
224 : use ppgrid, only : pcols, pver
225 : use string_utils, only : to_lower, GLC
226 : use chem_mods, only : fix_mass
227 : use mo_chem_utls, only : get_inv_ndx
228 : use cam_history, only : outfld
229 : use physconst, only: mwdry ! molecular weight dry air ~ kg/kmole
230 : use physconst, only: boltz
231 :
232 : implicit none
233 :
234 : type(physics_state), intent(in):: state(begchunk:endchunk)
235 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
236 :
237 : integer :: i,ind,c,ncol
238 : real(r8) :: to_vmr(pcols,pver)
239 :
240 0 : if( num_tracer_cnst < 1 ) return
241 :
242 0 : call advance_trcdata( fields, file, state, pbuf2d )
243 :
244 : ! copy prescribed tracer fields into state variable with the correct units
245 :
246 0 : do i = 1,num_tracer_cnst
247 0 : ind = get_inv_ndx( tracer_cnst_flds(i) )
248 0 : do c = begchunk,endchunk
249 0 : ncol = state(c)%ncol
250 :
251 0 : select case ( to_lower(trim(fields(i)%units(:GLC(fields(i)%units)))) )
252 : case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3")
253 0 : to_vmr(:ncol,:) = (1.e6_r8*boltz*state(c)%t(:ncol,:))/(state(c)%pmiddry(:ncol,:))
254 : case ('kg/kg','mmr')
255 0 : to_vmr(:ncol,:) = mwdry/fix_mass(ind)
256 : case ('mol/mol','mole/mole','vmr')
257 0 : to_vmr(:ncol,:) = 1._r8
258 : case default
259 0 : write(iulog,*) 'tracer_cnst_adv: units = ',trim(fields(i)%units) ,' are not recognized'
260 0 : call endrun('tracer_cnst_adv: units are not recognized')
261 : end select
262 :
263 0 : fields(i)%data(:ncol,:,c) = to_vmr(:ncol,:) * fields(i)%data(:ncol,:,c) ! vmr
264 0 : call outfld( trim(tracer_cnst_flds(i)), fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk )
265 :
266 : enddo
267 : enddo
268 :
269 0 : end subroutine tracer_cnst_adv
270 :
271 : !-------------------------------------------------------------------
272 : !-------------------------------------------------------------------
273 0 : subroutine get_cnst_data( field_name, data, ncol, lchnk, pbuf )
274 :
275 0 : use tracer_data, only : get_fld_data
276 : use physics_buffer, only : physics_buffer_desc
277 :
278 : implicit none
279 :
280 : character(len=*), intent(in) :: field_name
281 : real(r8), intent(out) :: data(:,:)
282 : integer, intent(in) :: lchnk
283 : integer, intent(in) :: ncol
284 : type(physics_buffer_desc), pointer :: pbuf(:)
285 :
286 0 : if( num_tracer_cnst < 1 ) return
287 :
288 0 : call get_fld_data( fields, field_name, data, ncol, lchnk, pbuf )
289 :
290 0 : end subroutine get_cnst_data
291 :
292 : !-------------------------------------------------------------------
293 : !-------------------------------------------------------------------
294 0 : subroutine get_cnst_data_ptr(name, state, q, pbuf)
295 :
296 0 : use tracer_data, only : get_fld_data, get_fld_ndx
297 : use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole
298 : use chem_mods, only : fix_mass
299 : use mo_chem_utls, only : get_inv_ndx
300 : use physics_types, only : physics_state
301 : use ppgrid, only : pcols, pver
302 : use physics_buffer, only : physics_buffer_desc
303 :
304 : implicit none
305 :
306 : character(len=*), intent(in) :: name
307 : type(physics_state), intent(in) :: state
308 : real(r8), pointer, dimension(:,:) :: q ! constituent mass mixing ratio
309 : type(physics_buffer_desc), pointer :: pbuf(:)
310 :
311 : integer :: lchnk
312 : integer :: ncol
313 : integer :: inv_id, idx
314 : character(len=80) :: error_str
315 :
316 0 : lchnk = state%lchnk
317 0 : ncol = state%ncol
318 :
319 : ! make sure the requested constituent can be provided
320 0 : inv_id = get_inv_ndx(name)
321 0 : if (.not. inv_id > 0) then
322 0 : if (masterproc) then
323 0 : write(iulog,*) 'get_cnst_data_ptr: '//name//' is not a prescribed tracer constituent'
324 : endif
325 : return
326 : endif
327 :
328 :
329 0 : call get_fld_ndx( fields, name, idx )
330 0 : if (idx<1) then
331 0 : write(error_str,*) 'get_cnst_data_ptr: ',trim(name),' not found ... idx : ',idx
332 0 : if (masterproc) then
333 0 : write(iulog,*) error_str
334 : end if
335 0 : call endrun(error_str)
336 : end if
337 0 : call get_fld_data( fields, name, data_q(:,:,idx,lchnk), ncol, lchnk, pbuf )
338 :
339 0 : data_q(:ncol,:,idx,lchnk) = data_q(:ncol,:,idx,lchnk)*fix_mass(inv_id)/mwdry ! vmr->mmr
340 0 : q => data_q(:,:,idx,lchnk)
341 :
342 0 : end subroutine get_cnst_data_ptr
343 :
344 : !-------------------------------------------------------------------
345 :
346 0 : subroutine init_tracer_cnst_restart( piofile )
347 0 : use pio, only : file_desc_t
348 : use tracer_data, only : init_trc_restart
349 : implicit none
350 : type(file_desc_t),intent(inout) :: pioFile ! pio File pointer
351 :
352 0 : call init_trc_restart( 'tracer_cnst', piofile, file )
353 :
354 0 : end subroutine init_tracer_cnst_restart
355 : !-------------------------------------------------------------------
356 0 : subroutine write_tracer_cnst_restart( piofile )
357 0 : use tracer_data, only : write_trc_restart
358 : use pio, only : file_desc_t
359 : implicit none
360 :
361 : type(file_desc_t) :: piofile
362 :
363 0 : call write_trc_restart( piofile, file )
364 :
365 0 : end subroutine write_tracer_cnst_restart
366 :
367 : !-------------------------------------------------------------------
368 0 : subroutine read_tracer_cnst_restart( pioFile )
369 0 : use tracer_data, only : read_trc_restart
370 : use pio, only : file_desc_t
371 : implicit none
372 :
373 : type(file_desc_t) :: piofile
374 :
375 0 : call read_trc_restart( 'tracer_cnst', piofile, file )
376 :
377 0 : end subroutine read_tracer_cnst_restart
378 :
379 : end module tracer_cnst
|