Line data Source code
1 : !-------------------------------------------------------------------
2 : ! manages reading and interpolation of offline tracer sources
3 : ! Created by: Francis Vitt -- 2 May 2006
4 : !-------------------------------------------------------------------
5 : module tracer_srcs
6 :
7 : use shr_kind_mod, only: r8 => shr_kind_r8
8 : use cam_abortutils, only : endrun
9 : use spmd_utils, only : masterproc
10 :
11 : use tracer_data, only : trfld,trfile,MAXTRCRS
12 : use cam_logfile, only : iulog
13 :
14 : implicit none
15 :
16 : private ! all unless made public
17 : save
18 :
19 : public :: tracer_srcs_init
20 : public :: num_tracer_srcs
21 : public :: tracer_src_flds
22 : public :: tracer_srcs_adv
23 : public :: get_srcs_data
24 : public :: write_tracer_srcs_restart
25 : public :: read_tracer_srcs_restart
26 : public :: tracer_srcs_defaultopts
27 : public :: tracer_srcs_setopts
28 : public :: init_tracer_srcs_restart
29 :
30 : type(trfld), pointer :: fields(:) => null()
31 : type(trfile) :: file
32 :
33 : integer :: num_tracer_srcs
34 : character(len=16), allocatable :: tracer_src_flds(:)
35 :
36 : character(len=64) :: specifier(MAXTRCRS) = ''
37 : character(len=256) :: filename = 'tracer_srcs_file'
38 : character(len=256) :: filelist = ''
39 : character(len=256) :: datapath = ''
40 : character(len=32) :: data_type = 'SERIAL'
41 : logical :: rmv_file = .false.
42 : integer :: cycle_yr = 0
43 : integer :: fixed_ymd = 0
44 : integer :: fixed_tod = 0
45 :
46 : contains
47 :
48 : !-------------------------------------------------------------------
49 : !-------------------------------------------------------------------
50 2304 : subroutine tracer_srcs_init()
51 :
52 : use mo_chem_utls, only : get_extfrc_ndx
53 : use tracer_data, only : trcdata_init
54 : use cam_history, only : addfld
55 :
56 : implicit none
57 :
58 : integer :: i ,ndx
59 :
60 1536 : allocate(file%in_pbuf(size(specifier)))
61 155136 : file%in_pbuf(:) = .false.
62 : call trcdata_init( specifier, filename, filelist, datapath, fields, file, &
63 1536 : rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type)
64 :
65 1536 : num_tracer_srcs = 0
66 1536 : if (associated(fields)) num_tracer_srcs = size( fields )
67 :
68 1536 : if( num_tracer_srcs < 1 ) then
69 :
70 1536 : if (masterproc) then
71 2 : write(iulog,*) 'There are no offline tracer sources'
72 2 : write(iulog,*) ' '
73 : end if
74 : return
75 : end if
76 :
77 0 : allocate( tracer_src_flds(num_tracer_srcs))
78 :
79 0 : do i = 1, num_tracer_srcs
80 :
81 0 : ndx = get_extfrc_ndx( fields(i)%fldnam )
82 :
83 0 : if (ndx < 1) then
84 0 : write(iulog,*) fields(i)%fldnam//' is not configured to have an external source'
85 0 : call endrun('tracer_srcs_init')
86 : endif
87 :
88 0 : tracer_src_flds(i) = fields(i)%fldnam
89 :
90 0 : call addfld(trim(fields(i)%fldnam)//'_trsrc', (/ 'lev' /), 'I','/cm3/s', 'tracer source rate' )
91 :
92 : enddo
93 :
94 1536 : end subroutine tracer_srcs_init
95 :
96 : !-------------------------------------------------------------------
97 : !-------------------------------------------------------------------
98 1536 : subroutine tracer_srcs_setopts( &
99 : tracer_srcs_file_in, &
100 : tracer_srcs_filelist_in, &
101 : tracer_srcs_datapath_in, &
102 : tracer_srcs_type_in, &
103 1536 : tracer_srcs_specifier_in, &
104 : tracer_srcs_rmfile_in, &
105 : tracer_srcs_cycle_yr_in, &
106 : tracer_srcs_fixed_ymd_in, &
107 : tracer_srcs_fixed_tod_in &
108 : )
109 :
110 : implicit none
111 :
112 : character(len=*), intent(in), optional :: tracer_srcs_file_in
113 : character(len=*), intent(in), optional :: tracer_srcs_filelist_in
114 : character(len=*), intent(in), optional :: tracer_srcs_datapath_in
115 : character(len=*), intent(in), optional :: tracer_srcs_type_in
116 : character(len=*), intent(in), optional :: tracer_srcs_specifier_in(:)
117 : logical, intent(in), optional :: tracer_srcs_rmfile_in
118 : integer, intent(in), optional :: tracer_srcs_cycle_yr_in
119 : integer, intent(in), optional :: tracer_srcs_fixed_ymd_in
120 : integer, intent(in), optional :: tracer_srcs_fixed_tod_in
121 :
122 1536 : if ( present(tracer_srcs_file_in) ) then
123 1536 : filename = tracer_srcs_file_in
124 : endif
125 1536 : if ( present(tracer_srcs_filelist_in) ) then
126 1536 : filelist = tracer_srcs_filelist_in
127 : endif
128 1536 : if ( present(tracer_srcs_datapath_in) ) then
129 1536 : datapath = tracer_srcs_datapath_in
130 : endif
131 1536 : if ( present(tracer_srcs_type_in) ) then
132 1536 : data_type = tracer_srcs_type_in
133 : endif
134 1536 : if ( present(tracer_srcs_specifier_in) ) then
135 156672 : specifier = tracer_srcs_specifier_in
136 : endif
137 1536 : if ( present(tracer_srcs_rmfile_in) ) then
138 1536 : rmv_file = tracer_srcs_rmfile_in
139 : endif
140 1536 : if ( present(tracer_srcs_cycle_yr_in) ) then
141 1536 : cycle_yr = tracer_srcs_cycle_yr_in
142 : endif
143 1536 : if ( present(tracer_srcs_fixed_ymd_in) ) then
144 1536 : fixed_ymd = tracer_srcs_fixed_ymd_in
145 : endif
146 1536 : if ( present(tracer_srcs_fixed_tod_in) ) then
147 1536 : fixed_tod = tracer_srcs_fixed_tod_in
148 : endif
149 :
150 3072 : endsubroutine tracer_srcs_setopts
151 :
152 : !-------------------------------------------------------------------
153 : !-------------------------------------------------------------------
154 1536 : subroutine tracer_srcs_defaultopts( &
155 : tracer_srcs_file_out, &
156 : tracer_srcs_filelist_out, &
157 : tracer_srcs_datapath_out, &
158 : tracer_srcs_type_out, &
159 1536 : tracer_srcs_specifier_out,&
160 : tracer_srcs_rmfile_out, &
161 : tracer_srcs_cycle_yr_out, &
162 : tracer_srcs_fixed_ymd_out,&
163 : tracer_srcs_fixed_tod_out &
164 : )
165 :
166 : implicit none
167 :
168 : character(len=*), intent(out), optional :: tracer_srcs_file_out
169 : character(len=*), intent(out), optional :: tracer_srcs_filelist_out
170 : character(len=*), intent(out), optional :: tracer_srcs_datapath_out
171 : character(len=*), intent(out), optional :: tracer_srcs_type_out
172 : character(len=*), intent(out), optional :: tracer_srcs_specifier_out(:)
173 : logical, intent(out), optional :: tracer_srcs_rmfile_out
174 : integer, intent(out), optional :: tracer_srcs_cycle_yr_out
175 : integer, intent(out), optional :: tracer_srcs_fixed_ymd_out
176 : integer, intent(out), optional :: tracer_srcs_fixed_tod_out
177 :
178 1536 : if ( present(tracer_srcs_file_out) ) then
179 1536 : tracer_srcs_file_out = filename
180 : endif
181 1536 : if ( present(tracer_srcs_filelist_out) ) then
182 1536 : tracer_srcs_filelist_out = filelist
183 : endif
184 1536 : if ( present(tracer_srcs_datapath_out) ) then
185 1536 : tracer_srcs_datapath_out = datapath
186 : endif
187 1536 : if ( present(tracer_srcs_type_out) ) then
188 1536 : tracer_srcs_type_out = data_type
189 : endif
190 1536 : if ( present(tracer_srcs_specifier_out) ) then
191 156672 : tracer_srcs_specifier_out = specifier
192 : endif
193 1536 : if ( present(tracer_srcs_rmfile_out) ) then
194 1536 : tracer_srcs_rmfile_out = rmv_file
195 : endif
196 1536 : if ( present(tracer_srcs_cycle_yr_out) ) then
197 1536 : tracer_srcs_cycle_yr_out = cycle_yr
198 : endif
199 1536 : if ( present(tracer_srcs_fixed_ymd_out) ) then
200 1536 : tracer_srcs_fixed_ymd_out = fixed_ymd
201 : endif
202 1536 : if ( present(tracer_srcs_fixed_tod_out) ) then
203 1536 : tracer_srcs_fixed_tod_out = fixed_tod
204 : endif
205 :
206 1536 : endsubroutine tracer_srcs_defaultopts
207 :
208 : !-------------------------------------------------------------------
209 : !-------------------------------------------------------------------
210 741888 : subroutine tracer_srcs_adv( pbuf2d, state )
211 :
212 : use tracer_data, only : advance_trcdata
213 : use ppgrid, only : begchunk, endchunk
214 : use physics_types,only : physics_state
215 : use cam_history, only : outfld
216 : use physics_buffer, only : physics_buffer_desc
217 :
218 : implicit none
219 :
220 : type(physics_state), intent(in):: state(begchunk:endchunk)
221 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
222 :
223 : integer :: i,c,ncol
224 :
225 370944 : if( num_tracer_srcs < 1 ) return
226 :
227 0 : call advance_trcdata( fields, file, state, pbuf2d )
228 :
229 0 : do c = begchunk,endchunk
230 0 : ncol = state(c)%ncol
231 0 : do i = 1,num_tracer_srcs
232 0 : call outfld( trim(fields(i)%fldnam)//'_trsrc', fields(i)%data(:ncol,:,c), ncol, state(c)%lchnk )
233 : enddo
234 : enddo
235 :
236 370944 : end subroutine tracer_srcs_adv
237 :
238 : !-------------------------------------------------------------------
239 : !-------------------------------------------------------------------
240 0 : subroutine get_srcs_data( field_name, data, ncol, lchnk, pbuf )
241 :
242 370944 : use tracer_data, only : get_fld_data
243 : use physics_buffer, only : physics_buffer_desc
244 :
245 : implicit none
246 :
247 : character(len=*), intent(in) :: field_name
248 : real(r8), intent(out) :: data(:,:)
249 : integer, intent(in) :: lchnk
250 : integer, intent(in) :: ncol
251 : type(physics_buffer_desc), pointer :: pbuf(:)
252 :
253 0 : if( num_tracer_srcs < 1 ) return
254 :
255 0 : call get_fld_data( fields, field_name, data, ncol, lchnk, pbuf )
256 :
257 0 : end subroutine get_srcs_data
258 :
259 : !-------------------------------------------------------------------
260 :
261 1536 : subroutine init_tracer_srcs_restart( piofile )
262 0 : use pio, only : file_desc_t
263 : use tracer_data, only : init_trc_restart
264 : implicit none
265 : type(file_desc_t),intent(inout) :: pioFile ! pio File pointer
266 :
267 1536 : call init_trc_restart( 'tracer_srcs', piofile, file )
268 :
269 1536 : end subroutine init_tracer_srcs_restart
270 : !-------------------------------------------------------------------
271 1536 : subroutine write_tracer_srcs_restart( piofile )
272 1536 : use tracer_data, only : write_trc_restart
273 : use pio, only : file_desc_t
274 : implicit none
275 :
276 : type(file_desc_t) :: piofile
277 :
278 1536 : call write_trc_restart( piofile, file )
279 :
280 1536 : end subroutine write_tracer_srcs_restart
281 :
282 : !-------------------------------------------------------------------
283 :
284 768 : subroutine read_tracer_srcs_restart( pioFile )
285 1536 : use tracer_data, only : read_trc_restart
286 : use pio, only : file_desc_t
287 : implicit none
288 :
289 : type(file_desc_t) :: piofile
290 :
291 768 : call read_trc_restart( 'tracer_srcs', piofile, file )
292 :
293 768 : end subroutine read_tracer_srcs_restart
294 :
295 :
296 : end module tracer_srcs
|
