Line data Source code
1 : module camsrfexch
2 :
3 : !-----------------------------------------------------------------------
4 : ! Module to handle data that is exchanged between the CAM atmosphere
5 : ! model and the surface models (land, sea-ice, and ocean).
6 : !-----------------------------------------------------------------------
7 :
8 : use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4
9 : use constituents, only: pcnst
10 : use ppgrid, only: pcols, begchunk, endchunk
11 : use phys_grid, only: get_ncols_p, phys_grid_initialized
12 : use infnan, only: posinf, assignment(=)
13 : use cam_abortutils, only: endrun
14 : use cam_logfile, only: iulog
15 : use srf_field_check, only: active_Sl_ram1, active_Sl_fv, active_Sl_soilw, &
16 : active_Fall_flxdst1, active_Fall_flxvoc, active_Fall_flxfire
17 : use cam_control_mod, only: aqua_planet, simple_phys
18 :
19 : implicit none
20 : private
21 :
22 : ! Public interfaces
23 : public atm2hub_alloc ! Atmosphere to surface data allocation method
24 : public hub2atm_alloc ! Merged hub surface to atmosphere data allocation method
25 : public atm2hub_deallocate
26 : public hub2atm_deallocate
27 : public cam_export
28 :
29 : ! Public data types
30 : public cam_out_t ! Data from atmosphere
31 : public cam_in_t ! Merged surface data
32 :
33 : !---------------------------------------------------------------------------
34 : ! This is the data that is sent from the atmosphere to the surface models
35 : !---------------------------------------------------------------------------
36 :
37 : type cam_out_t
38 : integer :: lchnk ! chunk index
39 : integer :: ncol ! number of columns in chunk
40 : real(r8) :: tbot(pcols) ! bot level temperature
41 : real(r8) :: zbot(pcols) ! bot level height above surface
42 : real(r8) :: topo(pcols) ! surface topographic height (m)
43 : real(r8) :: ubot(pcols) ! bot level u wind
44 : real(r8) :: vbot(pcols) ! bot level v wind
45 : real(r8) :: qbot(pcols,pcnst) ! bot level specific humidity
46 : real(r8) :: pbot(pcols) ! bot level pressure
47 : real(r8) :: rho(pcols) ! bot level density
48 : real(r8) :: netsw(pcols) !
49 : real(r8) :: flwds(pcols) !
50 : real(r8) :: precsc(pcols) !
51 : real(r8) :: precsl(pcols) !
52 : real(r8) :: precc(pcols) !
53 : real(r8) :: precl(pcols) !
54 : real(r8) :: soll(pcols) !
55 : real(r8) :: sols(pcols) !
56 : real(r8) :: solld(pcols) !
57 : real(r8) :: solsd(pcols) !
58 : real(r8) :: thbot(pcols) !
59 : real(r8) :: co2prog(pcols) ! prognostic co2
60 : real(r8) :: co2diag(pcols) ! diagnostic co2
61 : real(r8) :: ozone(pcols) ! surface ozone concentration (mole/mole)
62 : real(r8) :: lightning_flash_freq(pcols) ! cloud-to-ground lightning flash frequency (/min)
63 : real(r8) :: psl(pcols)
64 : real(r8) :: bcphiwet(pcols) ! wet deposition of hydrophilic black carbon
65 : real(r8) :: bcphidry(pcols) ! dry deposition of hydrophilic black carbon
66 : real(r8) :: bcphodry(pcols) ! dry deposition of hydrophobic black carbon
67 : real(r8) :: ocphiwet(pcols) ! wet deposition of hydrophilic organic carbon
68 : real(r8) :: ocphidry(pcols) ! dry deposition of hydrophilic organic carbon
69 : real(r8) :: ocphodry(pcols) ! dry deposition of hydrophobic organic carbon
70 : real(r8) :: dstwet1(pcols) ! wet deposition of dust (bin1)
71 : real(r8) :: dstdry1(pcols) ! dry deposition of dust (bin1)
72 : real(r8) :: dstwet2(pcols) ! wet deposition of dust (bin2)
73 : real(r8) :: dstdry2(pcols) ! dry deposition of dust (bin2)
74 : real(r8) :: dstwet3(pcols) ! wet deposition of dust (bin3)
75 : real(r8) :: dstdry3(pcols) ! dry deposition of dust (bin3)
76 : real(r8) :: dstwet4(pcols) ! wet deposition of dust (bin4)
77 : real(r8) :: dstdry4(pcols) ! dry deposition of dust (bin4)
78 : real(r8), pointer, dimension(:) :: nhx_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s)
79 : real(r8), pointer, dimension(:) :: noy_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s)
80 : end type cam_out_t
81 :
82 : !---------------------------------------------------------------------------
83 : ! This is the merged state of sea-ice, land and ocean surface parameterizations
84 : !---------------------------------------------------------------------------
85 :
86 : type cam_in_t
87 : integer :: lchnk ! chunk index
88 : integer :: ncol ! number of active columns
89 : real(r8) :: asdir(pcols) ! albedo: shortwave, direct
90 : real(r8) :: asdif(pcols) ! albedo: shortwave, diffuse
91 : real(r8) :: aldir(pcols) ! albedo: longwave, direct
92 : real(r8) :: aldif(pcols) ! albedo: longwave, diffuse
93 : real(r8) :: lwup(pcols) ! longwave up radiative flux
94 : real(r8) :: lhf(pcols) ! latent heat flux
95 : real(r8) :: shf(pcols) ! sensible heat flux
96 : real(r8) :: wsx(pcols) ! surface u-stress (N)
97 : real(r8) :: wsy(pcols) ! surface v-stress (N)
98 : real(r8) :: tref(pcols) ! ref height surface air temp
99 : real(r8) :: qref(pcols) ! ref height specific humidity
100 : real(r8) :: u10(pcols) ! 10m wind speed
101 : real(r8) :: ugustOut(pcols) ! gustiness added
102 : real(r8) :: u10withGusts(pcols) ! 10m wind speed with gusts added
103 : real(r8) :: ts(pcols) ! merged surface temp
104 : real(r8) :: sst(pcols) ! sea surface temp
105 : real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land
106 : real(r8) :: snowhice(pcols) ! snow depth over ice
107 : real(r8) :: fco2_lnd(pcols) ! co2 flux from lnd
108 : real(r8) :: fco2_ocn(pcols) ! co2 flux from ocn
109 : real(r8) :: fdms(pcols) ! dms flux
110 : real(r8) :: landfrac(pcols) ! land area fraction
111 : real(r8) :: icefrac(pcols) ! sea-ice areal fraction
112 : real(r8) :: ocnfrac(pcols) ! ocean areal fraction
113 : real(r8) :: cflx(pcols,pcnst) ! constituent flux (emissions)
114 : real(r8) :: ustar(pcols) ! atm/ocn saved version of ustar
115 : real(r8) :: re(pcols) ! atm/ocn saved version of re
116 : real(r8) :: ssq(pcols) ! atm/ocn saved version of ssq
117 : real(r8), pointer, dimension(:) :: ram1 !aerodynamical resistance (s/m) (pcols)
118 : real(r8), pointer, dimension(:) :: fv !friction velocity (m/s) (pcols)
119 : real(r8), pointer, dimension(:) :: soilw !volumetric soil water (m3/m3)
120 : real(r8), pointer, dimension(:,:) :: depvel ! deposition velocities
121 : real(r8), pointer, dimension(:,:) :: dstflx ! dust fluxes
122 : real(r8), pointer, dimension(:,:) :: meganflx ! MEGAN fluxes
123 : real(r8), pointer, dimension(:,:) :: fireflx ! wild fire emissions
124 : real(r8), pointer, dimension(:) :: fireztop ! wild fire emissions vert distribution top
125 : end type cam_in_t
126 :
127 : !===============================================================================
128 : CONTAINS
129 : !===============================================================================
130 :
131 2304 : subroutine hub2atm_alloc( cam_in )
132 :
133 : ! Allocate space for the surface to atmosphere data type. And initialize
134 : ! the values.
135 :
136 : use shr_drydep_mod, only: n_drydep
137 : use shr_megan_mod, only: shr_megan_mechcomps_n
138 : use shr_fire_emis_mod,only: shr_fire_emis_mechcomps_n
139 :
140 : ! ARGUMENTS:
141 : type(cam_in_t), pointer :: cam_in(:) ! Merged surface state
142 :
143 : ! LOCAL VARIABLES:
144 : integer :: c ! chunk index
145 : integer :: ierror ! Error code
146 : character(len=*), parameter :: sub = 'hub2atm_alloc'
147 : !-----------------------------------------------------------------------
148 :
149 2304 : if ( .not. phys_grid_initialized() ) call endrun(sub//": phys_grid not called yet")
150 6912 : allocate (cam_in(begchunk:endchunk), stat=ierror)
151 2304 : if ( ierror /= 0 )then
152 0 : write(iulog,*) sub//': Allocation error: ', ierror
153 0 : call endrun(sub//': allocation error')
154 : end if
155 :
156 11592 : do c = begchunk,endchunk
157 9288 : nullify(cam_in(c)%ram1)
158 9288 : nullify(cam_in(c)%fv)
159 9288 : nullify(cam_in(c)%soilw)
160 9288 : nullify(cam_in(c)%depvel)
161 9288 : nullify(cam_in(c)%dstflx)
162 9288 : nullify(cam_in(c)%meganflx)
163 9288 : nullify(cam_in(c)%fireflx)
164 11592 : nullify(cam_in(c)%fireztop)
165 : enddo
166 11592 : do c = begchunk,endchunk
167 9288 : if (active_Sl_ram1) then
168 9288 : allocate (cam_in(c)%ram1(pcols), stat=ierror)
169 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error ram1')
170 : endif
171 9288 : if (active_Sl_fv) then
172 9288 : allocate (cam_in(c)%fv(pcols), stat=ierror)
173 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error fv')
174 : endif
175 9288 : if (active_Sl_soilw) then
176 0 : allocate (cam_in(c)%soilw(pcols), stat=ierror)
177 0 : if ( ierror /= 0 ) call endrun(sub//': allocation error soilw')
178 : end if
179 9288 : if (active_Fall_flxdst1) then
180 : ! Assume 4 bins from surface model ....
181 9288 : allocate (cam_in(c)%dstflx(pcols,4), stat=ierror)
182 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error dstflx')
183 : endif
184 11592 : if (active_Fall_flxvoc .and. shr_megan_mechcomps_n>0) then
185 27864 : allocate (cam_in(c)%meganflx(pcols,shr_megan_mechcomps_n), stat=ierror)
186 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error meganflx')
187 : endif
188 : end do
189 :
190 2304 : if (n_drydep>0) then
191 11592 : do c = begchunk,endchunk
192 27864 : allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror)
193 11592 : if ( ierror /= 0 ) call endrun(sub//': allocation error depvel')
194 : end do
195 : endif
196 :
197 2304 : if (active_Fall_flxfire .and. shr_fire_emis_mechcomps_n>0) then
198 0 : do c = begchunk,endchunk
199 0 : allocate(cam_in(c)%fireflx(pcols,shr_fire_emis_mechcomps_n), stat=ierror)
200 0 : if ( ierror /= 0 ) call endrun(sub//': allocation error fireflx')
201 0 : allocate(cam_in(c)%fireztop(pcols), stat=ierror)
202 0 : if ( ierror /= 0 ) call endrun(sub//': allocation error fireztop')
203 : enddo
204 : endif
205 :
206 11592 : do c = begchunk,endchunk
207 9288 : cam_in(c)%lchnk = c
208 9288 : cam_in(c)%ncol = get_ncols_p(c)
209 157896 : cam_in(c)%asdir (:) = 0._r8
210 157896 : cam_in(c)%asdif (:) = 0._r8
211 157896 : cam_in(c)%aldir (:) = 0._r8
212 157896 : cam_in(c)%aldif (:) = 0._r8
213 157896 : cam_in(c)%lwup (:) = 0._r8
214 157896 : cam_in(c)%lhf (:) = 0._r8
215 157896 : cam_in(c)%shf (:) = 0._r8
216 157896 : cam_in(c)%wsx (:) = 0._r8
217 157896 : cam_in(c)%wsy (:) = 0._r8
218 157896 : cam_in(c)%tref (:) = 0._r8
219 157896 : cam_in(c)%qref (:) = 0._r8
220 157896 : cam_in(c)%u10 (:) = 0._r8
221 157896 : cam_in(c)%ugustOut (:) = 0._r8
222 157896 : cam_in(c)%u10withGusts (:) = 0._r8
223 157896 : cam_in(c)%ts (:) = 0._r8
224 157896 : cam_in(c)%sst (:) = 0._r8
225 157896 : cam_in(c)%snowhland(:) = 0._r8
226 157896 : cam_in(c)%snowhice (:) = 0._r8
227 157896 : cam_in(c)%fco2_lnd (:) = 0._r8
228 157896 : cam_in(c)%fco2_ocn (:) = 0._r8
229 157896 : cam_in(c)%fdms (:) = 0._r8
230 9288 : cam_in(c)%landfrac (:) = posinf
231 9288 : cam_in(c)%icefrac (:) = posinf
232 9288 : cam_in(c)%ocnfrac (:) = posinf
233 :
234 9288 : if (associated(cam_in(c)%ram1)) &
235 157896 : cam_in(c)%ram1 (:) = 0.1_r8
236 9288 : if (associated(cam_in(c)%fv)) &
237 157896 : cam_in(c)%fv (:) = 0.1_r8
238 9288 : if (associated(cam_in(c)%soilw)) &
239 0 : cam_in(c)%soilw (:) = 0.0_r8
240 9288 : if (associated(cam_in(c)%dstflx)) &
241 640872 : cam_in(c)%dstflx(:,:) = 0.0_r8
242 9288 : if (associated(cam_in(c)%meganflx)) &
243 167184 : cam_in(c)%meganflx(:,:) = 0.0_r8
244 :
245 6483024 : cam_in(c)%cflx (:,:) = 0._r8
246 157896 : cam_in(c)%ustar (:) = 0._r8
247 157896 : cam_in(c)%re (:) = 0._r8
248 157896 : cam_in(c)%ssq (:) = 0._r8
249 9288 : if (n_drydep>0) then
250 798768 : cam_in(c)%depvel (:,:) = 0._r8
251 : endif
252 11592 : if (active_Fall_flxfire .and. shr_fire_emis_mechcomps_n>0) then
253 0 : cam_in(c)%fireflx(:,:) = 0._r8
254 0 : cam_in(c)%fireztop(:) = 0._r8
255 : endif
256 : end do
257 :
258 2304 : end subroutine hub2atm_alloc
259 :
260 : !===============================================================================
261 :
262 2304 : subroutine atm2hub_alloc( cam_out )
263 :
264 : ! Allocate space for the atmosphere to surface data type. And initialize
265 : ! the values.
266 :
267 : ! ARGUMENTS:
268 : type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input
269 :
270 : ! LOCAL VARIABLES:
271 : integer :: c ! chunk index
272 : integer :: ierror ! Error code
273 : character(len=*), parameter :: sub = 'atm2hub_alloc'
274 : !-----------------------------------------------------------------------
275 :
276 2304 : if (.not. phys_grid_initialized()) call endrun(sub//": phys_grid not called yet")
277 6912 : allocate (cam_out(begchunk:endchunk), stat=ierror)
278 2304 : if ( ierror /= 0 )then
279 0 : write(iulog,*) sub//': Allocation error: ', ierror
280 0 : call endrun(sub//': allocation error: cam_out')
281 : end if
282 :
283 11592 : do c = begchunk,endchunk
284 9288 : cam_out(c)%lchnk = c
285 9288 : cam_out(c)%ncol = get_ncols_p(c)
286 157896 : cam_out(c)%tbot(:) = 0._r8
287 157896 : cam_out(c)%zbot(:) = 0._r8
288 157896 : cam_out(c)%topo(:) = 0._r8
289 157896 : cam_out(c)%ubot(:) = 0._r8
290 157896 : cam_out(c)%vbot(:) = 0._r8
291 6483024 : cam_out(c)%qbot(:,:) = 0._r8
292 157896 : cam_out(c)%pbot(:) = 0._r8
293 157896 : cam_out(c)%rho(:) = 0._r8
294 157896 : cam_out(c)%netsw(:) = 0._r8
295 157896 : cam_out(c)%flwds(:) = 0._r8
296 157896 : cam_out(c)%precsc(:) = 0._r8
297 157896 : cam_out(c)%precsl(:) = 0._r8
298 157896 : cam_out(c)%precc(:) = 0._r8
299 157896 : cam_out(c)%precl(:) = 0._r8
300 157896 : cam_out(c)%soll(:) = 0._r8
301 157896 : cam_out(c)%sols(:) = 0._r8
302 157896 : cam_out(c)%solld(:) = 0._r8
303 157896 : cam_out(c)%solsd(:) = 0._r8
304 157896 : cam_out(c)%thbot(:) = 0._r8
305 157896 : cam_out(c)%co2prog(:) = 0._r8
306 157896 : cam_out(c)%co2diag(:) = 0._r8
307 157896 : cam_out(c)%ozone(:) = 0._r8
308 157896 : cam_out(c)%lightning_flash_freq(:) = 0._r8
309 157896 : cam_out(c)%psl(:) = 0._r8
310 157896 : cam_out(c)%bcphidry(:) = 0._r8
311 157896 : cam_out(c)%bcphodry(:) = 0._r8
312 157896 : cam_out(c)%bcphiwet(:) = 0._r8
313 157896 : cam_out(c)%ocphidry(:) = 0._r8
314 157896 : cam_out(c)%ocphodry(:) = 0._r8
315 157896 : cam_out(c)%ocphiwet(:) = 0._r8
316 157896 : cam_out(c)%dstdry1(:) = 0._r8
317 157896 : cam_out(c)%dstwet1(:) = 0._r8
318 157896 : cam_out(c)%dstdry2(:) = 0._r8
319 157896 : cam_out(c)%dstwet2(:) = 0._r8
320 157896 : cam_out(c)%dstdry3(:) = 0._r8
321 157896 : cam_out(c)%dstwet3(:) = 0._r8
322 157896 : cam_out(c)%dstdry4(:) = 0._r8
323 157896 : cam_out(c)%dstwet4(:) = 0._r8
324 :
325 9288 : nullify(cam_out(c)%nhx_nitrogen_flx)
326 9288 : nullify(cam_out(c)%noy_nitrogen_flx)
327 :
328 11592 : if (.not.(simple_phys .or. aqua_planet)) then
329 :
330 9288 : allocate (cam_out(c)%nhx_nitrogen_flx(pcols), stat=ierror)
331 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error nhx_nitrogen_flx')
332 157896 : cam_out(c)%nhx_nitrogen_flx(:) = 0._r8
333 :
334 9288 : allocate (cam_out(c)%noy_nitrogen_flx(pcols), stat=ierror)
335 9288 : if ( ierror /= 0 ) call endrun(sub//': allocation error noy_nitrogen_flx')
336 157896 : cam_out(c)%noy_nitrogen_flx(:) = 0._r8
337 :
338 : endif
339 :
340 : end do
341 :
342 2304 : end subroutine atm2hub_alloc
343 :
344 : !===============================================================================
345 :
346 2304 : subroutine atm2hub_deallocate(cam_out)
347 :
348 : type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input
349 : !-----------------------------------------------------------------------
350 :
351 2304 : if(associated(cam_out)) then
352 2304 : deallocate(cam_out)
353 : end if
354 2304 : nullify(cam_out)
355 :
356 2304 : end subroutine atm2hub_deallocate
357 :
358 : !===============================================================================
359 :
360 2304 : subroutine hub2atm_deallocate(cam_in)
361 :
362 : type(cam_in_t), pointer :: cam_in(:) ! Atmosphere to surface input
363 :
364 : integer :: c
365 : !-----------------------------------------------------------------------
366 :
367 2304 : if(associated(cam_in)) then
368 11592 : do c=begchunk,endchunk
369 9288 : if(associated(cam_in(c)%ram1)) then
370 9288 : deallocate(cam_in(c)%ram1)
371 9288 : nullify(cam_in(c)%ram1)
372 : end if
373 9288 : if(associated(cam_in(c)%fv)) then
374 9288 : deallocate(cam_in(c)%fv)
375 9288 : nullify(cam_in(c)%fv)
376 : end if
377 9288 : if(associated(cam_in(c)%soilw)) then
378 0 : deallocate(cam_in(c)%soilw)
379 0 : nullify(cam_in(c)%soilw)
380 : end if
381 9288 : if(associated(cam_in(c)%dstflx)) then
382 9288 : deallocate(cam_in(c)%dstflx)
383 9288 : nullify(cam_in(c)%dstflx)
384 : end if
385 9288 : if(associated(cam_in(c)%meganflx)) then
386 9288 : deallocate(cam_in(c)%meganflx)
387 9288 : nullify(cam_in(c)%meganflx)
388 : end if
389 11592 : if(associated(cam_in(c)%depvel)) then
390 9288 : deallocate(cam_in(c)%depvel)
391 9288 : nullify(cam_in(c)%depvel)
392 : end if
393 :
394 : enddo
395 :
396 2304 : deallocate(cam_in)
397 : end if
398 2304 : nullify(cam_in)
399 :
400 2304 : end subroutine hub2atm_deallocate
401 :
402 :
403 : !======================================================================
404 :
405 99072 : subroutine cam_export(state,cam_out,pbuf)
406 :
407 : ! Transfer atmospheric fields into necessary surface data structures
408 :
409 : use physics_types, only: physics_state
410 : use ppgrid, only: pver
411 : use cam_history, only: outfld
412 : use chem_surfvals, only: chem_surfvals_get
413 : use co2_cycle, only: co2_transport, c_i
414 : use physconst, only: rair, mwdry, mwco2, gravit, mwo3
415 : use constituents, only: pcnst
416 : use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc
417 : use rad_constituents, only: rad_cnst_get_gas
418 : use cam_control_mod, only: simple_phys
419 :
420 : implicit none
421 :
422 : ! Input arguments
423 : type(physics_state), intent(in) :: state
424 : type (cam_out_t), intent(inout) :: cam_out
425 : type(physics_buffer_desc), pointer :: pbuf(:)
426 :
427 : ! Local variables
428 :
429 : integer :: i ! Longitude index
430 : integer :: m ! constituent index
431 : integer :: lchnk ! Chunk index
432 : integer :: ncol
433 : integer :: psl_idx
434 : integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx
435 : integer :: prec_sed_idx,snow_sed_idx,prec_pcw_idx,snow_pcw_idx
436 : integer :: srf_ozone_idx, lightning_idx
437 :
438 99072 : real(r8), pointer :: psl(:)
439 :
440 99072 : real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection
441 99072 : real(r8), pointer :: snow_dp(:) ! snow from ZM convection
442 99072 : real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection
443 99072 : real(r8), pointer :: snow_sh(:) ! snow from Hack convection
444 99072 : real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection
445 99072 : real(r8), pointer :: snow_sed(:) ! snow from ZM convection
446 99072 : real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection
447 99072 : real(r8), pointer :: snow_pcw(:) ! snow from Hack convection
448 99072 : real(r8), pointer :: o3_ptr(:,:), srf_o3_ptr(:)
449 99072 : real(r8), pointer :: lightning_ptr(:)
450 : !-----------------------------------------------------------------------
451 :
452 99072 : lchnk = state%lchnk
453 99072 : ncol = state%ncol
454 :
455 198144 : psl_idx = pbuf_get_index('PSL')
456 99072 : call pbuf_get_field(pbuf, psl_idx, psl)
457 :
458 99072 : prec_dp_idx = pbuf_get_index('PREC_DP', errcode=i)
459 99072 : snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=i)
460 99072 : prec_sh_idx = pbuf_get_index('PREC_SH', errcode=i)
461 99072 : snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=i)
462 99072 : prec_sed_idx = pbuf_get_index('PREC_SED', errcode=i)
463 99072 : snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=i)
464 99072 : prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=i)
465 99072 : snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=i)
466 99072 : srf_ozone_idx = pbuf_get_index('SRFOZONE', errcode=i)
467 99072 : lightning_idx = pbuf_get_index('LGHT_FLASH_FREQ', errcode=i)
468 :
469 99072 : if (prec_dp_idx > 0) then
470 99072 : call pbuf_get_field(pbuf, prec_dp_idx, prec_dp)
471 : end if
472 99072 : if (snow_dp_idx > 0) then
473 99072 : call pbuf_get_field(pbuf, snow_dp_idx, snow_dp)
474 : end if
475 99072 : if (prec_sh_idx > 0) then
476 99072 : call pbuf_get_field(pbuf, prec_sh_idx, prec_sh)
477 : end if
478 99072 : if (snow_sh_idx > 0) then
479 99072 : call pbuf_get_field(pbuf, snow_sh_idx, snow_sh)
480 : end if
481 99072 : if (prec_sed_idx > 0) then
482 99072 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed)
483 : end if
484 99072 : if (snow_sed_idx > 0) then
485 99072 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed)
486 : end if
487 99072 : if (prec_pcw_idx > 0) then
488 99072 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw)
489 : end if
490 99072 : if (snow_pcw_idx > 0) then
491 99072 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw)
492 : end if
493 :
494 1654272 : do i=1,ncol
495 1555200 : cam_out%tbot(i) = state%t(i,pver)
496 1555200 : cam_out%thbot(i) = state%t(i,pver) * state%exner(i,pver)
497 1555200 : cam_out%zbot(i) = state%zm(i,pver)
498 1555200 : cam_out%topo(i) = state%phis(i) / gravit
499 1555200 : cam_out%ubot(i) = state%u(i,pver)
500 1555200 : cam_out%vbot(i) = state%v(i,pver)
501 1555200 : cam_out%pbot(i) = state%pmid(i,pver)
502 1555200 : cam_out%psl(i) = psl(i)
503 1654272 : cam_out%rho(i) = cam_out%pbot(i)/(rair*cam_out%tbot(i))
504 : end do
505 4161024 : do m = 1, pcnst
506 67924224 : do i = 1, ncol
507 67825152 : cam_out%qbot(i,m) = state%q(i,pver,m)
508 : end do
509 : end do
510 :
511 1654272 : cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8
512 99072 : if (co2_transport()) then
513 0 : do i=1,ncol
514 0 : cam_out%co2prog(i) = state%q(i,pver,c_i(4)) * 1.0e+6_r8 *mwdry/mwco2
515 : end do
516 : end if
517 :
518 : ! get bottom layer ozone concentrations to export to surface models
519 99072 : if (srf_ozone_idx > 0) then
520 99072 : call pbuf_get_field(pbuf, srf_ozone_idx, srf_o3_ptr)
521 1654272 : cam_out%ozone(:ncol) = srf_o3_ptr(:ncol)
522 0 : else if (.not.simple_phys) then
523 0 : call rad_cnst_get_gas(0, 'O3', state, pbuf, o3_ptr)
524 0 : cam_out%ozone(:ncol) = o3_ptr(:ncol,pver) * mwdry/mwo3 ! mole/mole
525 : endif
526 :
527 : ! get cloud to ground lightning flash freq (/min) to export to surface models
528 99072 : if (lightning_idx>0) then
529 99072 : call pbuf_get_field(pbuf, lightning_idx, lightning_ptr)
530 1654272 : cam_out%lightning_flash_freq(:ncol) = lightning_ptr(:ncol)
531 : end if
532 :
533 : !
534 : ! Precipation and snow rates from shallow convection, deep convection and stratiform processes.
535 : ! Compute total convective and stratiform precipitation and snow rates
536 : !
537 1654272 : do i=1,ncol
538 1555200 : cam_out%precc (i) = 0._r8
539 1555200 : cam_out%precl (i) = 0._r8
540 1555200 : cam_out%precsc(i) = 0._r8
541 1555200 : cam_out%precsl(i) = 0._r8
542 1555200 : if (prec_dp_idx > 0) then
543 1555200 : cam_out%precc (i) = cam_out%precc (i) + prec_dp(i)
544 : end if
545 1555200 : if (prec_sh_idx > 0) then
546 1555200 : cam_out%precc (i) = cam_out%precc (i) + prec_sh(i)
547 : end if
548 1555200 : if (prec_sed_idx > 0) then
549 1555200 : cam_out%precl (i) = cam_out%precl (i) + prec_sed(i)
550 : end if
551 1555200 : if (prec_pcw_idx > 0) then
552 1555200 : cam_out%precl (i) = cam_out%precl (i) + prec_pcw(i)
553 : end if
554 1555200 : if (snow_dp_idx > 0) then
555 1555200 : cam_out%precsc(i) = cam_out%precsc(i) + snow_dp(i)
556 : end if
557 1555200 : if (snow_sh_idx > 0) then
558 1555200 : cam_out%precsc(i) = cam_out%precsc(i) + snow_sh(i)
559 : end if
560 1555200 : if (snow_sed_idx > 0) then
561 1555200 : cam_out%precsl(i) = cam_out%precsl(i) + snow_sed(i)
562 : end if
563 1555200 : if (snow_pcw_idx > 0) then
564 1555200 : cam_out%precsl(i) = cam_out%precsl(i) + snow_pcw(i)
565 : end if
566 :
567 : ! jrm These checks should not be necessary if they exist in the parameterizations
568 1555200 : if (cam_out%precc(i) .lt.0._r8) cam_out%precc(i)=0._r8
569 1555200 : if (cam_out%precl(i) .lt.0._r8) cam_out%precl(i)=0._r8
570 1555200 : if (cam_out%precsc(i).lt.0._r8) cam_out%precsc(i)=0._r8
571 1555200 : if (cam_out%precsl(i).lt.0._r8) cam_out%precsl(i)=0._r8
572 1555200 : if (cam_out%precsc(i).gt.cam_out%precc(i)) cam_out%precsc(i)=cam_out%precc(i)
573 1654272 : if (cam_out%precsl(i).gt.cam_out%precl(i)) cam_out%precsl(i)=cam_out%precl(i)
574 :
575 : end do
576 :
577 198144 : end subroutine cam_export
578 :
579 99072 : end module camsrfexch
|
