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