Line data Source code
1 : module atm_import_export
2 :
3 : use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected
4 : use NUOPC_Model , only : NUOPC_ModelGet
5 : use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet, ESMF_Field
6 : use ESMF , only : ESMF_Clock
7 : use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO
8 : use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError
9 : use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag
10 : use ESMF , only : operator(/=), operator(==)
11 : use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx
12 : use shr_sys_mod , only : shr_sys_abort
13 : use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max
14 : use nuopc_shr_methods , only : chkerr
15 : use cam_logfile , only : iulog
16 : use spmd_utils , only : masterproc, mpicom
17 : use srf_field_check , only : set_active_Sl_ram1
18 : use srf_field_check , only : set_active_Sl_fv
19 : use srf_field_check , only : set_active_Sl_soilw
20 : use srf_field_check , only : set_active_Fall_flxdst1
21 : use srf_field_check , only : set_active_Fall_flxvoc
22 : use srf_field_check , only : set_active_Fall_flxfire
23 : use srf_field_check , only : set_active_Fall_fco2_lnd
24 : use srf_field_check , only : set_active_Faoo_fco2_ocn
25 : use atm_stream_ndep , only : stream_ndep_init, stream_ndep_interp, stream_ndep_is_initialized
26 : use atm_stream_ndep , only : ndep_stream_active
27 : use chemistry , only : chem_has_ndep_flx
28 : use cam_control_mod , only : aqua_planet, simple_phys
29 :
30 : implicit none
31 : private ! except
32 :
33 : public :: read_surface_fields_namelists
34 : public :: advertise_fields
35 : public :: realize_fields
36 : public :: import_fields
37 : public :: export_fields
38 :
39 : private :: fldlist_add
40 : private :: fldlist_realize
41 : private :: state_getfldptr
42 :
43 : type fldlist_type
44 : character(len=128) :: stdname
45 : integer :: ungridded_lbound = 0
46 : integer :: ungridded_ubound = 0
47 : end type fldlist_type
48 :
49 : integer , parameter :: fldsMax = 100
50 : integer , public, protected :: fldsToAtm_num = 0
51 : integer , public, protected :: fldsFrAtm_num = 0
52 : type (fldlist_type) , public, protected :: fldsToAtm(fldsMax)
53 : type (fldlist_type) , public, protected :: fldsFrAtm(fldsMax)
54 :
55 : ! area correction factors for fluxes send and received from mediator
56 : real(r8), allocatable :: mod2med_areacor(:)
57 : real(r8), allocatable :: med2mod_areacor(:)
58 :
59 : character(len=cx) :: carma_fields = ' ' ! list of CARMA fields from lnd->atm
60 : integer :: drydep_nflds = -huge(1) ! number of dry deposition velocity fields lnd-> atm
61 : integer :: megan_nflds = -huge(1) ! number of MEGAN voc fields from lnd-> atm
62 : integer :: emis_nflds = -huge(1) ! number of fire emission fields from lnd-> atm
63 : logical :: atm_provides_lightning = .false. ! cld to grnd lightning flash freq (min-1)
64 : character(*),parameter :: F01 = "('(cam_import_export) ',a,i8,2x,i8,2x,d21.14)"
65 : character(*),parameter :: F02 = "('(cam_import_export) ',a,i8,2x,i8,2x,i8,2x,d21.14)"
66 : character(*),parameter :: u_FILE_u = __FILE__
67 :
68 : !===============================================================================
69 : contains
70 : !===============================================================================
71 :
72 : !-----------------------------------------------------------
73 : ! read mediator fields namelist file
74 : !-----------------------------------------------------------
75 1536 : subroutine read_surface_fields_namelists()
76 :
77 : use shr_drydep_mod , only : shr_drydep_readnl
78 : use shr_megan_mod , only : shr_megan_readnl
79 : use shr_fire_emis_mod , only : shr_fire_emis_readnl
80 : use shr_carma_mod , only : shr_carma_readnl
81 : use shr_lightning_coupling_mod, only : shr_lightning_coupling_readnl
82 :
83 : character(len=*), parameter :: nl_file_name = 'drv_flds_in'
84 :
85 : ! read mediator fields options
86 1536 : call shr_drydep_readnl(nl_file_name, drydep_nflds)
87 1536 : call shr_megan_readnl(nl_file_name, megan_nflds)
88 1536 : call shr_fire_emis_readnl(nl_file_name, emis_nflds)
89 1536 : call shr_carma_readnl(nl_file_name, carma_fields)
90 1536 : call shr_lightning_coupling_readnl(nl_file_name, atm_provides_lightning)
91 :
92 1536 : end subroutine read_surface_fields_namelists
93 :
94 : !-----------------------------------------------------------
95 : ! advertise fields
96 : !-----------------------------------------------------------
97 1536 : subroutine advertise_fields(gcomp, flds_scalar_name, rc)
98 :
99 : ! input/output variables
100 : type(ESMF_GridComp) :: gcomp
101 : character(len=*) , intent(in) :: flds_scalar_name
102 : integer , intent(out) :: rc
103 :
104 : ! local variables
105 : type(ESMF_State) :: importState
106 : type(ESMF_State) :: exportState
107 : character(ESMF_MAXSTR) :: stdname
108 : character(ESMF_MAXSTR) :: cvalue
109 : integer :: n, num
110 : logical :: flds_co2a ! use case
111 : logical :: flds_co2b ! use case
112 : logical :: flds_co2c ! use case
113 : character(len=128) :: fldname
114 : character(len=*), parameter :: subname='(atm_import_export:advertise_fields)'
115 : !-------------------------------------------------------------------------------
116 :
117 1536 : rc = ESMF_SUCCESS
118 :
119 1536 : call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc)
120 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
121 :
122 : !--------------------------------
123 : ! determine necessary toggles for below
124 : !--------------------------------
125 :
126 1536 : call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc)
127 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
128 1536 : read(cvalue,*) flds_co2a
129 1536 : if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2a = '// trim(cvalue)
130 :
131 1536 : call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc)
132 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
133 1536 : read(cvalue,*) flds_co2b
134 1536 : if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2b = '// trim(cvalue)
135 :
136 1536 : call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc)
137 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
138 1536 : read(cvalue,*) flds_co2c
139 1536 : if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2c = '// trim(cvalue)
140 :
141 : !--------------------------------
142 : ! Export fields
143 : !--------------------------------
144 :
145 1536 : if (masterproc) write(iulog,'(a)') trim(subname)//'export_fields '
146 :
147 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name))
148 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_topo' )
149 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_z' )
150 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_u' )
151 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_v' )
152 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_tbot' )
153 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_ptem' )
154 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_shum' )
155 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pbot' )
156 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' )
157 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' )
158 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_o3' )
159 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' )
160 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' )
161 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' )
162 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowl' )
163 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_lwdn' )
164 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndr' )
165 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdr' )
166 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndf' )
167 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdf' )
168 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swnet' ) ! only diagnostic
169 :
170 : ! from atm - black carbon deposition fluxes (3)
171 : ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet
172 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3)
173 :
174 : ! from atm - organic carbon deposition fluxes (3)
175 : ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet
176 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3)
177 :
178 : ! from atm - wet dust deposition frluxes (4 sizes)
179 : ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4
180 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4)
181 :
182 : ! from atm - dry dust deposition frluxes (4 sizes)
183 : ! (1) => dstdry1, (2) => dstdry2, (3) => dstdry3, (4) => dstdry4
184 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4)
185 :
186 1536 : call ESMF_LogWrite(subname//' export fields co2', ESMF_LOGMSG_INFO)
187 :
188 : ! from atm co2 fields
189 1536 : if (flds_co2a .or. flds_co2b .or. flds_co2c) then
190 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_co2prog' )
191 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_co2diag' )
192 : end if
193 :
194 : ! Nitrogen deposition fluxes
195 : ! Assume that 2 fields are always sent as part of Faxa_ndep
196 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2)
197 :
198 : ! lightning flash freq
199 1536 : if (atm_provides_lightning) then
200 1536 : call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning')
201 : end if
202 :
203 : ! Now advertise above export fields
204 1536 : if (masterproc) write(iulog,*) trim(subname)//' advertise export fields'
205 47616 : do n = 1,fldsFrAtm_num
206 46080 : call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, &
207 46080 : TransferOfferGeomObject='will provide', rc=rc)
208 47616 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
209 : enddo
210 :
211 : !-----------------
212 : ! Import fields
213 : !-----------------
214 :
215 1536 : if (masterproc) write(iulog,'(a)') trim(subname)//' import fields '
216 :
217 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name))
218 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' )
219 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdf' )
220 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidf' )
221 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdr' )
222 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_lfrac' )
223 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Si_ifrac' )
224 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ofrac' )
225 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_tref' )
226 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_qref' )
227 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_t' )
228 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_t' )
229 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_fv' ); call set_active_Sl_fv(.true.)
230 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_ram1' ); call set_active_Sl_ram1(.true.)
231 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_snowh' )
232 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Si_snowh' )
233 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ssq' )
234 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' )
235 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ustar' )
236 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' )
237 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ugustOut')
238 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_u10withGust')
239 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' )
240 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' )
241 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' )
242 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_sen' )
243 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lwup' )
244 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' )
245 :
246 : ! dust fluxes from land (4 sizes)
247 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4)
248 1536 : call set_active_Fall_flxdst1(.true.)
249 :
250 : ! co2 fields from land and ocean
251 1536 : if (flds_co2b .or. flds_co2c) then
252 0 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_fco2_lnd')
253 0 : call set_active_Fall_fco2_lnd(.true.)
254 : end if
255 1536 : if (flds_co2c) then
256 0 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faoo_fco2_ocn')
257 0 : call set_active_Faoo_fco2_ocn(.true.)
258 : end if
259 :
260 : ! dry deposition velocities from land - ALSO initialize drydep here
261 1536 : if (drydep_nflds > 0) then
262 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds)
263 : end if
264 :
265 : ! MEGAN VOC emissions fluxes from land
266 1536 : if (megan_nflds > 0) then
267 1536 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds)
268 1536 : call set_active_Fall_flxvoc(.true.)
269 : end if
270 :
271 : ! fire emissions fluxes from land
272 1536 : if (emis_nflds > 0) then
273 0 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds)
274 0 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_fztop')
275 0 : call set_active_Fall_flxfire(.true.)
276 : end if
277 :
278 : ! CARMA volumetric soil water from land
279 1536 : if (carma_fields /= ' ') then
280 0 : call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_soilw') ! optional for carma
281 0 : call set_active_Sl_soilw(.true.) ! check for carma
282 : end if
283 :
284 : ! ------------------------------------------
285 : ! Now advertise above import fields
286 : ! ------------------------------------------
287 1536 : call ESMF_LogWrite(trim(subname)//' advertise import fields ', ESMF_LOGMSG_INFO)
288 49152 : do n = 1,fldsToAtm_num
289 47616 : call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, &
290 47616 : TransferOfferGeomObject='will provide', rc=rc)
291 49152 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
292 : enddo
293 :
294 3072 : end subroutine advertise_fields
295 :
296 : !===============================================================================
297 :
298 1536 : subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, single_column, rc)
299 :
300 : use ESMF , only : ESMF_MeshGet, ESMF_StateGet
301 : use ESMF , only : ESMF_FieldRegridGetArea,ESMF_FieldGet
302 : use ppgrid , only : pcols, begchunk, endchunk
303 : use phys_grid , only : get_area_all_p, get_ncols_p
304 :
305 : ! input/output variables
306 : type(ESMF_GridComp) , intent(inout) :: gcomp
307 : type(ESMF_Mesh) , intent(in) :: Emesh
308 : character(len=*) , intent(in) :: flds_scalar_name
309 : integer , intent(in) :: flds_scalar_num
310 : logical , intent(in) :: single_column
311 : integer , intent(out) :: rc
312 :
313 : ! local variables
314 : type(ESMF_State) :: importState
315 : type(ESMF_State) :: exportState
316 : type(ESMF_Field) :: lfield
317 : integer :: numOwnedElements
318 : integer :: c,i,n,ncols
319 1536 : real(r8), allocatable :: mesh_areas(:)
320 1536 : real(r8), allocatable :: model_areas(:)
321 1536 : real(r8), allocatable :: area(:)
322 1536 : real(r8), pointer :: dataptr(:)
323 : real(r8) :: max_mod2med_areacor
324 : real(r8) :: max_med2mod_areacor
325 : real(r8) :: min_mod2med_areacor
326 : real(r8) :: min_med2mod_areacor
327 : real(r8) :: max_mod2med_areacor_glob
328 : real(r8) :: max_med2mod_areacor_glob
329 : real(r8) :: min_mod2med_areacor_glob
330 : real(r8) :: min_med2mod_areacor_glob
331 : character(len=cl) :: cvalue
332 : character(len=cl) :: mesh_atm
333 : character(len=cl) :: mesh_lnd
334 : character(len=cl) :: mesh_ocn
335 : logical :: samegrid_atm_lnd_ocn
336 : character(len=*), parameter :: subname='(atm_import_export:realize_fields)'
337 : !---------------------------------------------------------------------------
338 :
339 1536 : rc = ESMF_SUCCESS
340 :
341 1536 : call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO)
342 :
343 1536 : call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc)
344 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
345 :
346 : call fldlist_realize( &
347 : state=ExportState, &
348 : fldList=fldsFrAtm, &
349 : numflds=fldsFrAtm_num, &
350 : flds_scalar_name=flds_scalar_name, &
351 : flds_scalar_num=flds_scalar_num, &
352 : tag=subname//':camExport',&
353 1536 : mesh=Emesh, rc=rc)
354 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
355 :
356 : call fldlist_realize( &
357 : state=importState, &
358 : fldList=fldsToAtm, &
359 : numflds=fldsToAtm_num, &
360 : flds_scalar_name=flds_scalar_name, &
361 : flds_scalar_num=flds_scalar_num, &
362 : tag=subname//':camImport',&
363 1536 : mesh=Emesh, rc=rc)
364 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
365 :
366 : ! Determine if atm/lnd/ocn are on the same grid - if so set area correction factors to 1
367 1536 : call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=mesh_atm, rc=rc)
368 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
369 1536 : call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=mesh_lnd, rc=rc)
370 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
371 1536 : call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=mesh_ocn, rc=rc)
372 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
373 :
374 1536 : samegrid_atm_lnd_ocn = .false.
375 : if ( trim(mesh_lnd) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd) .and. &
376 1536 : trim(mesh_ocn) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then
377 : samegrid_atm_lnd_ocn = .true.
378 0 : elseif ( trim(mesh_lnd) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then
379 : samegrid_atm_lnd_ocn = .true.
380 0 : elseif ( trim(mesh_ocn) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd)) then
381 0 : samegrid_atm_lnd_ocn = .true.
382 : end if
383 :
384 : ! allocate area correction factors
385 1536 : call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc)
386 1536 : if (chkerr(rc,__LINE__,u_FILE_u)) return
387 4608 : allocate (mod2med_areacor(numOwnedElements))
388 3072 : allocate (med2mod_areacor(numOwnedElements))
389 :
390 1536 : if (single_column .or. samegrid_atm_lnd_ocn) then
391 :
392 112128 : mod2med_areacor(:) = 1._r8
393 112128 : med2mod_areacor(:) = 1._r8
394 :
395 : else
396 :
397 : ! Determine areas for regridding
398 0 : call ESMF_StateGet(exportState, itemName=trim(fldsFrAtm(2)%stdname), field=lfield, rc=rc)
399 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
400 0 : call ESMF_FieldRegridGetArea(lfield, rc=rc)
401 0 : if (chkerr(rc,__LINE__,u_FILE_u)) return
402 0 : call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc)
403 0 : if (chkerr(rc,__LINE__,u_FILE_u)) return
404 0 : allocate(mesh_areas(numOwnedElements))
405 0 : mesh_areas(:) = dataptr(:)
406 :
407 : ! Determine model areas
408 0 : allocate(model_areas(numOwnedElements))
409 0 : allocate(area(numOwnedElements))
410 0 : n = 0
411 0 : do c = begchunk, endchunk
412 0 : ncols = get_ncols_p(c)
413 0 : call get_area_all_p(c, ncols, area)
414 0 : do i = 1,ncols
415 0 : n = n + 1
416 0 : model_areas(n) = area(i)
417 : end do
418 : end do
419 0 : deallocate(area)
420 :
421 : ! Determine flux correction factors (module variables)
422 0 : do n = 1,numOwnedElements
423 0 : mod2med_areacor(n) = model_areas(n) / mesh_areas(n)
424 0 : med2mod_areacor(n) = 1._r8 / mod2med_areacor(n)
425 : end do
426 0 : deallocate(model_areas)
427 0 : deallocate(mesh_areas)
428 :
429 : end if
430 :
431 113664 : min_mod2med_areacor = minval(mod2med_areacor)
432 113664 : max_mod2med_areacor = maxval(mod2med_areacor)
433 113664 : min_med2mod_areacor = minval(med2mod_areacor)
434 113664 : max_med2mod_areacor = maxval(med2mod_areacor)
435 1536 : call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom)
436 1536 : call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom)
437 1536 : call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom)
438 1536 : call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom)
439 :
440 1536 : if (masterproc) then
441 2 : write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',&
442 4 : min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'CAM'
443 2 : write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',&
444 4 : min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'CAM'
445 : end if
446 :
447 1536 : call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
448 :
449 6144 : end subroutine realize_fields
450 :
451 : !===============================================================================
452 :
453 30720 : subroutine import_fields( gcomp, cam_in, restart_init, rc)
454 :
455 : ! -----------------------------------------------------
456 : ! Set field pointers in import state and
457 : ! copy from field pointer to chunk array data structure
458 : ! -----------------------------------------------------
459 :
460 1536 : use camsrfexch , only : cam_in_t
461 : use phys_grid , only : get_ncols_p
462 : use ppgrid , only : begchunk, endchunk
463 : use shr_const_mod , only : shr_const_stebol
464 : use co2_cycle , only : c_i, co2_readFlux_ocn, co2_readFlux_fuel
465 : use co2_cycle , only : co2_transport, co2_time_interp_ocn, co2_time_interp_fuel
466 : use co2_cycle , only : data_flux_ocn, data_flux_fuel
467 : use physconst , only : mwco2
468 : use time_manager , only : is_first_step, get_nstep
469 :
470 : ! input/output variabes
471 : type(ESMF_GridComp) :: gcomp
472 : type(cam_in_t) , intent(inout) :: cam_in(begchunk:endchunk)
473 : logical, optional , intent(in) :: restart_init
474 : integer , intent(out) :: rc
475 :
476 : ! local variables
477 : type(ESMF_State) :: importState
478 : integer :: i,n,c,g, num ! indices
479 : integer :: ncols ! number of columns
480 : integer :: nstep
481 : logical :: overwrite_flds
482 : logical :: exists
483 : logical :: exists_fco2_ocn
484 : logical :: exists_fco2_lnd
485 : character(len=128) :: fldname
486 15360 : real(r8), pointer :: fldptr2d(:,:)
487 15360 : real(r8), pointer :: fldptr1d(:)
488 15360 : real(r8), pointer :: fldptr_lat(:)
489 15360 : real(r8), pointer :: fldptr_lwup(:)
490 15360 : real(r8), pointer :: fldptr_avsdr(:)
491 15360 : real(r8), pointer :: fldptr_anidr(:)
492 15360 : real(r8), pointer :: fldptr_avsdf(:)
493 15360 : real(r8), pointer :: fldptr_anidf(:)
494 15360 : real(r8), pointer :: fldptr_tsurf(:)
495 15360 : real(r8), pointer :: fldptr_tocn(:)
496 15360 : real(r8), pointer :: fldptr_tref(:)
497 15360 : real(r8), pointer :: fldptr_qref(:)
498 15360 : real(r8), pointer :: fldptr_u10(:)
499 15360 : real(r8), pointer :: fldptr_snowhland(:)
500 15360 : real(r8), pointer :: fldptr_snowhice(:)
501 15360 : real(r8), pointer :: fldptr_ifrac(:)
502 15360 : real(r8), pointer :: fldptr_ofrac(:)
503 15360 : real(r8), pointer :: fldptr_lfrac(:)
504 15360 : real(r8), pointer :: fldptr_taux(:)
505 15360 : real(r8), pointer :: fldptr_tauy(:)
506 15360 : real(r8), pointer :: fldptr_sen(:)
507 15360 : real(r8), pointer :: fldptr_evap(:)
508 : logical, save :: first_time = .true.
509 : character(len=*), parameter :: subname='(atm_import_export:import_fields)'
510 : !---------------------------------------------------------------------------
511 :
512 15360 : rc = ESMF_SUCCESS
513 :
514 : ! Get import state
515 15360 : call NUOPC_ModelGet(gcomp, importState=importState, rc=rc)
516 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
517 :
518 : ! don't overwrite fields if invoked during the initialization phase
519 : ! of a 'continue' or 'branch' run type with data from .rs file
520 15360 : overwrite_flds = .true.
521 15360 : if (present(restart_init)) overwrite_flds = .not. restart_init
522 :
523 : !--------------------------
524 : ! Required atmosphere input fields
525 : !--------------------------
526 :
527 768 : if (overwrite_flds) then
528 14592 : call state_getfldptr(importState, 'Faxx_taux', fldptr=fldptr_taux, rc=rc)
529 14592 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
530 14592 : call state_getfldptr(importState, 'Faxx_tauy', fldptr=fldptr_tauy, rc=rc)
531 14592 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
532 14592 : call state_getfldptr(importState, 'Faxx_sen' , fldptr=fldptr_sen, rc=rc)
533 14592 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
534 14592 : call state_getfldptr(importState, 'Faxx_evap', fldptr=fldptr_evap, rc=rc)
535 14592 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
536 14592 : g = 1
537 87552 : do c = begchunk,endchunk
538 1138176 : do i = 1,get_ncols_p(c)
539 1050624 : cam_in(c)%wsx(i) = -fldptr_taux(g) * med2mod_areacor(g)
540 1050624 : cam_in(c)%wsy(i) = -fldptr_tauy(g) * med2mod_areacor(g)
541 1050624 : cam_in(c)%shf(i) = -fldptr_sen(g) * med2mod_areacor(g)
542 1050624 : cam_in(c)%cflx(i,1) = -fldptr_evap(g) * med2mod_areacor(g)
543 1123584 : g = g + 1
544 : end do
545 : end do
546 : end if ! end of overwrite_flds
547 :
548 15360 : call state_getfldptr(importState, 'Faxx_lat', fldptr=fldptr_lat, rc=rc)
549 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
550 15360 : call state_getfldptr(importState, 'Faxx_lwup', fldptr=fldptr_lwup, rc=rc)
551 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
552 15360 : call state_getfldptr(importState, 'Sx_avsdr', fldptr=fldptr_avsdr, rc=rc)
553 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
554 15360 : call state_getfldptr(importState, 'Sx_anidr', fldptr=fldptr_anidr, rc=rc)
555 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
556 15360 : call state_getfldptr(importState, 'Sx_avsdf', fldptr=fldptr_avsdf, rc=rc)
557 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
558 15360 : call state_getfldptr(importState, 'Sx_anidf', fldptr=fldptr_anidf, rc=rc)
559 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
560 15360 : call state_getfldptr(importState, 'Sx_t', fldptr=fldptr_tsurf, rc=rc)
561 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
562 15360 : call state_getfldptr(importState, 'So_t', fldptr=fldptr_tocn, rc=rc)
563 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
564 15360 : call state_getfldptr(importState, 'Sl_snowh', fldptr=fldptr_snowhland, rc=rc)
565 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
566 15360 : call state_getfldptr(importState, 'Si_snowh', fldptr=fldptr_snowhice, rc=rc)
567 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
568 15360 : call state_getfldptr(importState, 'Sx_tref', fldptr=fldptr_tref, rc=rc)
569 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
570 15360 : call state_getfldptr(importState, 'Sx_qref', fldptr=fldptr_qref, rc=rc)
571 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
572 15360 : call state_getfldptr(importState, 'Sx_u10', fldptr=fldptr_u10, rc=rc)
573 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
574 15360 : call state_getfldptr(importState, 'Si_ifrac', fldptr=fldptr_ifrac, rc=rc)
575 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
576 15360 : call state_getfldptr(importState, 'So_ofrac', fldptr=fldptr_ofrac, rc=rc)
577 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
578 15360 : call state_getfldptr(importState, 'Sl_lfrac', fldptr=fldptr_lfrac, rc=rc)
579 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
580 :
581 : ! Only do area correction on fluxes
582 15360 : g = 1
583 92160 : do c = begchunk,endchunk
584 1198080 : do i = 1,get_ncols_p(c)
585 1105920 : cam_in(c)%lhf(i) = -fldptr_lat(g) * med2mod_areacor(g)
586 1105920 : cam_in(c)%lwup(i) = -fldptr_lwup(g) * med2mod_areacor(g)
587 1105920 : cam_in(c)%asdir(i) = fldptr_avsdr(g)
588 1105920 : cam_in(c)%aldir(i) = fldptr_anidr(g)
589 1105920 : cam_in(c)%asdif(i) = fldptr_avsdf(g)
590 1105920 : cam_in(c)%aldif(i) = fldptr_anidf(g)
591 1105920 : cam_in(c)%ts(i) = fldptr_tsurf(g)
592 1105920 : cam_in(c)%sst(i) = fldptr_tocn(g)
593 1105920 : cam_in(c)%tref(i) = fldptr_tref(g)
594 1105920 : cam_in(c)%qref(i) = fldptr_qref(g)
595 1105920 : cam_in(c)%u10(i) = fldptr_u10(g)
596 1105920 : cam_in(c)%snowhland(i) = fldptr_snowhland(g)
597 1105920 : cam_in(c)%snowhice(i) = fldptr_snowhice(g)
598 1105920 : cam_in(c)%icefrac(i) = fldptr_ifrac(g)
599 1105920 : cam_in(c)%ocnfrac(i) = fldptr_ofrac(g)
600 1105920 : cam_in(c)%landfrac(i) = fldptr_lfrac(g)
601 1182720 : g = g + 1
602 : end do
603 : end do
604 :
605 : ! Optional fields
606 :
607 15360 : call state_getfldptr(importState, 'Sl_ram1', fldptr=fldptr1d, exists=exists, rc=rc)
608 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
609 15360 : if (exists) then
610 15360 : g = 1
611 92160 : do c = begchunk,endchunk
612 92160 : if ( associated(cam_in(c)%ram1) ) then
613 1182720 : do i = 1, get_ncols_p(c)
614 1105920 : cam_in(c)%ram1(i) = fldptr1d(g)
615 1182720 : g = g + 1
616 : end do
617 : end if
618 : end do
619 : end if
620 :
621 15360 : call state_getfldptr(importState, 'Sl_fv', fldptr=fldptr1d, exists=exists, rc=rc)
622 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
623 15360 : if (exists) then
624 15360 : g = 1
625 92160 : do c = begchunk,endchunk
626 92160 : if ( associated(cam_in(c)%fv) ) then
627 1182720 : do i = 1,get_ncols_p(c)
628 1105920 : cam_in(c)%fv(i) = fldptr1d(g)
629 1182720 : g = g + 1
630 : end do
631 : end if
632 : end do
633 : end if
634 :
635 : ! For CARMA - soil water from land
636 15360 : call state_getfldptr(importState, 'Sl_soilw', fldptr=fldptr1d, exists=exists, rc=rc)
637 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
638 15360 : if (exists) then
639 0 : g = 1
640 0 : do c = begchunk,endchunk
641 0 : if ( associated(cam_in(c)%soilw)) then
642 0 : do i = 1,get_ncols_p(c)
643 0 : cam_in(c)%soilw(i) = fldptr1d(g)
644 0 : g = g+1
645 : end do
646 : end if
647 : end do
648 : end if
649 :
650 : ! dry deposition fluxes from land
651 15360 : call state_getfldptr(importState, 'Fall_flxdst', fldptr2d=fldptr2d, exists=exists, rc=rc)
652 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
653 15360 : if (exists) then
654 15360 : g = 1
655 92160 : do c = begchunk,endchunk
656 92160 : if ( associated(cam_in(c)%dstflx) ) then
657 1182720 : do i = 1,get_ncols_p(c)
658 5529600 : do n = 1, size(fldptr2d, dim=1)
659 5529600 : cam_in(c)%dstflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g)
660 : end do
661 1182720 : g = g + 1
662 : end do
663 : end if
664 : end do
665 : end if
666 :
667 : ! MEGAN VOC emis fluxes from land
668 15360 : call state_getfldptr(importState, 'Fall_voc', fldptr2d=fldptr2d, exists=exists, rc=rc)
669 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
670 15360 : if (exists) then
671 15360 : g = 1
672 92160 : do c=begchunk,endchunk
673 92160 : if ( associated(cam_in(c)%meganflx) ) then
674 1182720 : do i = 1,get_ncols_p(c)
675 22118400 : do n = 1, size(fldptr2d, dim=1)
676 22118400 : cam_in(c)%meganflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g)
677 : end do
678 1182720 : g = g + 1
679 : end do
680 : end if
681 : end do
682 : end if
683 :
684 : ! fire emission fluxes from land
685 15360 : call state_getfldptr(importState, 'Fall_fire', fldptr2d=fldptr2d, exists=exists, rc=rc)
686 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
687 15360 : if (exists) then
688 0 : g = 1
689 0 : do c = begchunk,endchunk
690 0 : if ( associated(cam_in(c)%fireflx) .and. associated(cam_in(c)%fireztop) ) then
691 0 : do i = 1,get_ncols_p(c)
692 0 : do n = 1, size(fldptr2d, dim=1)
693 0 : cam_in(c)%fireflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g)
694 : end do
695 0 : g = g + 1
696 : end do
697 : end if
698 : end do
699 : end if
700 15360 : call state_getfldptr(importState, 'Sl_fztop', fldptr=fldptr1d, exists=exists, rc=rc)
701 15360 : if (exists) then
702 0 : g = 1
703 0 : do c = begchunk,endchunk
704 0 : do i = 1,get_ncols_p(c)
705 0 : cam_in(c)%fireztop(i) = fldptr1d(g)
706 0 : g = g + 1
707 : end do
708 : end do
709 : end if
710 :
711 : ! dry dep velocities
712 15360 : call state_getfldptr(importState, 'Sl_ddvel', fldptr2d=fldptr2d, exists=exists, rc=rc)
713 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
714 15360 : if (exists) then
715 15360 : g = 1
716 92160 : do c = begchunk,endchunk
717 1198080 : do i = 1,get_ncols_p(c)
718 112803840 : do n = 1, size(fldptr2d, dim=1)
719 112803840 : cam_in(c)%depvel(i,n) = fldptr2d(n,g)
720 : end do
721 1182720 : g = g + 1
722 : end do
723 : end do
724 : end if
725 :
726 : ! fields needed to calculate water isotopes to ocean evaporation processes
727 15360 : call state_getfldptr(importState, 'So_ustar', fldptr=fldptr1d, exists=exists, rc=rc)
728 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
729 15360 : if (exists) then
730 15360 : g = 1
731 92160 : do c = begchunk,endchunk
732 1198080 : do i = 1,get_ncols_p(c)
733 1105920 : cam_in(c)%ustar(i) = fldptr1d(g)
734 1182720 : g = g + 1
735 : end do
736 : end do
737 : end if
738 15360 : call state_getfldptr(importState, 'So_re', fldptr=fldptr1d, exists=exists, rc=rc)
739 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
740 15360 : if (exists) then
741 15360 : g = 1
742 92160 : do c = begchunk,endchunk
743 1198080 : do i = 1,get_ncols_p(c)
744 1105920 : cam_in(c)%re(i)= fldptr1d(g)
745 1182720 : g = g + 1
746 : end do
747 : end do
748 : end if
749 15360 : call state_getfldptr(importState, 'So_ssq', fldptr=fldptr1d, exists=exists, rc=rc)
750 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
751 15360 : if (exists) then
752 15360 : g = 1
753 92160 : do c = begchunk,endchunk
754 1198080 : do i = 1,get_ncols_p(c)
755 1105920 : cam_in(c)%ssq(i) = fldptr1d(g)
756 1182720 : g = g + 1
757 : end do
758 : end do
759 : end if
760 :
761 15360 : call state_getfldptr(importState, 'So_ugustOut', fldptr=fldptr1d, exists=exists, rc=rc)
762 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
763 15360 : if (exists) then
764 0 : g = 1
765 0 : do c = begchunk,endchunk
766 0 : do i = 1,get_ncols_p(c)
767 0 : cam_in(c)%ugustOut(i) = fldptr1d(g)
768 0 : g = g + 1
769 : end do
770 : end do
771 : end if
772 :
773 15360 : call state_getfldptr(importState, 'So_u10withGust', fldptr=fldptr1d, exists=exists, rc=rc)
774 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
775 15360 : if (exists) then
776 0 : g = 1
777 0 : do c = begchunk,endchunk
778 0 : do i = 1,get_ncols_p(c)
779 0 : cam_in(c)%u10withGusts(i) = fldptr1d(g)
780 0 : g = g + 1
781 : end do
782 : end do
783 : end if
784 :
785 : ! bgc scenarios
786 15360 : call state_getfldptr(importState, 'Fall_fco2_lnd', fldptr=fldptr1d, exists=exists_fco2_lnd, rc=rc)
787 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
788 15360 : if (exists_fco2_lnd) then
789 0 : g = 1
790 0 : do c = begchunk,endchunk
791 0 : do i = 1,get_ncols_p(c)
792 0 : cam_in(c)%fco2_lnd(i) = -fldptr1d(g) * med2mod_areacor(g)
793 0 : g = g + 1
794 : end do
795 : end do
796 : end if
797 15360 : call state_getfldptr(importState, 'Faoo_fco2_ocn', fldptr=fldptr1d, exists=exists_fco2_ocn, rc=rc)
798 15360 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
799 15360 : if (exists_fco2_ocn) then
800 0 : g = 1
801 0 : do c = begchunk,endchunk
802 0 : do i = 1,get_ncols_p(c)
803 0 : cam_in(c)%fco2_ocn(i) = -fldptr1d(g) * med2mod_areacor(g)
804 0 : g = g + 1
805 : end do
806 : end do
807 : else
808 : ! Consistency check
809 15360 : if (co2_readFlux_ocn) then
810 0 : call shr_sys_abort(subname // ':: co2_readFlux_ocn and x2a_Faoo_fco2_ocn cannot both be active')
811 : end if
812 : end if
813 15360 : call state_getfldptr(importState, 'Faoo_dms_ocn', fldptr=fldptr1d, exists=exists, rc=rc)
814 15360 : if (exists) then
815 0 : g = 1
816 0 : do c = begchunk,endchunk
817 0 : do i = 1,get_ncols_p(c)
818 0 : cam_in(c)%fdms(i) = -fldptr1d(g) * med2mod_areacor(g)
819 0 : g = g + 1
820 : end do
821 : end do
822 : end if
823 :
824 : ! -----------------------------------
825 : ! Get total co2 flux from components,
826 : ! -----------------------------------
827 :
828 : ! Note - co2_transport determines if cam_in(c)%cflx(i,c_i(1:4)) is allocated
829 :
830 15360 : if (co2_transport() .and. overwrite_flds) then
831 :
832 : ! Interpolate in time for flux data read in
833 0 : if (co2_readFlux_ocn) then
834 0 : call co2_time_interp_ocn
835 : end if
836 0 : if (co2_readFlux_fuel) then
837 0 : call co2_time_interp_fuel
838 : end if
839 :
840 : ! from ocn : data read in or from coupler or zero
841 : ! from fuel: data read in or zero
842 : ! from lnd : through coupler or zero
843 : ! all co2 fluxes in unit kgCO2/m2/s
844 :
845 0 : do c=begchunk,endchunk
846 0 : do i=1, get_ncols_p(c)
847 :
848 : ! co2 flux from ocn
849 0 : if (exists_fco2_ocn) then
850 0 : cam_in(c)%cflx(i,c_i(1)) = cam_in(c)%fco2_ocn(i)
851 0 : else if (co2_readFlux_ocn) then
852 : ! convert from molesCO2/m2/s to kgCO2/m2/s
853 0 : cam_in(c)%cflx(i,c_i(1)) = &
854 0 : -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in(c)%landfrac(i))*mwco2*1.0e-3_r8
855 : else
856 0 : cam_in(c)%cflx(i,c_i(1)) = 0._r8
857 : end if
858 :
859 : ! co2 flux from fossil fuel
860 0 : if (co2_readFlux_fuel) then
861 0 : cam_in(c)%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,c)
862 : else
863 0 : cam_in(c)%cflx(i,c_i(2)) = 0._r8
864 : end if
865 :
866 : ! co2 flux from land (cpl already multiplies flux by land fraction)
867 0 : if (exists_fco2_lnd) then
868 0 : cam_in(c)%cflx(i,c_i(3)) = cam_in(c)%fco2_lnd(i)
869 : else
870 0 : cam_in(c)%cflx(i,c_i(3)) = 0._r8
871 : end if
872 :
873 : ! merged co2 flux
874 0 : cam_in(c)%cflx(i,c_i(4)) = cam_in(c)%cflx(i,c_i(1)) + cam_in(c)%cflx(i,c_i(2)) + cam_in(c)%cflx(i,c_i(3))
875 : end do
876 : end do
877 : end if
878 :
879 : ! if first step, determine longwave up flux from the surface temperature
880 15360 : if (first_time) then
881 1536 : if (is_first_step()) then
882 4608 : do c=begchunk, endchunk
883 59904 : do i=1, get_ncols_p(c)
884 59136 : cam_in(c)%lwup(i) = shr_const_stebol*(cam_in(c)%ts(i)**4)
885 : end do
886 : end do
887 : end if
888 1536 : first_time = .false.
889 : end if
890 :
891 30720 : end subroutine import_fields
892 :
893 : !===============================================================================
894 :
895 33792 : subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc)
896 :
897 : ! -----------------------------------------------------
898 : ! Set field pointers in export set
899 : ! Copy from chunk array data structure into state fldptr
900 : ! -----------------------------------------------------
901 :
902 15360 : use camsrfexch , only : cam_out_t
903 : use phys_grid , only : get_ncols_p
904 : use ppgrid , only : begchunk, endchunk
905 : use time_manager , only : is_first_step, get_nstep
906 : use spmd_utils , only : masterproc
907 :
908 : !-------------------------------
909 : ! Pack the export state
910 : !-------------------------------
911 :
912 : ! input/output variables
913 : type(ESMF_GridComp) :: gcomp
914 : type(ESMF_Mesh) , intent(in) :: model_mesh
915 : type(ESMF_Clock), intent(in) :: model_clock
916 : type(cam_out_t) , intent(inout) :: cam_out(begchunk:endchunk)
917 : integer , intent(out) :: rc
918 :
919 : ! local variables
920 : type(ESMF_State) :: exportState
921 : type(ESMF_Clock) :: clock
922 : integer :: i,m,c,n,g ! indices
923 : integer :: ncols ! Number of columns
924 : integer :: nstep
925 : logical :: exists
926 : ! 2d pointers
927 16896 : real(r8), pointer :: fldptr_ndep(:,:)
928 16896 : real(r8), pointer :: fldptr_bcph(:,:) , fldptr_ocph(:,:)
929 16896 : real(r8), pointer :: fldptr_dstwet(:,:), fldptr_dstdry(:,:)
930 : ! 1d pointers
931 16896 : real(r8), pointer :: fldptr_soll(:) , fldptr_sols(:)
932 16896 : real(r8), pointer :: fldptr_solld(:) , fldptr_solsd(:)
933 16896 : real(r8), pointer :: fldptr_snowc(:) , fldptr_snowl(:)
934 16896 : real(r8), pointer :: fldptr_rainc(:) , fldptr_rainl(:)
935 16896 : real(r8), pointer :: fldptr_lwdn(:) , fldptr_swnet(:)
936 16896 : real(r8), pointer :: fldptr_topo(:) , fldptr_zbot(:)
937 16896 : real(r8), pointer :: fldptr_ubot(:) , fldptr_vbot(:)
938 16896 : real(r8), pointer :: fldptr_pbot(:) , fldptr_tbot(:)
939 16896 : real(r8), pointer :: fldptr_shum(:) , fldptr_dens(:)
940 16896 : real(r8), pointer :: fldptr_ptem(:) , fldptr_pslv(:)
941 16896 : real(r8), pointer :: fldptr_co2prog(:) , fldptr_co2diag(:)
942 16896 : real(r8), pointer :: fldptr_ozone(:)
943 16896 : real(r8), pointer :: fldptr_lght(:)
944 : character(len=*), parameter :: subname='(atm_import_export:export_fields)'
945 : !---------------------------------------------------------------------------
946 :
947 16896 : rc = ESMF_SUCCESS
948 :
949 : ! Get export state
950 16896 : call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc)
951 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
952 :
953 : ! required export state variables
954 16896 : call state_getfldptr(exportState, 'Sa_topo', fldptr=fldptr_topo, rc=rc)
955 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
956 16896 : call state_getfldptr(exportState, 'Sa_z' , fldptr=fldptr_zbot, rc=rc)
957 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
958 16896 : call state_getfldptr(exportState, 'Sa_u' , fldptr=fldptr_ubot, rc=rc)
959 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
960 16896 : call state_getfldptr(exportState, 'Sa_v' , fldptr=fldptr_vbot, rc=rc)
961 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
962 16896 : call state_getfldptr(exportState, 'Sa_tbot', fldptr=fldptr_tbot, rc=rc)
963 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
964 16896 : call state_getfldptr(exportState, 'Sa_pbot', fldptr=fldptr_pbot, rc=rc)
965 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
966 16896 : call state_getfldptr(exportState, 'Sa_shum', fldptr=fldptr_shum, rc=rc)
967 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
968 16896 : call state_getfldptr(exportState, 'Sa_dens', fldptr=fldptr_dens, rc=rc)
969 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
970 16896 : call state_getfldptr(exportState, 'Sa_ptem', fldptr=fldptr_ptem, rc=rc)
971 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
972 16896 : call state_getfldptr(exportState, 'Sa_pslv', fldptr=fldptr_pslv, rc=rc)
973 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
974 16896 : g = 1
975 101376 : do c = begchunk,endchunk
976 1317888 : do i = 1,get_ncols_p(c)
977 1216512 : fldptr_topo(g) = cam_out(c)%topo(i)
978 1216512 : fldptr_zbot(g) = cam_out(c)%zbot(i)
979 1216512 : fldptr_ubot(g) = cam_out(c)%ubot(i)
980 1216512 : fldptr_vbot(g) = cam_out(c)%vbot(i)
981 1216512 : fldptr_pbot(g) = cam_out(c)%pbot(i)
982 1216512 : fldptr_tbot(g) = cam_out(c)%tbot(i)
983 1216512 : fldptr_shum(g) = cam_out(c)%qbot(i,1)
984 1216512 : fldptr_dens(g) = cam_out(c)%rho(i)
985 1216512 : fldptr_ptem(g) = cam_out(c)%thbot(i)
986 1216512 : fldptr_pslv(g) = cam_out(c)%psl(i)
987 1300992 : g = g + 1
988 : end do
989 : end do
990 :
991 : ! required export flux variables
992 16896 : call state_getfldptr(exportState, 'Faxa_swnet', fldptr=fldptr_swnet, rc=rc)
993 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
994 16896 : call state_getfldptr(exportState, 'Faxa_lwdn' , fldptr=fldptr_lwdn , rc=rc)
995 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
996 16896 : call state_getfldptr(exportState, 'Faxa_rainc', fldptr=fldptr_rainc, rc=rc)
997 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
998 16896 : call state_getfldptr(exportState, 'Faxa_rainl', fldptr=fldptr_rainl, rc=rc)
999 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1000 16896 : call state_getfldptr(exportState, 'Faxa_snowc', fldptr=fldptr_snowc, rc=rc)
1001 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1002 16896 : call state_getfldptr(exportState, 'Faxa_snowl', fldptr=fldptr_snowl, rc=rc)
1003 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1004 16896 : call state_getfldptr(exportState, 'Faxa_swndr', fldptr=fldptr_soll, rc=rc)
1005 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1006 16896 : call state_getfldptr(exportState, 'Faxa_swvdr', fldptr=fldptr_sols, rc=rc)
1007 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1008 16896 : call state_getfldptr(exportState, 'Faxa_swndf', fldptr=fldptr_solld, rc=rc)
1009 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1010 16896 : call state_getfldptr(exportState, 'Faxa_swvdf', fldptr=fldptr_solsd, rc=rc)
1011 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1012 16896 : g = 1
1013 101376 : do c = begchunk,endchunk
1014 1317888 : do i = 1,get_ncols_p(c)
1015 1216512 : fldptr_lwdn(g) = cam_out(c)%flwds(i) * mod2med_areacor(g)
1016 1216512 : fldptr_swnet(g) = cam_out(c)%netsw(i) * mod2med_areacor(g)
1017 1216512 : fldptr_snowc(g) = cam_out(c)%precsc(i)*1000._r8 * mod2med_areacor(g)
1018 1216512 : fldptr_snowl(g) = cam_out(c)%precsl(i)*1000._r8 * mod2med_areacor(g)
1019 1216512 : fldptr_rainc(g) = (cam_out(c)%precc(i) - cam_out(c)%precsc(i))*1000._r8 * mod2med_areacor(g)
1020 1216512 : fldptr_rainl(g) = (cam_out(c)%precl(i) - cam_out(c)%precsl(i))*1000._r8 * mod2med_areacor(g)
1021 1216512 : fldptr_soll(g) = cam_out(c)%soll(i) * mod2med_areacor(g)
1022 1216512 : fldptr_sols(g) = cam_out(c)%sols(i) * mod2med_areacor(g)
1023 1216512 : fldptr_solld(g) = cam_out(c)%solld(i) * mod2med_areacor(g)
1024 1216512 : fldptr_solsd(g) = cam_out(c)%solsd(i) * mod2med_areacor(g)
1025 1300992 : g = g + 1
1026 : end do
1027 : end do
1028 :
1029 : ! aerosol deposition fluxes
1030 16896 : call state_getfldptr(exportState, 'Faxa_bcph', fldptr2d=fldptr_bcph, rc=rc)
1031 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1032 16896 : call state_getfldptr(exportState, 'Faxa_ocph', fldptr2d=fldptr_ocph, rc=rc)
1033 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1034 16896 : call state_getfldptr(exportState, 'Faxa_dstdry', fldptr2d=fldptr_dstdry, rc=rc)
1035 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1036 16896 : call state_getfldptr(exportState, 'Faxa_dstwet', fldptr2d=fldptr_dstwet, rc=rc)
1037 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1038 : ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet
1039 : ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet
1040 16896 : g = 1
1041 101376 : do c = begchunk,endchunk
1042 1317888 : do i = 1,get_ncols_p(c)
1043 1216512 : fldptr_bcph(1,g) = cam_out(c)%bcphidry(i) * mod2med_areacor(g)
1044 1216512 : fldptr_bcph(2,g) = cam_out(c)%bcphodry(i) * mod2med_areacor(g)
1045 1216512 : fldptr_bcph(3,g) = cam_out(c)%bcphiwet(i) * mod2med_areacor(g)
1046 1216512 : fldptr_ocph(1,g) = cam_out(c)%ocphidry(i) * mod2med_areacor(g)
1047 1216512 : fldptr_ocph(2,g) = cam_out(c)%ocphodry(i) * mod2med_areacor(g)
1048 1216512 : fldptr_ocph(3,g) = cam_out(c)%ocphiwet(i) * mod2med_areacor(g)
1049 1216512 : fldptr_dstdry(1,g) = cam_out(c)%dstdry1(i) * mod2med_areacor(g)
1050 1216512 : fldptr_dstdry(2,g) = cam_out(c)%dstdry2(i) * mod2med_areacor(g)
1051 1216512 : fldptr_dstdry(3,g) = cam_out(c)%dstdry3(i) * mod2med_areacor(g)
1052 1216512 : fldptr_dstdry(4,g) = cam_out(c)%dstdry4(i) * mod2med_areacor(g)
1053 1216512 : fldptr_dstwet(1,g) = cam_out(c)%dstwet1(i) * mod2med_areacor(g)
1054 1216512 : fldptr_dstwet(2,g) = cam_out(c)%dstwet2(i) * mod2med_areacor(g)
1055 1216512 : fldptr_dstwet(3,g) = cam_out(c)%dstwet3(i) * mod2med_areacor(g)
1056 1216512 : fldptr_dstwet(4,g) = cam_out(c)%dstwet4(i) * mod2med_areacor(g)
1057 1300992 : g = g + 1
1058 : end do
1059 : end do
1060 :
1061 16896 : call state_getfldptr(exportState, 'Sa_o3', fldptr=fldptr_ozone, exists=exists, rc=rc)
1062 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1063 16896 : if (exists) then
1064 16896 : g = 1
1065 101376 : do c = begchunk,endchunk
1066 1317888 : do i = 1,get_ncols_p(c)
1067 1216512 : fldptr_ozone(g) = cam_out(c)%ozone(i) ! atm ozone
1068 1300992 : g = g + 1
1069 : end do
1070 : end do
1071 : end if
1072 :
1073 16896 : call state_getfldptr(exportState, 'Sa_lightning', fldptr=fldptr_lght, exists=exists, rc=rc)
1074 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1075 16896 : if (exists) then
1076 16896 : g = 1
1077 101376 : do c = begchunk,endchunk
1078 1317888 : do i = 1,get_ncols_p(c)
1079 1216512 : fldptr_lght(g) = cam_out(c)%lightning_flash_freq(i) ! cloud-to-ground lightning flash frequency (/min)
1080 1300992 : g = g + 1
1081 : end do
1082 : end do
1083 : end if
1084 :
1085 16896 : call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc)
1086 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1087 16896 : if (exists) then
1088 16896 : g = 1
1089 101376 : do c = begchunk,endchunk
1090 1317888 : do i = 1,get_ncols_p(c)
1091 1216512 : fldptr_co2prog(g) = cam_out(c)%co2prog(i) ! atm prognostic co2
1092 1300992 : g = g + 1
1093 : end do
1094 : end do
1095 : end if
1096 :
1097 16896 : call state_getfldptr(exportState, 'Sa_co2diag', fldptr=fldptr_co2diag, exists=exists, rc=rc)
1098 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1099 16896 : if (exists) then
1100 16896 : g = 1
1101 101376 : do c = begchunk,endchunk
1102 1317888 : do i = 1,get_ncols_p(c)
1103 1216512 : fldptr_co2diag(g) = cam_out(c)%co2diag(i) ! atm diagnostic co2
1104 1300992 : g = g + 1
1105 : end do
1106 : end do
1107 : end if
1108 :
1109 16896 : call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, rc=rc)
1110 16896 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1111 :
1112 3666432 : fldptr_ndep(:,:) = 0._r8
1113 :
1114 16896 : if (.not. (simple_phys .or. aqua_planet)) then
1115 :
1116 : ! The ndep_stream_nl namelist group is read in stream_ndep_init. This sets whether
1117 : ! or not the stream will be used.
1118 16896 : if (.not. stream_ndep_is_initialized) then
1119 1536 : call stream_ndep_init(model_mesh, model_clock, rc)
1120 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1121 1536 : stream_ndep_is_initialized = .true.
1122 : end if
1123 :
1124 16896 : if (ndep_stream_active.or.chem_has_ndep_flx) then
1125 :
1126 : ! Nitrogen dep fluxes are obtained from the ndep input stream if input data is available
1127 : ! otherwise computed by chemistry
1128 16896 : if (ndep_stream_active) then
1129 :
1130 : ! get ndep fluxes from the stream
1131 0 : call stream_ndep_interp(cam_out, rc)
1132 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1133 :
1134 : end if
1135 :
1136 16896 : g = 1
1137 101376 : do c = begchunk,endchunk
1138 1317888 : do i = 1,get_ncols_p(c)
1139 1216512 : fldptr_ndep(1,g) = cam_out(c)%nhx_nitrogen_flx(i) * mod2med_areacor(g)
1140 1216512 : fldptr_ndep(2,g) = cam_out(c)%noy_nitrogen_flx(i) * mod2med_areacor(g)
1141 1300992 : g = g + 1
1142 : end do
1143 : end do
1144 :
1145 : end if
1146 :
1147 : end if
1148 :
1149 33792 : end subroutine export_fields
1150 :
1151 : !===============================================================================
1152 :
1153 93696 : subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound)
1154 :
1155 : ! input/otuput variables
1156 : integer , intent(inout) :: num
1157 : type(fldlist_type) , intent(inout) :: fldlist(:)
1158 : character(len=*) , intent(in) :: stdname
1159 : integer, optional , intent(in) :: ungridded_lbound
1160 : integer, optional , intent(in) :: ungridded_ubound
1161 :
1162 : ! local variables
1163 : character(len=*), parameter :: subname='(atm_import_export:fldlist_add)'
1164 : !-------------------------------------------------------------------------------
1165 :
1166 : ! Set up a list of field information
1167 :
1168 93696 : num = num + 1
1169 93696 : if (num > fldsMax) then
1170 : call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), &
1171 0 : ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__)
1172 0 : return
1173 : endif
1174 93696 : fldlist(num)%stdname = trim(stdname)
1175 :
1176 93696 : if (present(ungridded_lbound) .and. present(ungridded_ubound)) then
1177 12288 : fldlist(num)%ungridded_lbound = ungridded_lbound
1178 12288 : fldlist(num)%ungridded_ubound = ungridded_ubound
1179 : end if
1180 :
1181 16896 : end subroutine fldlist_add
1182 :
1183 : !===============================================================================
1184 :
1185 3072 : subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc)
1186 :
1187 : use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize
1188 : use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8
1189 : use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove
1190 : use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS
1191 : use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU
1192 :
1193 : ! input/output variables
1194 : type(ESMF_State) , intent(inout) :: state
1195 : type(fldlist_type) , intent(in) :: fldList(:)
1196 : integer , intent(in) :: numflds
1197 : character(len=*) , intent(in) :: flds_scalar_name
1198 : integer , intent(in) :: flds_scalar_num
1199 : character(len=*) , intent(in) :: tag
1200 : type(ESMF_Mesh) , intent(in) :: mesh
1201 : integer , intent(inout) :: rc
1202 :
1203 : ! local variables
1204 : integer :: n
1205 : type(ESMF_Field) :: field
1206 : character(len=80) :: stdname
1207 : character(CL) :: msg
1208 : character(len=*),parameter :: subname='(atm_import_export:fldlist_realize)'
1209 : ! ----------------------------------------------
1210 :
1211 3072 : rc = ESMF_SUCCESS
1212 :
1213 99840 : do n = 1, numflds
1214 93696 : stdname = fldList(n)%stdname
1215 96768 : if (NUOPC_IsConnected(state, fieldName=stdname)) then
1216 90624 : if (stdname == trim(flds_scalar_name)) then
1217 3072 : if (masterproc) then
1218 4 : write(iulog,'(a)') trim(subname)//trim(tag)//" field = "//trim(stdname)//" is connected on root pe"
1219 : end if
1220 : ! Create the scalar field
1221 3072 : call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc)
1222 3072 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1223 : else
1224 : ! Create the field
1225 87552 : if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then
1226 : field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, &
1227 : ungriddedLbound=(/fldlist(n)%ungridded_lbound/), &
1228 : ungriddedUbound=(/fldlist(n)%ungridded_ubound/), &
1229 36864 : gridToFieldMap=(/2/), rc=rc)
1230 12288 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1231 12288 : if (masterproc) then
1232 : write(iulog,'(a,i8,a,i8)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// &
1233 16 : " is connected using mesh with lbound ", fldlist(n)%ungridded_lbound,&
1234 32 : " and with ubound ",fldlist(n)%ungridded_ubound
1235 : end if
1236 : else
1237 75264 : field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
1238 75264 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1239 75264 : if (masterproc) then
1240 98 : write(iulog,'(a)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// " is connected using mesh "
1241 : end if
1242 : end if
1243 : endif
1244 :
1245 : ! NOW call NUOPC_Realize
1246 90624 : call NUOPC_Realize(state, field=field, rc=rc)
1247 90624 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1248 : else
1249 3072 : if (stdname /= trim(flds_scalar_name)) then
1250 3072 : if (masterproc) then
1251 4 : write(iulog,'(a)')trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is not connected"
1252 : end if
1253 6144 : call ESMF_StateRemove(state, (/stdname/), rc=rc)
1254 3072 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1255 : end if
1256 : end if
1257 : end do
1258 :
1259 : contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1260 :
1261 3072 : subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc)
1262 : ! ----------------------------------------------
1263 : ! create a field with scalar data on the root pe
1264 : ! ----------------------------------------------
1265 :
1266 3072 : use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid
1267 : use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU
1268 : use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8
1269 :
1270 : ! input/output variables
1271 : type(ESMF_Field) , intent(inout) :: field
1272 : character(len=*) , intent(in) :: flds_scalar_name
1273 : integer , intent(in) :: flds_scalar_num
1274 : integer , intent(inout) :: rc
1275 :
1276 : ! local variables
1277 : type(ESMF_Distgrid) :: distgrid
1278 : type(ESMF_Grid) :: grid
1279 : character(len=*), parameter :: subname='(atm_import_export:SetScalarField)'
1280 : ! ----------------------------------------------
1281 :
1282 3072 : rc = ESMF_SUCCESS
1283 :
1284 : ! create a DistGrid with a single index space element, which gets mapped onto DE 0.
1285 3072 : distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc)
1286 3072 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1287 :
1288 3072 : grid = ESMF_GridCreate(distgrid, rc=rc)
1289 3072 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1290 :
1291 : field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, typekind=ESMF_TYPEKIND_R8, &
1292 6144 : ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), gridToFieldMap=(/2/), rc=rc)
1293 3072 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
1294 :
1295 6144 : end subroutine SetScalarField
1296 :
1297 : end subroutine fldlist_realize
1298 :
1299 : !===============================================================================
1300 1039872 : subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc)
1301 :
1302 : ! ----------------------------------------------
1303 : ! Get pointer to a state field
1304 : ! ----------------------------------------------
1305 :
1306 : use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag
1307 : use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet
1308 : use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE
1309 :
1310 : ! input/output variables
1311 : type(ESMF_State) , intent(in) :: State
1312 : character(len=*) , intent(in) :: fldname
1313 : real(R8), optional, pointer :: fldptr(:)
1314 : real(R8), optional, pointer :: fldptr2d(:,:)
1315 : logical , optional, intent(out) :: exists
1316 : integer , intent(out) :: rc
1317 :
1318 : ! local variables
1319 : type(ESMF_FieldStatus_Flag) :: status
1320 : type(ESMF_StateItem_Flag) :: itemFlag
1321 : type(ESMF_Field) :: lfield
1322 : type(ESMF_Mesh) :: lmesh
1323 : integer :: nnodes, nelements
1324 : logical :: lexists
1325 : character(len=*), parameter :: subname='(atm_import_export:state_getfldptr)'
1326 : ! ----------------------------------------------
1327 :
1328 1039872 : rc = ESMF_SUCCESS
1329 :
1330 1039872 : lexists = .true.
1331 :
1332 : ! Determine if field with name fldname exists in state
1333 1039872 : if (present(exists)) then
1334 313344 : call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc)
1335 313344 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1336 313344 : if (itemflag == ESMF_STATEITEM_NOTFOUND) then
1337 : lexists = .false.
1338 : end if
1339 313344 : exists = lexists
1340 : end if
1341 :
1342 : if (lexists) then
1343 916992 : call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc)
1344 916992 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1345 916992 : if (present(fldptr)) then
1346 786432 : call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc)
1347 786432 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1348 130560 : else if (present(fldptr2d)) then
1349 130560 : call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc)
1350 130560 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1351 : end if
1352 : end if
1353 :
1354 2079744 : end subroutine state_getfldptr
1355 :
1356 1039872 : end module atm_import_export
|
