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 1536 : 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 1536 : if ( .not. phys_grid_initialized() ) call endrun(sub//": phys_grid not called yet")
150 4608 : allocate (cam_in(begchunk:endchunk), stat=ierror)
151 1536 : if ( ierror /= 0 )then
152 0 : write(iulog,*) sub//': Allocation error: ', ierror
153 0 : call endrun(sub//': allocation error')
154 : end if
155 :
156 7728 : do c = begchunk,endchunk
157 6192 : nullify(cam_in(c)%ram1)
158 6192 : nullify(cam_in(c)%fv)
159 6192 : nullify(cam_in(c)%soilw)
160 6192 : nullify(cam_in(c)%depvel)
161 6192 : nullify(cam_in(c)%dstflx)
162 6192 : nullify(cam_in(c)%meganflx)
163 6192 : nullify(cam_in(c)%fireflx)
164 7728 : nullify(cam_in(c)%fireztop)
165 : enddo
166 7728 : do c = begchunk,endchunk
167 6192 : if (active_Sl_ram1) then
168 6192 : allocate (cam_in(c)%ram1(pcols), stat=ierror)
169 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error ram1')
170 : endif
171 6192 : if (active_Sl_fv) then
172 6192 : allocate (cam_in(c)%fv(pcols), stat=ierror)
173 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error fv')
174 : endif
175 6192 : 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 6192 : if (active_Fall_flxdst1) then
180 : ! Assume 4 bins from surface model ....
181 6192 : allocate (cam_in(c)%dstflx(pcols,4), stat=ierror)
182 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error dstflx')
183 : endif
184 7728 : if (active_Fall_flxvoc .and. shr_megan_mechcomps_n>0) then
185 18576 : allocate (cam_in(c)%meganflx(pcols,shr_megan_mechcomps_n), stat=ierror)
186 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error meganflx')
187 : endif
188 : end do
189 :
190 1536 : if (n_drydep>0) then
191 7728 : do c = begchunk,endchunk
192 18576 : allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror)
193 7728 : if ( ierror /= 0 ) call endrun(sub//': allocation error depvel')
194 : end do
195 : endif
196 :
197 1536 : 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 7728 : do c = begchunk,endchunk
207 6192 : cam_in(c)%lchnk = c
208 6192 : cam_in(c)%ncol = get_ncols_p(c)
209 105264 : cam_in(c)%asdir (:) = 0._r8
210 105264 : cam_in(c)%asdif (:) = 0._r8
211 105264 : cam_in(c)%aldir (:) = 0._r8
212 105264 : cam_in(c)%aldif (:) = 0._r8
213 105264 : cam_in(c)%lwup (:) = 0._r8
214 105264 : cam_in(c)%lhf (:) = 0._r8
215 105264 : cam_in(c)%shf (:) = 0._r8
216 105264 : cam_in(c)%wsx (:) = 0._r8
217 105264 : cam_in(c)%wsy (:) = 0._r8
218 105264 : cam_in(c)%tref (:) = 0._r8
219 105264 : cam_in(c)%qref (:) = 0._r8
220 105264 : cam_in(c)%u10 (:) = 0._r8
221 105264 : cam_in(c)%ugustOut (:) = 0._r8
222 105264 : cam_in(c)%u10withGusts (:) = 0._r8
223 105264 : cam_in(c)%ts (:) = 0._r8
224 105264 : cam_in(c)%sst (:) = 0._r8
225 105264 : cam_in(c)%snowhland(:) = 0._r8
226 105264 : cam_in(c)%snowhice (:) = 0._r8
227 105264 : cam_in(c)%fco2_lnd (:) = 0._r8
228 105264 : cam_in(c)%fco2_ocn (:) = 0._r8
229 105264 : cam_in(c)%fdms (:) = 0._r8
230 6192 : cam_in(c)%landfrac (:) = posinf
231 6192 : cam_in(c)%icefrac (:) = posinf
232 6192 : cam_in(c)%ocnfrac (:) = posinf
233 :
234 6192 : if (associated(cam_in(c)%ram1)) &
235 105264 : cam_in(c)%ram1 (:) = 0.1_r8
236 6192 : if (associated(cam_in(c)%fv)) &
237 105264 : cam_in(c)%fv (:) = 0.1_r8
238 6192 : if (associated(cam_in(c)%soilw)) &
239 0 : cam_in(c)%soilw (:) = 0.0_r8
240 6192 : if (associated(cam_in(c)%dstflx)) &
241 427248 : cam_in(c)%dstflx(:,:) = 0.0_r8
242 6192 : if (associated(cam_in(c)%meganflx)) &
243 111456 : cam_in(c)%meganflx(:,:) = 0.0_r8
244 :
245 4322016 : cam_in(c)%cflx (:,:) = 0._r8
246 105264 : cam_in(c)%ustar (:) = 0._r8
247 105264 : cam_in(c)%re (:) = 0._r8
248 105264 : cam_in(c)%ssq (:) = 0._r8
249 6192 : if (n_drydep>0) then
250 532512 : cam_in(c)%depvel (:,:) = 0._r8
251 : endif
252 7728 : 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 1536 : end subroutine hub2atm_alloc
259 :
260 : !===============================================================================
261 :
262 1536 : 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 1536 : if (.not. phys_grid_initialized()) call endrun(sub//": phys_grid not called yet")
277 4608 : allocate (cam_out(begchunk:endchunk), stat=ierror)
278 1536 : 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 7728 : do c = begchunk,endchunk
284 6192 : cam_out(c)%lchnk = c
285 6192 : cam_out(c)%ncol = get_ncols_p(c)
286 105264 : cam_out(c)%tbot(:) = 0._r8
287 105264 : cam_out(c)%zbot(:) = 0._r8
288 105264 : cam_out(c)%topo(:) = 0._r8
289 105264 : cam_out(c)%ubot(:) = 0._r8
290 105264 : cam_out(c)%vbot(:) = 0._r8
291 4322016 : cam_out(c)%qbot(:,:) = 0._r8
292 105264 : cam_out(c)%pbot(:) = 0._r8
293 105264 : cam_out(c)%rho(:) = 0._r8
294 105264 : cam_out(c)%netsw(:) = 0._r8
295 105264 : cam_out(c)%flwds(:) = 0._r8
296 105264 : cam_out(c)%precsc(:) = 0._r8
297 105264 : cam_out(c)%precsl(:) = 0._r8
298 105264 : cam_out(c)%precc(:) = 0._r8
299 105264 : cam_out(c)%precl(:) = 0._r8
300 105264 : cam_out(c)%soll(:) = 0._r8
301 105264 : cam_out(c)%sols(:) = 0._r8
302 105264 : cam_out(c)%solld(:) = 0._r8
303 105264 : cam_out(c)%solsd(:) = 0._r8
304 105264 : cam_out(c)%thbot(:) = 0._r8
305 105264 : cam_out(c)%co2prog(:) = 0._r8
306 105264 : cam_out(c)%co2diag(:) = 0._r8
307 105264 : cam_out(c)%ozone(:) = 0._r8
308 105264 : cam_out(c)%lightning_flash_freq(:) = 0._r8
309 105264 : cam_out(c)%psl(:) = 0._r8
310 105264 : cam_out(c)%bcphidry(:) = 0._r8
311 105264 : cam_out(c)%bcphodry(:) = 0._r8
312 105264 : cam_out(c)%bcphiwet(:) = 0._r8
313 105264 : cam_out(c)%ocphidry(:) = 0._r8
314 105264 : cam_out(c)%ocphodry(:) = 0._r8
315 105264 : cam_out(c)%ocphiwet(:) = 0._r8
316 105264 : cam_out(c)%dstdry1(:) = 0._r8
317 105264 : cam_out(c)%dstwet1(:) = 0._r8
318 105264 : cam_out(c)%dstdry2(:) = 0._r8
319 105264 : cam_out(c)%dstwet2(:) = 0._r8
320 105264 : cam_out(c)%dstdry3(:) = 0._r8
321 105264 : cam_out(c)%dstwet3(:) = 0._r8
322 105264 : cam_out(c)%dstdry4(:) = 0._r8
323 105264 : cam_out(c)%dstwet4(:) = 0._r8
324 :
325 6192 : nullify(cam_out(c)%nhx_nitrogen_flx)
326 6192 : nullify(cam_out(c)%noy_nitrogen_flx)
327 :
328 7728 : if (.not.(simple_phys .or. aqua_planet)) then
329 :
330 6192 : allocate (cam_out(c)%nhx_nitrogen_flx(pcols), stat=ierror)
331 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error nhx_nitrogen_flx')
332 105264 : cam_out(c)%nhx_nitrogen_flx(:) = 0._r8
333 :
334 6192 : allocate (cam_out(c)%noy_nitrogen_flx(pcols), stat=ierror)
335 6192 : if ( ierror /= 0 ) call endrun(sub//': allocation error noy_nitrogen_flx')
336 105264 : cam_out(c)%noy_nitrogen_flx(:) = 0._r8
337 :
338 : endif
339 :
340 : end do
341 :
342 1536 : end subroutine atm2hub_alloc
343 :
344 : !===============================================================================
345 :
346 1536 : subroutine atm2hub_deallocate(cam_out)
347 :
348 : type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input
349 : !-----------------------------------------------------------------------
350 :
351 1536 : if(associated(cam_out)) then
352 1536 : deallocate(cam_out)
353 : end if
354 1536 : nullify(cam_out)
355 :
356 1536 : end subroutine atm2hub_deallocate
357 :
358 : !===============================================================================
359 :
360 1536 : 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 1536 : if(associated(cam_in)) then
368 7728 : do c=begchunk,endchunk
369 6192 : if(associated(cam_in(c)%ram1)) then
370 6192 : deallocate(cam_in(c)%ram1)
371 6192 : nullify(cam_in(c)%ram1)
372 : end if
373 6192 : if(associated(cam_in(c)%fv)) then
374 6192 : deallocate(cam_in(c)%fv)
375 6192 : nullify(cam_in(c)%fv)
376 : end if
377 6192 : 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 6192 : if(associated(cam_in(c)%dstflx)) then
382 6192 : deallocate(cam_in(c)%dstflx)
383 6192 : nullify(cam_in(c)%dstflx)
384 : end if
385 6192 : if(associated(cam_in(c)%meganflx)) then
386 6192 : deallocate(cam_in(c)%meganflx)
387 6192 : nullify(cam_in(c)%meganflx)
388 : end if
389 7728 : if(associated(cam_in(c)%depvel)) then
390 6192 : deallocate(cam_in(c)%depvel)
391 6192 : nullify(cam_in(c)%depvel)
392 : end if
393 :
394 : enddo
395 :
396 1536 : deallocate(cam_in)
397 : end if
398 1536 : nullify(cam_in)
399 :
400 1536 : end subroutine hub2atm_deallocate
401 :
402 :
403 : !======================================================================
404 :
405 65016 : 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 65016 : real(r8), pointer :: psl(:)
439 :
440 65016 : real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection
441 65016 : real(r8), pointer :: snow_dp(:) ! snow from ZM convection
442 65016 : real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection
443 65016 : real(r8), pointer :: snow_sh(:) ! snow from Hack convection
444 65016 : real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection
445 65016 : real(r8), pointer :: snow_sed(:) ! snow from ZM convection
446 65016 : real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection
447 65016 : real(r8), pointer :: snow_pcw(:) ! snow from Hack convection
448 65016 : real(r8), pointer :: o3_ptr(:,:), srf_o3_ptr(:)
449 65016 : real(r8), pointer :: lightning_ptr(:)
450 : !-----------------------------------------------------------------------
451 :
452 65016 : lchnk = state%lchnk
453 65016 : ncol = state%ncol
454 :
455 130032 : psl_idx = pbuf_get_index('PSL')
456 65016 : call pbuf_get_field(pbuf, psl_idx, psl)
457 :
458 65016 : prec_dp_idx = pbuf_get_index('PREC_DP', errcode=i)
459 65016 : snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=i)
460 65016 : prec_sh_idx = pbuf_get_index('PREC_SH', errcode=i)
461 65016 : snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=i)
462 65016 : prec_sed_idx = pbuf_get_index('PREC_SED', errcode=i)
463 65016 : snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=i)
464 65016 : prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=i)
465 65016 : snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=i)
466 65016 : srf_ozone_idx = pbuf_get_index('SRFOZONE', errcode=i)
467 65016 : lightning_idx = pbuf_get_index('LGHT_FLASH_FREQ', errcode=i)
468 :
469 65016 : if (prec_dp_idx > 0) then
470 65016 : call pbuf_get_field(pbuf, prec_dp_idx, prec_dp)
471 : end if
472 65016 : if (snow_dp_idx > 0) then
473 65016 : call pbuf_get_field(pbuf, snow_dp_idx, snow_dp)
474 : end if
475 65016 : if (prec_sh_idx > 0) then
476 65016 : call pbuf_get_field(pbuf, prec_sh_idx, prec_sh)
477 : end if
478 65016 : if (snow_sh_idx > 0) then
479 65016 : call pbuf_get_field(pbuf, snow_sh_idx, snow_sh)
480 : end if
481 65016 : if (prec_sed_idx > 0) then
482 65016 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed)
483 : end if
484 65016 : if (snow_sed_idx > 0) then
485 65016 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed)
486 : end if
487 65016 : if (prec_pcw_idx > 0) then
488 65016 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw)
489 : end if
490 65016 : if (snow_pcw_idx > 0) then
491 65016 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw)
492 : end if
493 :
494 1085616 : do i=1,ncol
495 1020600 : cam_out%tbot(i) = state%t(i,pver)
496 1020600 : cam_out%thbot(i) = state%t(i,pver) * state%exner(i,pver)
497 1020600 : cam_out%zbot(i) = state%zm(i,pver)
498 1020600 : cam_out%topo(i) = state%phis(i) / gravit
499 1020600 : cam_out%ubot(i) = state%u(i,pver)
500 1020600 : cam_out%vbot(i) = state%v(i,pver)
501 1020600 : cam_out%pbot(i) = state%pmid(i,pver)
502 1020600 : cam_out%psl(i) = psl(i)
503 1085616 : cam_out%rho(i) = cam_out%pbot(i)/(rair*cam_out%tbot(i))
504 : end do
505 2730672 : do m = 1, pcnst
506 44575272 : do i = 1, ncol
507 44510256 : cam_out%qbot(i,m) = state%q(i,pver,m)
508 : end do
509 : end do
510 :
511 1085616 : cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8
512 65016 : 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 65016 : if (srf_ozone_idx > 0) then
520 65016 : call pbuf_get_field(pbuf, srf_ozone_idx, srf_o3_ptr)
521 1085616 : 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 65016 : if (lightning_idx>0) then
529 65016 : call pbuf_get_field(pbuf, lightning_idx, lightning_ptr)
530 1085616 : 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 1085616 : do i=1,ncol
538 1020600 : cam_out%precc (i) = 0._r8
539 1020600 : cam_out%precl (i) = 0._r8
540 1020600 : cam_out%precsc(i) = 0._r8
541 1020600 : cam_out%precsl(i) = 0._r8
542 1020600 : if (prec_dp_idx > 0) then
543 1020600 : cam_out%precc (i) = cam_out%precc (i) + prec_dp(i)
544 : end if
545 1020600 : if (prec_sh_idx > 0) then
546 1020600 : cam_out%precc (i) = cam_out%precc (i) + prec_sh(i)
547 : end if
548 1020600 : if (prec_sed_idx > 0) then
549 1020600 : cam_out%precl (i) = cam_out%precl (i) + prec_sed(i)
550 : end if
551 1020600 : if (prec_pcw_idx > 0) then
552 1020600 : cam_out%precl (i) = cam_out%precl (i) + prec_pcw(i)
553 : end if
554 1020600 : if (snow_dp_idx > 0) then
555 1020600 : cam_out%precsc(i) = cam_out%precsc(i) + snow_dp(i)
556 : end if
557 1020600 : if (snow_sh_idx > 0) then
558 1020600 : cam_out%precsc(i) = cam_out%precsc(i) + snow_sh(i)
559 : end if
560 1020600 : if (snow_sed_idx > 0) then
561 1020600 : cam_out%precsl(i) = cam_out%precsl(i) + snow_sed(i)
562 : end if
563 1020600 : if (snow_pcw_idx > 0) then
564 1020600 : 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 1020600 : if (cam_out%precc(i) .lt.0._r8) cam_out%precc(i)=0._r8
569 1020600 : if (cam_out%precl(i) .lt.0._r8) cam_out%precl(i)=0._r8
570 1020600 : if (cam_out%precsc(i).lt.0._r8) cam_out%precsc(i)=0._r8
571 1020600 : if (cam_out%precsl(i).lt.0._r8) cam_out%precsl(i)=0._r8
572 1020600 : if (cam_out%precsc(i).gt.cam_out%precc(i)) cam_out%precsc(i)=cam_out%precc(i)
573 1085616 : if (cam_out%precsl(i).gt.cam_out%precl(i)) cam_out%precsl(i)=cam_out%precl(i)
574 :
575 : end do
576 :
577 130032 : end subroutine cam_export
578 :
579 65016 : end module camsrfexch
|
