Line data Source code
1 : module atm_comp_nuopc
2 :
3 : !----------------------------------------------------------------------------
4 : ! This is the NUOPC cap for CAM
5 : !----------------------------------------------------------------------------
6 :
7 : use ESMF , only : operator(<=), operator(>), operator(==), operator(+)
8 : use ESMF , only : ESMF_MethodRemove
9 : use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_State, ESMF_StateGet
10 : use ESMF , only : ESMF_Grid, ESMF_GridCreateNoPeriDimUfrm, ESMF_Field, ESMF_FieldGet
11 : use ESMF , only : ESMF_DistGrid, ESMF_DistGridCreate
12 : use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_MeshGet, ESMF_FILEFORMAT_ESMFMESH
13 : use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockGetNextTime, ESMF_ClockAdvance
14 : use ESMF , only : ESMF_Time, ESMF_TimeGet
15 : use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmRingerOff, ESMF_AlarmIsRinging
16 : use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL, ESMF_AlarmSet
17 : use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet
18 : use ESMF , only : ESMF_CalKind_Flag, ESMF_MAXSTR, ESMF_KIND_I8
19 : use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN
20 : use ESMF , only : ESMF_GridCompSetEntryPoint
21 : use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet
22 : use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU
23 : use ESMF , only : ESMF_LogWrite, ESMF_LogSetError, ESMF_LogFoundError
24 : use ESMF , only : ESMF_SUCCESS, ESMF_METHOD_INITIALIZE, ESMF_FAILURE, ESMF_RC_NOT_VALID
25 : use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER
26 : use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize
27 : use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime
28 : use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise
29 : use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet
30 : use NUOPC_Model , only : model_routine_SS => SetServices
31 : use NUOPC_Model , only : SetVM
32 : use NUOPC_Model , only : model_label_Advance => label_Advance
33 : use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize
34 : use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock
35 : use NUOPC_Model , only : model_label_Finalize => label_Finalize
36 : use NUOPC_Model , only : NUOPC_ModelGet
37 : use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs
38 : use shr_sys_mod , only : shr_sys_abort
39 : use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit
40 : use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date
41 : use shr_const_mod , only : shr_const_pi
42 : use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT
43 : use cam_instance , only : cam_instance_init, inst_suffix, inst_index
44 : use cam_comp , only : cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final
45 : use camsrfexch , only : cam_out_t, cam_in_t
46 : use radiation , only : nextsw_cday
47 : use cam_logfile , only : iulog
48 : use spmd_utils , only : spmdinit, masterproc, iam, mpicom
49 : use time_manager , only : get_curr_calday, advance_timestep, get_curr_date, get_nstep, get_step_size
50 : use atm_import_export , only : read_surface_fields_namelists, advertise_fields, realize_fields
51 : use atm_import_export , only : import_fields, export_fields
52 : use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit
53 : use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance
54 : use perf_mod , only : t_startf, t_stopf
55 : use ppgrid , only : pcols, begchunk, endchunk
56 : use dyn_grid , only : get_horiz_grid_dim_d
57 : use phys_grid , only : get_ncols_p, get_gcol_p, get_rlon_all_p, get_rlat_all_p
58 : use phys_grid , only : ngcols=>num_global_phys_cols
59 : use cam_control_mod , only : cam_ctrl_set_orbit
60 : use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem
61 : use cam_initfiles , only : cam_initfiles_get_caseid, cam_initfiles_get_restdir
62 : use cam_history_support , only : fillvalue
63 : use filenames , only : interpret_filename_spec
64 : use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, PIO_MAX_NAME
65 : use pio , only : pio_closefile, pio_put_att, pio_enddef, pio_nowrite
66 : use pio , only : pio_inq_dimid, pio_inq_varid, pio_inquire_dimension, pio_def_var
67 : use pio , only : pio_initdecomp, pio_freedecomp
68 : use pio , only : pio_read_darray, pio_write_darray
69 : use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling
70 : use pio , only : pio_def_var, pio_get_var, pio_put_var, PIO_INT
71 : use ioFileMod
72 : !$use omp_lib , only : omp_set_num_threads
73 :
74 : implicit none
75 : private ! except
76 :
77 : public :: SetServices
78 : public :: SetVM
79 :
80 : !--------------------------------------------------------------------------
81 : ! Private interfaces
82 : !--------------------------------------------------------------------------
83 :
84 : private :: InitializeP0
85 : private :: InitializeAdvertise
86 : private :: InitializeRealize
87 : private :: ModelAdvance
88 : private :: ModelSetRunClock
89 : private :: ModelFinalize
90 : private :: cam_read_srfrest
91 : private :: cam_write_srfrest
92 : private :: cam_orbital_init
93 : private :: cam_orbital_update
94 : private :: cam_set_mesh_for_single_column
95 : private :: cam_pio_checkerr
96 :
97 : !--------------------------------------------------------------------------
98 : ! Private module data
99 : !--------------------------------------------------------------------------
100 :
101 : character(len=CL) :: flds_scalar_name = ''
102 : integer :: flds_scalar_num = 0
103 : integer :: flds_scalar_index_nx = 0
104 : integer :: flds_scalar_index_ny = 0
105 : integer :: flds_scalar_index_nextsw_cday = 0
106 : integer :: nthrds
107 : integer , parameter :: dbug_flag = 0
108 : type(cam_in_t) , pointer :: cam_in(:)
109 : type(cam_out_t) , pointer :: cam_out(:)
110 : integer , pointer :: dof(:) ! global index space decomposition
111 : character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file
112 : character(*) ,parameter :: modName = "(atm_comp_nuopc)"
113 : character(*) ,parameter :: u_FILE_u = &
114 : __FILE__
115 :
116 : logical :: dart_mode = .false.
117 : logical :: mediator_present
118 :
119 : character(len=CL) :: orb_mode ! attribute - orbital mode
120 : integer :: orb_iyear ! attribute - orbital year
121 : integer :: orb_iyear_align ! attribute - associated with model year
122 : real(R8) :: orb_obliq ! attribute - obliquity in degrees
123 : real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude
124 : real(R8) :: orb_eccen ! attribute and update- orbital eccentricity
125 :
126 : character(len=*) , parameter :: orb_fixed_year = 'fixed_year'
127 : character(len=*) , parameter :: orb_variable_year = 'variable_year'
128 : character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters'
129 :
130 : real(R8) , parameter :: grid_tol = 1.e-2_r8 ! tolerance for calculated lat/lon vs read in
131 :
132 : type(ESMF_Mesh) :: model_mesh ! model_mesh
133 : type(ESMF_Clock) :: model_clock ! model_clock
134 :
135 : !===============================================================================
136 : contains
137 : !===============================================================================
138 :
139 1536 : subroutine SetServices(gcomp, rc)
140 : type(ESMF_GridComp) :: gcomp
141 : integer, intent(out) :: rc
142 :
143 : ! local variables
144 : character(len=*),parameter :: subname=trim(modName)//':(SetServices) '
145 :
146 1536 : rc = ESMF_SUCCESS
147 :
148 : ! the NUOPC gcomp component will register the generic methods
149 :
150 1536 : call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc)
151 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
152 :
153 : ! switching to IPD version v03
154 :
155 : call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
156 1536 : userRoutine=InitializeP0, phase=0, rc=rc)
157 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
158 :
159 : ! set entry point for methods that require specific implementation
160 :
161 : call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
162 3072 : phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc)
163 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
164 :
165 : call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
166 3072 : phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc)
167 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
168 :
169 : ! attach specializing method(s)
170 :
171 : call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, &
172 1536 : specRoutine=ModelAdvance, rc=rc)
173 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
174 :
175 : call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, &
176 1536 : specRoutine=DataInitialize, rc=rc)
177 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
178 :
179 1536 : call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc)
180 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
181 : call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, &
182 1536 : specRoutine=ModelSetRunClock, rc=rc)
183 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
184 :
185 : call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, &
186 1536 : specRoutine=ModelFinalize, rc=rc)
187 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
188 :
189 : end subroutine SetServices
190 :
191 : !===============================================================================
192 1536 : subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
193 : type(ESMF_GridComp) :: gcomp
194 : type(ESMF_State) :: importState, exportState
195 : type(ESMF_Clock) :: clock
196 : integer, intent(out) :: rc
197 : !-------------------------------------------------------------------------------
198 :
199 1536 : rc = ESMF_SUCCESS
200 :
201 : ! Switch to IPDv03 by filtering all other phaseMap entries
202 3072 : call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc)
203 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
204 :
205 : end subroutine InitializeP0
206 :
207 : !===============================================================================
208 12288 : subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
209 :
210 : ! intput/output variables
211 : type(ESMF_GridComp) :: gcomp
212 : type(ESMF_State) :: importState, exportState
213 : type(ESMF_Clock) :: clock
214 : integer, intent(out) :: rc
215 :
216 : ! local variables
217 : type(ESMF_VM) :: vm
218 : integer :: n
219 : integer :: localpet
220 : character(len=CL) :: cvalue
221 : character(len=CL) :: logmsg
222 : logical :: isPresent, isSet
223 : integer :: shrlogunit ! original log unit
224 : character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) '
225 : !-------------------------------------------------------------------------------
226 :
227 1536 : rc = ESMF_SUCCESS
228 : if (dbug_flag > 5) then
229 : call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO)
230 : end if
231 :
232 1536 : call ESMF_VMGetCurrent(vm, rc=rc)
233 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
234 1536 : call ESMF_VmGet(vm, localPet=localPet, rc=rc)
235 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
236 :
237 : !----------------------------------------------------------------------------
238 : ! reset shr logging to my log file
239 : !----------------------------------------------------------------------------
240 :
241 1536 : call set_component_logging(gcomp, localpet==0, iulog, shrlogunit, rc)
242 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
243 :
244 1536 : call shr_log_setLogUnit (iulog)
245 :
246 : !----------------------------------------------------------------------------
247 : ! advertise import/export fields
248 : !----------------------------------------------------------------------------
249 :
250 1536 : call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
251 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
252 1536 : if (isPresent .and. isSet) then
253 1536 : flds_scalar_name = trim(cvalue)
254 1536 : call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO)
255 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
256 : else
257 0 : call shr_sys_abort(subname//'Need to set attribute ScalarFieldName')
258 : endif
259 :
260 1536 : call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
261 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
262 1536 : if (isPresent .and. isSet) then
263 1536 : read(cvalue, *) flds_scalar_num
264 1536 : write(logmsg,*) flds_scalar_num
265 1536 : call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO)
266 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
267 : else
268 0 : call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount')
269 : endif
270 :
271 1536 : call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
272 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
273 1536 : if (isPresent .and. isSet) then
274 1536 : read(cvalue,*) flds_scalar_index_nx
275 1536 : write(logmsg,*) flds_scalar_index_nx
276 1536 : call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO)
277 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
278 : else
279 0 : call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX')
280 : endif
281 :
282 1536 : call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
283 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
284 1536 : if (isPresent .and. isSet) then
285 1536 : read(cvalue,*) flds_scalar_index_ny
286 1536 : write(logmsg,*) flds_scalar_index_ny
287 1536 : call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO)
288 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
289 : else
290 0 : call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY')
291 : endif
292 :
293 1536 : call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
294 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
295 1536 : if (isPresent .and. isSet) then
296 1536 : read(cvalue,*) flds_scalar_index_nextsw_cday
297 1536 : write(logmsg,*) flds_scalar_index_nextsw_cday
298 1536 : call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO)
299 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
300 : else
301 0 : call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday')
302 : endif
303 :
304 : ! read mediator fields namelists
305 1536 : call read_surface_fields_namelists()
306 :
307 1536 : call NUOPC_CompAttributeGet(gcomp, name="mediator_present", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
308 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
309 1536 : if (isPresent .and. isSet) then
310 1536 : read (cvalue,*) mediator_present
311 1536 : if (mediator_present) then
312 1536 : call advertise_fields(gcomp, flds_scalar_name, rc)
313 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
314 : end if
315 : else
316 0 : call shr_sys_abort(subname//'Need to set attribute mediator_present')
317 : endif
318 :
319 : if (dbug_flag > 5) then
320 : call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO)
321 : end if
322 1536 : end subroutine InitializeAdvertise
323 :
324 : !===============================================================================
325 1536 : subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
326 :
327 : use ESMF, only : ESMF_VMGet
328 :
329 : ! input/output variables
330 : type(ESMF_GridComp) :: gcomp
331 : type(ESMF_State) :: importState
332 : type(ESMF_State) :: exportState
333 : type(ESMF_Clock) :: clock
334 : integer, intent(out) :: rc
335 :
336 : ! local variables
337 : type(ESMF_VM) :: vm
338 : type(ESMF_Time) :: currTime ! Current time
339 : type(ESMF_Time) :: startTime ! Start time
340 : type(ESMF_Time) :: stopTime ! Stop time
341 : type(ESMF_Time) :: refTime ! Ref time
342 : type(ESMF_TimeInterval) :: timeStep
343 : type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type
344 : type(ESMF_DistGrid) :: distGrid
345 : integer :: spatialDim
346 : integer :: numOwnedElements
347 1536 : real(R8), pointer :: ownedElemCoords(:)
348 1536 : real(r8), pointer :: lat(:), latMesh(:)
349 1536 : real(r8), pointer :: lon(:), lonMesh(:)
350 : real(r8) :: lats(pcols) ! array of chunk latitudes
351 : real(r8) :: lons(pcols) ! array of chunk longitude
352 : integer :: hdim1_d, hdim2_d ! dims of rect horizontal grid data (If 1D data struct, hdim2_d==1)
353 : integer :: ncols ! number of local columns
354 : integer :: start_ymd ! Start date (YYYYMMDD)
355 : integer :: start_tod ! Start time of day (sec)
356 : integer :: curr_ymd ! Start date (YYYYMMDD)
357 : integer :: curr_tod ! Start time of day (sec)
358 : integer :: stop_ymd ! Stop date (YYYYMMDD)
359 : integer :: stop_tod ! Stop time of day (sec)
360 : integer :: ref_ymd ! Reference date (YYYYMMDD)
361 : integer :: ref_tod ! Reference time of day (sec)
362 : character(len=cs) :: calendar ! Calendar type
363 : integer :: dtime ! time step increment (sec)
364 : integer :: atm_cpl_dt ! driver atm coupling time step
365 : integer :: nstep ! CAM nstep
366 : real(r8) :: caldayp1 ! CAM calendar day for for next cam time step
367 : integer :: yy,mm,dd ! Temporaries for time query
368 : logical :: perpetual_run ! If in perpetual mode or not
369 : integer :: perpetual_ymd ! Perpetual date (YYYYMMDD)
370 : character(CL) :: cvalue
371 : character(ESMF_MAXSTR) :: convCIM, purpComp
372 : integer :: lsize ! local size ofarrays
373 : integer :: n,c,g,i,j ! indices
374 : character(len=cs) :: start_type ! infodata start type
375 : character(len=cl) :: caseid ! case ID
376 : character(len=cl) :: ctitle ! case title
377 : character(len=cl) :: model_doi_url ! DOI for CESM model run
378 : logical :: aqua_planet ! Flag to run model in "aqua planet" mode
379 : logical :: brnch_retain_casename ! true => branch run has same caseid as run being branched from
380 : logical :: single_column = .false.
381 : character(len=cl) :: single_column_lnd_domainfile
382 : real(r8) :: scol_lon
383 : real(r8) :: scol_lat
384 : real(r8) :: scol_spval
385 : real(r8) :: eccen
386 : real(r8) :: obliqr
387 : real(r8) :: lambm0
388 : real(r8) :: mvelpp
389 : !character(len=cl) :: atm_resume_all_inst(num_inst_atm) ! atm resume file
390 : integer :: lbnum
391 : character(CS) :: inst_name
392 : integer :: inst_index
393 : character(CS) :: inst_suffix
394 : integer :: lmpicom
395 : logical :: isPresent, isSet
396 : character(len=512) :: diro
397 : character(len=512) :: logfile
398 : integer :: compid ! component id
399 : integer :: localPet, localPeCount
400 : logical :: initial_run ! startup mode which only requires a minimal initial file
401 : logical :: restart_run ! continue a previous run; requires a restart file
402 : logical :: branch_run ! branch from a previous run; requires a restart file
403 : character(len=CL) :: tempc1,tempc2
404 : integer :: shrlogunit ! original log unit
405 : real(r8) , parameter :: radtodeg = 180.0_r8/shr_const_pi
406 : integer , parameter :: aqua_perpetual_ymd = 321
407 : character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) '
408 : character(len=*), parameter :: format = "('("//trim(subname)//") :',A)"
409 : !-------------------------------------------------------------------------------
410 :
411 1536 : rc = ESMF_SUCCESS
412 : if (dbug_flag > 5) then
413 : call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO)
414 : end if
415 :
416 1536 : call shr_log_setLogUnit (iulog)
417 :
418 : !----------------------------------------------------------------------------
419 : ! generate local mpi comm
420 : !----------------------------------------------------------------------------
421 :
422 1536 : call ESMF_GridCompGet(gcomp, vm=vm, localpet=localPet, rc=rc)
423 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
424 :
425 1536 : call ESMF_VMGet(vm, mpiCommunicator=lmpicom, rc=rc)
426 1536 : if (chkerr(rc,__LINE__,u_FILE_u)) return
427 :
428 1536 : call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc)
429 1536 : if (chkerr(rc,__LINE__,u_FILE_u)) return
430 :
431 1536 : if(localPeCount == 1) then
432 1536 : call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc)
433 1536 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
434 1536 : read(cvalue,*) nthrds
435 : else
436 0 : nthrds = localPeCount
437 : endif
438 :
439 : !$ call omp_set_num_threads(nthrds)
440 :
441 : !----------------------------------------------------------------------------
442 : ! determine instance information
443 : !----------------------------------------------------------------------------
444 1536 : call get_component_instance(gcomp, inst_suffix, inst_index, rc)
445 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
446 :
447 1536 : inst_name = 'ATM'//inst_suffix
448 : ! Set filename specifier for restart surface file
449 : ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day)
450 1536 : rsfilename_spec_cam = '%c.cam' // trim(inst_suffix) // '.rs.%y-%m-%d-%s.nc'
451 :
452 : !----------------------------------------------------------------------------
453 : ! initialize cam mpi (needed for masterproc below)
454 : !----------------------------------------------------------------------------
455 :
456 1536 : call spmdinit(lmpicom)
457 :
458 : !----------------------
459 : ! Initialize cam - needed in realize phase to get grid information
460 : !----------------------
461 :
462 1536 : call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc)
463 1536 : if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return
464 1536 : read(cvalue,*) compid
465 1536 : call cam_instance_init(compid, inst_name, inst_index, inst_suffix)
466 :
467 : !----------------------
468 : ! Initialize cam - needed in realize phase to get grid information
469 : !----------------------
470 :
471 1536 : if (masterproc) then
472 2 : write(iulog,format) "CAM atm model initialization"
473 : end if
474 :
475 : #if (defined _MEMTRACE)
476 : if(masterproc) then
477 : lbnum=1
478 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:start::',lbnum)
479 : endif
480 : #endif
481 :
482 : !----------------------
483 : ! Obtain and load orbital values
484 : !----------------------
485 :
486 1536 : call cam_orbital_init(gcomp, iulog, masterproc, rc)
487 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
488 :
489 1536 : call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc)
490 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
491 :
492 1536 : call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp)
493 :
494 : !----------------------
495 : ! Obtain attributes
496 : !----------------------
497 :
498 1536 : call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc)
499 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
500 1536 : read(cvalue,*) caseid
501 1536 : ctitle=caseid
502 :
503 : ! starting info
504 1536 : call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc)
505 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
506 1536 : read(cvalue,*) start_type
507 1536 : call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc)
508 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
509 1536 : read(cvalue,*) brnch_retain_casename
510 :
511 : ! single column input
512 1536 : call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc)
513 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
514 1536 : read(cvalue,*) scol_lon
515 1536 : call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc)
516 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
517 1536 : read(cvalue,*) scol_lat
518 1536 : call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc)
519 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
520 1536 : read(cvalue,*) scol_spval
521 :
522 : ! For single column mode in cam need to have a valid single_column_lnd_domainfile for the mask
523 1536 : call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc)
524 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
525 1536 : if (scol_lon > scol_spval .and. scol_lat > scol_spval) then
526 0 : if (trim(single_column_lnd_domainfile) /= 'UNSET') then
527 0 : single_column = .true.
528 : else
529 0 : call shr_sys_abort('single_column_lnd_domainfile cannot be null for single column mode')
530 : end if
531 : else
532 1536 : single_column = .false.
533 : end if
534 :
535 : ! aqua planet input
536 1536 : call NUOPC_CompAttributeGet(gcomp, name='aqua_planet', value=cvalue, rc=rc)
537 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
538 1536 : read(cvalue,*) aqua_planet
539 :
540 : ! perpetual input
541 1536 : call NUOPC_CompAttributeGet(gcomp, name='perpetual', value=cvalue, rc=rc)
542 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
543 1536 : read(cvalue,*) perpetual_run
544 1536 : call NUOPC_CompAttributeGet(gcomp, name='perpetual_ymd', value=cvalue, rc=rc)
545 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
546 1536 : read(cvalue,*) perpetual_ymd
547 :
548 : ! TODO: query the config attributes for the number of instances - ASSUMES multi-driver
549 :
550 : ! TODO: must obtain model_doi_url from gcomp - for now hardwire to 'not_set'
551 1536 : model_doi_url = 'not_set'
552 :
553 : ! Initialize CAM, allocate cam_in and cam_out and determine
554 : ! atm decomposition (needed to initialize gsmap)
555 : ! for an initial run, cam_in and cam_out are allocated in cam_init
556 : ! for a restart/branch run, cam_in and cam_out are allocated in restart
557 : !
558 : !TODO: the following strings must not be hard-wired - must have module variables
559 : ! like seq_infodata_start_type_type - maybe another entry in flds_mod?
560 :
561 1536 : initial_run = .false.
562 1536 : restart_run = .false.
563 1536 : branch_run = .false.
564 1536 : if (trim(start_type) == trim('startup')) then
565 768 : initial_run = .true.
566 768 : else if (trim(start_type) == trim('continue') ) then
567 768 : restart_run = .true.
568 0 : else if (trim(start_type) == trim('branch')) then
569 0 : branch_run = .true.
570 : else
571 0 : call shr_sys_abort( subname//' ERROR: unknown start_type' )
572 : end if
573 :
574 : ! DART always starts up as an initial run.
575 : call NUOPC_CompAttributeGet(gcomp, name='data_assimilation_atm', value=cvalue, &
576 1536 : isPresent=isPresent, isSet=isSet, rc=rc)
577 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
578 1536 : if (isPresent .and. isSet) then
579 1536 : read(cvalue,*) dart_mode
580 : end if
581 1536 : if (dart_mode) then
582 0 : initial_run = .true.
583 0 : restart_run = .false.
584 0 : branch_run = .false.
585 : end if
586 :
587 : ! Get properties from clock
588 : call ESMF_ClockGet( clock, &
589 : currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, &
590 1536 : timeStep=timeStep, rc=rc)
591 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
592 :
593 1536 : call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc )
594 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
595 1536 : call shr_cal_ymd2date(yy,mm,dd,curr_ymd)
596 :
597 1536 : call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc )
598 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
599 1536 : call shr_cal_ymd2date(yy,mm,dd,start_ymd)
600 :
601 1536 : call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc )
602 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
603 1536 : call shr_cal_ymd2date(yy,mm,dd,stop_ymd)
604 :
605 1536 : call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc )
606 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
607 1536 : call shr_cal_ymd2date(yy,mm,dd,ref_ymd)
608 :
609 1536 : call ESMF_TimeIntervalGet( timeStep, s=dtime, rc=rc )
610 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
611 :
612 1536 : call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc )
613 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
614 :
615 1536 : if (esmf_caltype == ESMF_CALKIND_NOLEAP) then
616 1536 : calendar = shr_cal_noleap
617 0 : else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then
618 0 : calendar = shr_cal_gregorian
619 : else
620 0 : call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' )
621 : end if
622 :
623 : ! Initialize module orbital values and update orbital
624 1536 : call cam_orbital_init(gcomp, iulog, masterproc, rc)
625 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
626 1536 : call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc)
627 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
628 :
629 : ! Initialize CAM
630 1536 : if (aqua_planet) then
631 0 : perpetual_run = .true.
632 0 : perpetual_ymd = aqua_perpetual_ymd
633 : end if
634 :
635 : call cam_init( &
636 : caseid=caseid, ctitle=ctitle, model_doi_url=model_doi_url, &
637 : initial_run_in=initial_run, restart_run_in=restart_run, &
638 : branch_run_in=branch_run, post_assim_in=dart_mode, &
639 : calendar=calendar, brnch_retain_casename=brnch_retain_casename, aqua_planet=aqua_planet, &
640 : single_column=single_column, scmlat=scol_lat, scmlon=scol_lon, &
641 : eccen=eccen, obliqr=obliqr, lambm0=lambm0, mvelpp=mvelpp, &
642 : perpetual_run=perpetual_run, perpetual_ymd=perpetual_ymd, &
643 : dtime=dtime, start_ymd=start_ymd, start_tod=start_tod, ref_ymd=ref_ymd, ref_tod=ref_tod, &
644 : stop_ymd=stop_ymd, stop_tod=stop_tod, curr_ymd=curr_ymd, curr_tod=curr_tod, &
645 1536 : cam_out=cam_out, cam_in=cam_in)
646 :
647 1536 : if (mediator_present) then
648 :
649 1536 : if (single_column) then
650 :
651 0 : call cam_set_mesh_for_single_column(scol_lon, scol_lat, model_mesh, rc)
652 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
653 0 : allocate(dof(1))
654 0 : dof(1) = 1
655 :
656 : else
657 :
658 : ! generate the dof
659 1536 : lsize = 0
660 7728 : do c = begchunk, endchunk
661 104928 : do i = 1, get_ncols_p(c)
662 103392 : lsize = lsize + 1
663 : end do
664 : end do
665 4608 : allocate(dof(lsize))
666 1536 : n = 0
667 7728 : do c = begchunk, endchunk
668 104928 : do i = 1, get_ncols_p(c)
669 97200 : n = n+1
670 103392 : dof(n) = get_gcol_p(c,i)
671 : end do
672 : end do
673 :
674 : ! create distGrid from global index array
675 1536 : DistGrid = ESMF_DistGridCreate(arbSeqIndexList=dof, rc=rc)
676 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
677 :
678 : ! read in the mesh
679 1536 : call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc)
680 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
681 :
682 : model_mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, &
683 1536 : elementDistgrid=Distgrid, rc=rc)
684 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
685 1536 : if (masterproc) then
686 2 : write(iulog,*)'mesh file for cam domain is ',trim(cvalue)
687 : end if
688 :
689 : ! obtain mesh lats and lons
690 1536 : call ESMF_MeshGet(model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc)
691 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
692 1536 : if (numOwnedElements /= lsize) then
693 0 : write(tempc1,'(i10)') numOwnedElements
694 0 : write(tempc2,'(i10)') lsize
695 : call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// trim(tempc1) // &
696 0 : " not equal to local size "// trim(tempc2), ESMF_LOGMSG_INFO, rc=rc)
697 0 : rc = ESMF_FAILURE
698 0 : return
699 : end if
700 4608 : allocate(ownedElemCoords(spatialDim*numOwnedElements))
701 6144 : allocate(lonMesh(lsize), latMesh(lsize))
702 1536 : call ESMF_MeshGet(model_mesh, ownedElemCoords=ownedElemCoords)
703 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
704 98736 : do n = 1,lsize
705 97200 : lonMesh(n) = ownedElemCoords(2*n-1)
706 98736 : latMesh(n) = ownedElemCoords(2*n)
707 : end do
708 :
709 : ! obtain internally generated cam lats and lons
710 101808 : allocate(lon(lsize)); lon(:) = 0._r8
711 100272 : allocate(lat(lsize)); lat(:) = 0._r8
712 1536 : n=0
713 7728 : do c = begchunk, endchunk
714 6192 : ncols = get_ncols_p(c)
715 : ! latitudes and longitudes returned in radians
716 6192 : call get_rlat_all_p(c, ncols, lats)
717 6192 : call get_rlon_all_p(c, ncols, lons)
718 104928 : do i=1,ncols
719 97200 : n = n+1
720 97200 : lat(n) = lats(i)*radtodeg
721 103392 : lon(n) = lons(i)*radtodeg
722 : end do
723 : end do
724 :
725 : ! error check differences between internally generated lons and those read in
726 98736 : do n = 1,lsize
727 97200 : if (abs(lonMesh(n) - lon(n)) > grid_tol .and. .not. &
728 : abs(abs(lonMesh(n) - lon(n))- 360._r8) < grid_tol) then
729 0 : write(6,100)n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n))
730 : 100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5)
731 0 : call shr_sys_abort()
732 : end if
733 98736 : if (abs(latMesh(n) - lat(n)) > grid_tol) then
734 0 : write(6,100)n,lat(n),latMesh(n), abs(latMesh(n)-lat(n))
735 : 101 format('ERROR: CAM n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5)
736 0 : call shr_sys_abort()
737 : end if
738 : end do
739 :
740 : ! deallocate memory
741 1536 : deallocate(ownedElemCoords)
742 1536 : deallocate(lon, lonMesh)
743 3072 : deallocate(lat, latMesh)
744 :
745 : end if ! end of if single_column
746 :
747 : ! realize the actively coupled fields
748 1536 : call realize_fields(gcomp, model_mesh, flds_scalar_name, flds_scalar_num, single_column, rc)
749 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
750 :
751 : ! Create model_clock as a module variable - needed for generating streams
752 1536 : model_clock = clock
753 :
754 : ! Create cam export array and set the state scalars
755 1536 : call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc )
756 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
757 :
758 1536 : call get_horiz_grid_dim_d(hdim1_d, hdim2_d)
759 : call State_SetScalar(dble(hdim1_d), flds_scalar_index_nx, exportState, &
760 1536 : flds_scalar_name, flds_scalar_num, rc)
761 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
762 : call State_SetScalar(dble(hdim2_d), flds_scalar_index_ny, exportState, &
763 1536 : flds_scalar_name, flds_scalar_num, rc)
764 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
765 :
766 : ! diagnostics
767 : if (dbug_flag > 1) then
768 : call State_diagnose(exportState,subname//':ES',rc=rc)
769 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
770 : endif
771 :
772 : end if ! end of mediator_present if-block
773 :
774 1536 : call shr_log_setLogUnit (shrlogunit)
775 :
776 : #if (defined _MEMTRACE)
777 : if(masterproc) then
778 : write(iulog,*) TRIM(Sub) // ':end::'
779 : lbnum=1
780 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:end::',lbnum)
781 : call memmon_reset_addr()
782 : endif
783 : #endif
784 :
785 : if (dbug_flag > 5) then
786 : call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO)
787 : end if
788 :
789 69120 : end subroutine InitializeRealize
790 :
791 : !===============================================================================
792 3072 : subroutine DataInitialize(gcomp, rc)
793 :
794 : type(ESMF_GridComp) :: gcomp
795 : integer, intent(out) :: rc
796 :
797 : ! local variables
798 : type(ESMF_Clock) :: clock
799 : type(ESMF_State) :: importState, exportState
800 : type(ESMF_Time) :: currTime ! Current time
801 : type(ESMF_TimeInterval) :: timeStep
802 : type(ESMF_Field) :: field
803 3072 : character(ESMF_MAXSTR),allocatable :: fieldNameList(:)
804 : character(ESMF_MAXSTR) :: fieldName
805 : integer :: n, fieldCount
806 : integer :: shrlogunit ! original log unit
807 : integer(ESMF_KIND_I8) :: stepno ! time step
808 : integer :: atm_cpl_dt ! driver atm coupling time step
809 : logical :: importDone ! true => import data is valid
810 : logical :: atCorrectTime ! true => field is at correct time
811 : character(CL) :: cvalue
812 : character(len=*),parameter :: subname=trim(modName)//':(DataInitialize) '
813 : !-------------------------------------------------------------------------------
814 :
815 3072 : rc = ESMF_SUCCESS
816 : if (dbug_flag > 5) then
817 : call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO)
818 : end if
819 :
820 3072 : call shr_log_getLogUnit (shrlogunit)
821 3072 : call shr_log_setLogUnit (iulog)
822 :
823 : #if (defined _MEMTRACE)
824 : if (masterproc) then
825 : lbnum=1
826 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:start::',lbnum)
827 : endif
828 : #endif
829 :
830 : !--------------------------------
831 : ! Query the Component for its clock, importState and exportState
832 : !--------------------------------
833 :
834 3072 : call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc)
835 4608 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
836 :
837 : ! get the current time out of the clock
838 3072 : call ESMF_ClockGet(clock, currTime=currTime, rc=rc)
839 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
840 :
841 : if (dbug_flag > 1) then
842 : call log_clock_advance(clock, 'CAM', iulog, rc)
843 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
844 : endif
845 :
846 : !---------------------------------------------------------------
847 3072 : if (mediator_present) then
848 : !---------------------------------------------------------------
849 :
850 : ! Determine if all the import state has been initialized
851 : ! And if not initialized, then return
852 :
853 3072 : call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc)
854 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
855 :
856 9216 : allocate(fieldNameList(fieldCount))
857 3072 : call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc)
858 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
859 3072 : importDone = .true.
860 47616 : do n=1, fieldCount
861 46080 : call ESMF_StateGet(importState, itemName=fieldNameList(n), field=field, rc=rc)
862 46080 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
863 :
864 46080 : atCorrectTime = NUOPC_IsAtTime(field, currTime, rc=rc)
865 46080 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
866 :
867 93696 : if (.not. atCorrectTime) then
868 1536 : call ESMF_LogWrite("CAM - Initialize-Data-Dependency NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc)
869 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
870 :
871 : importDone = .false.
872 : exit ! break out of the loop when first not satisfied found
873 : end if
874 : end do
875 3072 : deallocate(fieldNameList)
876 :
877 : ! *** Import state has not been initialized - RETURN ****
878 :
879 3072 : if (.not. importDone) then
880 : ! Simply return if the import has not been initialized
881 : call ESMF_LogWrite("CAM - Initialize-Data-Dependency Returning to mediator without doing tphysbc", &
882 1536 : ESMF_LOGMSG_INFO, rc=rc)
883 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
884 : RETURN
885 : end if
886 :
887 : ! *** Import state has been initialized - continue with tphysbc ***
888 :
889 1536 : call ESMF_LogWrite("CAM - Initialize-Data-Dependency doing tphysbc", ESMF_LOGMSG_INFO, rc=rc)
890 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
891 :
892 : ! get the current step number and coupling interval
893 1536 : call ESMF_ClockGet( clock, TimeStep=timeStep, advanceCount=stepno, rc=rc )
894 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
895 1536 : call ESMF_TimeIntervalGet( timeStep, s=atm_cpl_dt, rc=rc )
896 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
897 :
898 : ! For initial run, unpack the import state, run cam radiation/clouds and return
899 : ! For restart run, read the import state from the restart and run radiation/clouds and return
900 :
901 : ! Note - cam_run1 is called only for the purposes of finishing the
902 : ! flux averaged calculation to compute cam-out
903 : ! Note - cam_run1 is called on restart only to have cam internal state consistent with the
904 : ! cam_out state sent to the coupler
905 :
906 1536 : if (stepno == 0) then
907 768 : call import_fields( gcomp, cam_in, rc=rc )
908 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
909 768 : call cam_run1 ( cam_in, cam_out )
910 768 : call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc )
911 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
912 : else
913 768 : call cam_read_srfrest( gcomp, clock, rc=rc )
914 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
915 768 : call import_fields( gcomp, cam_in, restart_init=.true., rc=rc )
916 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
917 768 : call cam_run1 ( cam_in, cam_out )
918 768 : call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc )
919 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
920 : end if
921 :
922 : ! Compute time of next radiation computation
923 : call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, &
924 1536 : flds_scalar_name, flds_scalar_num, rc)
925 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
926 :
927 : ! diagnostics
928 : if (dbug_flag > 1) then
929 : call State_diagnose(exportState,subname//':ES',rc=rc)
930 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
931 : endif
932 :
933 : ! CAM data is now fully initialized
934 :
935 1536 : call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc)
936 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
937 :
938 4608 : allocate(fieldNameList(fieldCount))
939 1536 : call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc)
940 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
941 :
942 47616 : do n=1, fieldCount
943 46080 : call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc)
944 46080 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
945 :
946 46080 : call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc)
947 93696 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
948 : end do
949 1536 : deallocate(fieldNameList)
950 :
951 : ! check whether all Fields in the exportState are "Updated"
952 9216 : if (NUOPC_IsUpdated(exportState)) then
953 1536 : call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc)
954 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
955 :
956 1536 : call ESMF_LogWrite("CAM - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc)
957 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
958 : end if
959 :
960 : !---------------------------------------------------------------
961 : else ! mediator is not present
962 : !---------------------------------------------------------------
963 :
964 0 : call cam_run1 ( cam_in, cam_out )
965 :
966 0 : call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc)
967 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
968 :
969 : end if
970 :
971 : ! End redirection of share output to cam log
972 1536 : call shr_log_setLogUnit (shrlogunit)
973 :
974 : #if (defined _MEMTRACE)
975 : if(masterproc) then
976 : lbnum=1
977 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:end::',lbnum)
978 : endif
979 : #endif
980 :
981 : if (dbug_flag > 5) then
982 : call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO)
983 : end if
984 :
985 84480 : end subroutine DataInitialize
986 :
987 : !===============================================================================
988 368640 : subroutine ModelAdvance(gcomp, rc)
989 :
990 : use ESMF, only : ESMF_GridCompGet, esmf_vmget, esmf_vm
991 : ! Run CAM
992 :
993 : ! Input/output variables
994 : type(ESMF_GridComp) :: gcomp
995 : integer, intent(out) :: rc
996 :
997 : ! local variables
998 : type(ESMF_VM) :: vm
999 : type(ESMF_Clock) :: clock
1000 : type(ESMF_Alarm) :: alarm
1001 : type(ESMF_Time) :: time
1002 : type(ESMF_Time) :: currTime ! Current time
1003 : type(ESMF_Time) :: nextTime ! Next timestep time
1004 : type(ESMF_TimeInterval) :: timeStep ! Clock, time-step
1005 : type(ESMF_State) :: importState
1006 : type(ESMF_State) :: exportState
1007 : character(CL) :: cvalue
1008 : integer :: shrlogunit ! original log unit
1009 : character(CL) :: case_name ! case name
1010 : real(r8) :: eccen
1011 : real(r8) :: obliqr
1012 : real(r8) :: lambm0
1013 : real(r8) :: mvelpp
1014 : logical :: dosend ! true => send data back to driver
1015 : integer :: dtime ! time step increment (sec)
1016 : integer :: ymd_sync ! Sync ymd
1017 : integer :: yr_sync ! Sync current year
1018 : integer :: mon_sync ! Sync current month
1019 : integer :: day_sync ! Sync current day
1020 : integer :: tod_sync ! Sync current time of day (sec)
1021 : integer :: ymd ! CAM current date (YYYYMMDD)
1022 : integer :: yr ! CAM current year
1023 : integer :: mon ! CAM current month
1024 : integer :: day ! CAM current day
1025 : integer :: tod ! CAM current time of day (sec)
1026 : logical :: rstwr ! .true. ==> write restart file before returning
1027 : logical :: nlend ! Flag signaling last time-step
1028 : integer :: lbnum
1029 : integer :: localPet, localPeCount
1030 : logical :: first_time = .true.
1031 : character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) '
1032 : !-------------------------------------------------------------------------------
1033 :
1034 368640 : rc = ESMF_SUCCESS
1035 :
1036 : !$ call omp_set_num_threads(nthrds)
1037 :
1038 368640 : call shr_log_getLogUnit (shrlogunit)
1039 368640 : call shr_log_setLogUnit (iulog)
1040 :
1041 : #if (defined _MEMTRACE)
1042 : if(masterproc) then
1043 : lbnum=1
1044 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:start::',lbnum)
1045 : endif
1046 : #endif
1047 :
1048 : !--------------------------------
1049 : ! Query the Component for its clock, importState and exportState
1050 : !--------------------------------
1051 :
1052 368640 : call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc)
1053 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1054 :
1055 : if (dbug_flag > 1) then
1056 : call log_clock_advance(clock, 'CAM', iulog, rc)
1057 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1058 : endif
1059 :
1060 : !--------------------------------
1061 : ! Determine current time
1062 : !--------------------------------
1063 :
1064 368640 : call ESMF_ClockGet( clock, currTime=currTime)
1065 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1066 :
1067 368640 : call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc)
1068 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1069 368640 : call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc)
1070 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1071 :
1072 : !----------------------
1073 : ! Update and load orbital parameters
1074 : !----------------------
1075 :
1076 368640 : if (trim(orb_mode) == trim(orb_variable_year) .or. first_time) then
1077 368640 : call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc)
1078 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1079 368640 : call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp)
1080 : end if
1081 368640 : first_time = .false.
1082 :
1083 : !--------------------------------
1084 : ! Run cam
1085 : !--------------------------------
1086 :
1087 : ! Unpack import state
1088 368640 : if (mediator_present) then
1089 368640 : call t_startf ('CAM_import')
1090 368640 : call State_diagnose(importState, string=subname//':IS', rc=rc)
1091 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1092 :
1093 368640 : call import_fields( gcomp, cam_in, rc=rc)
1094 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1095 368640 : call t_stopf ('CAM_import')
1096 : end if
1097 :
1098 : dosend = .false.
1099 738048 : do while (.not. dosend)
1100 :
1101 : ! TODO: This is currently hard-wired - is there a better way for nuopc?
1102 : ! Need to not return when nstep = 0 and return when nstep = 1
1103 : ! Note that the model clock is updated at the end of the time step not at the beginning
1104 369408 : if (get_nstep() > 0) then
1105 368640 : dosend = .true.
1106 : end if
1107 :
1108 : ! Determine if time to write restart
1109 :
1110 369408 : call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc)
1111 369408 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1112 :
1113 369408 : if (ESMF_AlarmIsRinging(alarm, rc=rc)) then
1114 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1115 1536 : rstwr = .true.
1116 1536 : call ESMF_AlarmRingerOff( alarm, rc=rc )
1117 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1118 : else
1119 367872 : rstwr = .false.
1120 : endif
1121 :
1122 : ! Determine if time to stop
1123 :
1124 369408 : call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc)
1125 369408 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1126 :
1127 369408 : if (ESMF_AlarmIsRinging(alarm, rc=rc)) then
1128 1536 : nlend = .true.
1129 : else
1130 367872 : nlend = .false.
1131 : endif
1132 :
1133 : ! Run CAM (run2, run3, run4)
1134 :
1135 369408 : call t_startf ('CAM_run2')
1136 369408 : call cam_run2( cam_out, cam_in )
1137 369408 : call t_stopf ('CAM_run2')
1138 :
1139 369408 : call t_startf ('CAM_run3')
1140 369408 : call cam_run3( cam_out )
1141 369408 : call t_stopf ('CAM_run3')
1142 :
1143 369408 : call t_startf ('CAM_run4')
1144 : call cam_run4( cam_out, cam_in, rstwr, nlend, &
1145 369408 : yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync)
1146 369408 : call t_stopf ('CAM_run4')
1147 :
1148 : ! Advance cam time step
1149 :
1150 369408 : call t_startf ('CAM_adv_timestep')
1151 369408 : call advance_timestep()
1152 369408 : call t_stopf ('CAM_adv_timestep')
1153 :
1154 : ! Run cam radiation/clouds (run1)
1155 :
1156 369408 : call t_startf ('CAM_run1')
1157 369408 : call cam_run1 ( cam_in, cam_out )
1158 369408 : call t_stopf ('CAM_run1')
1159 :
1160 : end do
1161 :
1162 368640 : if (mediator_present) then
1163 : ! Set export fields
1164 368640 : call t_startf ('CAM_export')
1165 368640 : call export_fields( gcomp, model_mesh, model_clock, cam_out, rc )
1166 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1167 368640 : call t_stopf ('CAM_export')
1168 :
1169 : ! Set the coupling scalars
1170 : ! Return time of next radiation calculation - albedos will need to be
1171 : ! calculated by each surface model at this time
1172 : call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, &
1173 368640 : flds_scalar_name, flds_scalar_num, rc)
1174 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1175 :
1176 : ! diagnostics
1177 : if (dbug_flag > 1) then
1178 : call State_diagnose(exportState, string=subname//':ES',rc=rc)
1179 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1180 : if (masterproc) then
1181 : call log_clock_advance(clock, 'CAM', iulog, rc)
1182 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1183 : end if
1184 : endif
1185 :
1186 : ! Write merged surface data restart file if appropriate
1187 368640 : if (rstwr) then
1188 : call cam_write_srfrest( gcomp, &
1189 1536 : yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync, rc=rc)
1190 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1191 : end if
1192 :
1193 : else
1194 :
1195 : ! if there is no mediator, then write the clock info to a driver restart file
1196 0 : if (rstwr) then
1197 0 : call cam_write_clockrest( clock, yr_sync, mon_sync, day_sync, tod_sync, rc=rc)
1198 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1199 : end if
1200 :
1201 : end if
1202 :
1203 : ! Check for consistency of internal cam clock with master sync clock
1204 : ! Note that the driver clock has not been updated yet - so at this point
1205 : ! CAM is actually 2 coupling intervals (or physics time steps) ahead of the driver clock
1206 368640 : dtime = get_step_size()
1207 368640 : call get_curr_date( yr, mon, day, tod, offset=-2*dtime )
1208 368640 : ymd = yr*10000 + mon*100 + day
1209 : tod = tod
1210 :
1211 368640 : call ESMF_ClockGet( clock, currTime=currTime, rc=rc)
1212 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1213 368640 : call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc )
1214 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1215 368640 : call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync)
1216 :
1217 368640 : if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) )then
1218 0 : write(iulog,*)' cam ymd=',ymd ,' cam tod= ',tod
1219 0 : write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync
1220 0 : call shr_sys_abort( subname//': CAM clock is not in sync with master Sync Clock' )
1221 : end if
1222 :
1223 : #if (defined _MEMTRACE)
1224 : if(masterproc) then
1225 : lbnum=1
1226 : call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:end::',lbnum)
1227 : endif
1228 : #endif
1229 :
1230 : !--------------------------------
1231 : ! Reset shr logging to my original values
1232 : !--------------------------------
1233 :
1234 368640 : call shr_log_setLogUnit (shrlogunit)
1235 :
1236 5160960 : end subroutine ModelAdvance
1237 :
1238 : !===============================================================================
1239 :
1240 368640 : subroutine ModelSetRunClock(gcomp, rc)
1241 :
1242 : ! input/output variables
1243 : type(ESMF_GridComp) :: gcomp
1244 : integer, intent(out) :: rc
1245 :
1246 : ! local variables
1247 : type(ESMF_Clock) :: mclock, dclock
1248 : type(ESMF_Time) :: mcurrtime, dcurrtime
1249 : type(ESMF_Time) :: mstoptime
1250 : type(ESMF_TimeInterval) :: mtimestep, dtimestep
1251 : character(len=256) :: cvalue
1252 : character(len=256) :: restart_option ! Restart option units
1253 : integer :: restart_n ! Number until restart interval
1254 : integer :: restart_ymd ! Restart date (YYYYMMDD)
1255 : type(ESMF_ALARM) :: restart_alarm
1256 : character(len=256) :: stop_option ! Stop option units
1257 : integer :: stop_n ! Number until stop interval
1258 : integer :: stop_ymd ! Stop date (YYYYMMDD)
1259 : type(ESMF_ALARM) :: stop_alarm
1260 : character(len=128) :: name
1261 : integer :: alarmcount
1262 : character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) '
1263 : !-------------------------------------------------------------------------------
1264 :
1265 368640 : rc = ESMF_SUCCESS
1266 :
1267 : ! query the Component for its clocks
1268 368640 : call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc)
1269 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1270 :
1271 368640 : call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc)
1272 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1273 :
1274 368640 : call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc)
1275 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1276 :
1277 : !--------------------------------
1278 : ! force model clock currtime and timestep to match driver and set stoptime
1279 : !--------------------------------
1280 :
1281 368640 : mstoptime = mcurrtime + dtimestep
1282 368640 : call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc)
1283 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1284 :
1285 : !--------------------------------
1286 : ! set restart and stop alarms
1287 : !--------------------------------
1288 :
1289 368640 : call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc)
1290 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1291 :
1292 368640 : if (alarmCount == 0) then
1293 :
1294 1536 : call ESMF_GridCompGet(gcomp, name=name, rc=rc)
1295 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1296 1536 : call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO)
1297 :
1298 : !----------------
1299 : ! Restart alarm
1300 : !----------------
1301 1536 : call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc)
1302 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1303 :
1304 1536 : call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc)
1305 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1306 1536 : read(cvalue,*) restart_n
1307 :
1308 1536 : call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc)
1309 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1310 1536 : read(cvalue,*) restart_ymd
1311 :
1312 : call alarmInit(mclock, restart_alarm, restart_option, &
1313 : opt_n = restart_n, &
1314 : opt_ymd = restart_ymd, &
1315 : RefTime = mcurrTime, &
1316 1536 : alarmname = 'alarm_restart', rc=rc)
1317 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1318 :
1319 1536 : call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc)
1320 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1321 :
1322 : !----------------
1323 : ! Stop alarm
1324 : !----------------
1325 1536 : call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc)
1326 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1327 :
1328 1536 : call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc)
1329 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1330 1536 : read(cvalue,*) stop_n
1331 :
1332 1536 : call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc)
1333 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1334 1536 : read(cvalue,*) stop_ymd
1335 :
1336 : call alarmInit(mclock, stop_alarm, stop_option, &
1337 : opt_n = stop_n, &
1338 : opt_ymd = stop_ymd, &
1339 : RefTime = mcurrTime, &
1340 1536 : alarmname = 'alarm_stop', rc=rc)
1341 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1342 :
1343 1536 : call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc)
1344 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1345 :
1346 : end if
1347 :
1348 : !--------------------------------
1349 : ! Advance model clock to trigger alarms then reset model clock back to currtime
1350 : !--------------------------------
1351 :
1352 368640 : call ESMF_ClockAdvance(mclock,rc=rc)
1353 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1354 :
1355 368640 : call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc)
1356 368640 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1357 :
1358 21381120 : end subroutine ModelSetRunClock
1359 :
1360 : !===============================================================================
1361 1536 : subroutine ModelFinalize(gcomp, rc)
1362 : type(ESMF_GridComp) :: gcomp
1363 : integer, intent(out) :: rc
1364 :
1365 : ! local variables
1366 : integer :: shrlogunit ! original log unit
1367 : character(*), parameter :: F00 = "('(atm_comp_nuopc) ',8a)"
1368 : character(*), parameter :: F91 = "('(atm_comp_nuopc) ',73('-'))"
1369 : character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) '
1370 : !-------------------------------------------------------------------------------
1371 :
1372 : !--------------------------------
1373 : ! Finalize routine
1374 : !--------------------------------
1375 :
1376 1536 : rc = ESMF_SUCCESS
1377 :
1378 1536 : call shr_log_getLogUnit (shrlogunit)
1379 1536 : call shr_log_setLogUnit (iulog)
1380 :
1381 1536 : call cam_final( cam_out, cam_in )
1382 :
1383 1536 : if (masterproc) then
1384 2 : write(iulog,F91)
1385 2 : write(iulog,F00) 'CAM: end of main integration loop'
1386 2 : write(iulog,F91)
1387 : end if
1388 :
1389 1536 : call shr_log_setLogUnit (shrlogunit)
1390 :
1391 1536 : end subroutine ModelFinalize
1392 :
1393 : !===============================================================================
1394 3072 : subroutine cam_orbital_init(gcomp, logunit, mastertask, rc)
1395 :
1396 : !----------------------------------------------------------
1397 : ! Initialize orbital related values
1398 : !----------------------------------------------------------
1399 :
1400 : ! input/output variables
1401 : type(ESMF_GridComp) , intent(in) :: gcomp
1402 : integer , intent(in) :: logunit
1403 : logical , intent(in) :: mastertask
1404 : integer , intent(out) :: rc ! output error
1405 :
1406 : ! local variables
1407 : character(len=CL) :: msgstr ! temporary
1408 : character(len=CL) :: cvalue ! temporary
1409 : character(len=*) , parameter :: subname = "(cam_orbital_init)"
1410 : !-------------------------------------------------------------------------------
1411 :
1412 3072 : rc = ESMF_SUCCESS
1413 :
1414 : ! Determine orbital attributes from input
1415 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc)
1416 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1417 3072 : read(cvalue,*) orb_mode
1418 :
1419 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_iyear", value=cvalue, rc=rc)
1420 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1421 3072 : read(cvalue,*) orb_iyear
1422 :
1423 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_iyear_align", value=cvalue, rc=rc)
1424 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1425 3072 : read(cvalue,*) orb_iyear_align
1426 :
1427 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_obliq", value=cvalue, rc=rc)
1428 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1429 3072 : read(cvalue,*) orb_obliq
1430 :
1431 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_eccen", value=cvalue, rc=rc)
1432 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1433 3072 : read(cvalue,*) orb_eccen
1434 :
1435 3072 : call NUOPC_CompAttributeGet(gcomp, name="orb_mvelp", value=cvalue, rc=rc)
1436 3072 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1437 3072 : read(cvalue,*) orb_mvelp
1438 :
1439 : ! Error checks
1440 3072 : if (trim(orb_mode) == trim(orb_fixed_year)) then
1441 0 : orb_obliq = SHR_ORB_UNDEF_REAL
1442 0 : orb_eccen = SHR_ORB_UNDEF_REAL
1443 0 : orb_mvelp = SHR_ORB_UNDEF_REAL
1444 0 : if (orb_iyear == SHR_ORB_UNDEF_INT) then
1445 0 : if (mastertask) then
1446 0 : write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode)
1447 0 : write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear
1448 0 : write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode)
1449 : end if
1450 0 : call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc)
1451 0 : return ! bail out
1452 : endif
1453 3072 : elseif (trim(orb_mode) == trim(orb_variable_year)) then
1454 3072 : orb_obliq = SHR_ORB_UNDEF_REAL
1455 3072 : orb_eccen = SHR_ORB_UNDEF_REAL
1456 3072 : orb_mvelp = SHR_ORB_UNDEF_REAL
1457 3072 : if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then
1458 0 : if (mastertask) then
1459 0 : write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode)
1460 0 : write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align
1461 0 : write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode)
1462 : end if
1463 0 : call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc)
1464 0 : return ! bail out
1465 : endif
1466 0 : elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then
1467 : !-- force orb_iyear to undef to make sure shr_orb_params works properly
1468 0 : orb_iyear = SHR_ORB_UNDEF_INT
1469 0 : orb_iyear_align = SHR_ORB_UNDEF_INT
1470 : if (orb_eccen == SHR_ORB_UNDEF_REAL .or. &
1471 0 : orb_obliq == SHR_ORB_UNDEF_REAL .or. &
1472 : orb_mvelp == SHR_ORB_UNDEF_REAL) then
1473 0 : if (mastertask) then
1474 0 : write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode)
1475 0 : write(logunit,*) trim(subname),' ERROR: orb_eccen = ',orb_eccen
1476 0 : write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq
1477 0 : write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp
1478 0 : write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode)
1479 : end if
1480 0 : call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc)
1481 0 : return ! bail out
1482 : endif
1483 : else
1484 0 : write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode)
1485 0 : call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc)
1486 0 : rc = ESMF_FAILURE
1487 0 : return ! bail out
1488 : endif
1489 :
1490 : end subroutine cam_orbital_init
1491 :
1492 : !===============================================================================
1493 371712 : subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc)
1494 :
1495 : !----------------------------------------------------------
1496 : ! Update orbital settings
1497 : !----------------------------------------------------------
1498 :
1499 : ! input/output variables
1500 : type(ESMF_Clock) , intent(in) :: clock
1501 : integer , intent(in) :: logunit
1502 : logical , intent(in) :: mastertask
1503 : real(R8) , intent(inout) :: eccen ! orbital eccentricity
1504 : real(R8) , intent(inout) :: obliqr ! Earths obliquity in rad
1505 : real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians)
1506 : real(R8) , intent(inout) :: mvelpp ! moving vernal equinox longitude of perihelion plus pi (radians)
1507 : integer , intent(out) :: rc ! output error
1508 :
1509 : ! local variables
1510 : type(ESMF_Time) :: CurrTime ! current time
1511 : integer :: year ! model year at current time
1512 : integer :: orb_year ! orbital year for current orbital computation
1513 : character(len=CL) :: msgstr ! temporary
1514 : logical, save :: logprint = .true.
1515 : character(len=*) , parameter :: subname = "(cam_orbital_update)"
1516 : !-------------------------------------------
1517 :
1518 371712 : rc = ESMF_SUCCESS
1519 :
1520 371712 : if (trim(orb_mode) == trim(orb_variable_year)) then
1521 371712 : call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc)
1522 371712 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1523 371712 : call ESMF_TimeGet(CurrTime, yy=year, rc=rc)
1524 371712 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1525 371712 : orb_year = orb_iyear + (year - orb_iyear_align)
1526 : else
1527 0 : orb_year = orb_iyear
1528 : end if
1529 371712 : if(.not. (logprint .and. mastertask)) then
1530 371710 : logprint = .false.
1531 : endif
1532 :
1533 371712 : eccen = orb_eccen
1534 :
1535 371712 : call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, logprint)
1536 371712 : logprint = .false.
1537 : if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. &
1538 371712 : mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then
1539 0 : write (msgstr, *) subname//' ERROR: orb params incorrect'
1540 0 : call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc)
1541 0 : return ! bail out
1542 : endif
1543 :
1544 2601984 : end subroutine cam_orbital_update
1545 :
1546 : !===============================================================================
1547 768 : subroutine cam_read_srfrest( gcomp, clock, rc )
1548 :
1549 : ! input/output variables
1550 : type(ESMF_GridComp) :: gcomp
1551 : type(ESMF_Clock), intent(inout) :: clock
1552 : integer , intent(out) :: rc
1553 :
1554 : ! local variables
1555 : type(ESMF_State) :: importState, exportState
1556 : type(ESMF_Field) :: lfield
1557 : integer :: lrank
1558 : integer :: rcode ! return error code
1559 : integer :: nf,n
1560 : type(file_desc_t) :: file
1561 : type(io_desc_t) :: iodesc
1562 : integer :: fieldCount
1563 768 : character(ESMF_MAXSTR),allocatable :: fieldNameList(:)
1564 : type(var_desc_t) :: varid
1565 768 : real(r8), pointer :: fldptr(:)
1566 768 : real(r8), pointer :: tmpptr(:)
1567 768 : real(r8), pointer :: fldptr2d(:,:)
1568 : type(ESMF_Time) :: currTime ! time at previous interval
1569 : integer :: yr_spec ! Current year
1570 : integer :: mon_spec ! Current month
1571 : integer :: day_spec ! Current day
1572 : integer :: sec_spec ! Current time of day (sec)
1573 : character(len=256) :: fname_srf_cam ! surface restart filename
1574 : character(len=256) :: pname_srf_cam ! surface restart full pathname
1575 : character(len=PIO_MAX_NAME) :: varname
1576 : integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds
1577 : integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds
1578 : integer :: lsize
1579 : character(len=8) :: cvalue
1580 : integer :: nloop
1581 : character(len=4) :: prefix
1582 : !-----------------------------------------------------------------------
1583 :
1584 768 : rc = ESMF_SUCCESS
1585 :
1586 : ! ------------------------------
1587 : ! Get surface restart dataset
1588 : ! ------------------------------
1589 :
1590 768 : call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc)
1591 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1592 :
1593 768 : call ESMF_ClockGet( clock, currTime=currTime, rc=rc )
1594 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1595 :
1596 768 : call ESMF_TimeGet( currTime, yy=yr_spec, mm=mon_spec, dd=day_spec, s=sec_spec, rc=rc )
1597 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1598 :
1599 : fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, case=cam_initfiles_get_caseid(), &
1600 768 : yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec )
1601 768 : pname_srf_cam = trim(cam_initfiles_get_restdir() )//fname_srf_cam
1602 768 : call getfil(pname_srf_cam, fname_srf_cam)
1603 :
1604 : ! ------------------------------
1605 : ! Open restart file
1606 : ! ------------------------------
1607 :
1608 768 : call cam_pio_openfile(File, fname_srf_cam, 0)
1609 1536 : call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc)
1610 768 : call pio_seterrorhandling(File, pio_bcast_error)
1611 :
1612 : ! ------------------------------
1613 : ! Read in import and export fields
1614 : ! ------------------------------
1615 :
1616 2304 : do nloop = 1,2
1617 :
1618 1536 : if (nloop == 1) then
1619 768 : prefix = 'x2a_' ! import fields
1620 768 : call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc)
1621 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1622 2304 : allocate(fieldnameList(fieldCount))
1623 768 : call ESMF_StateGet(importState, itemNameList=fieldnameList, rc=rc)
1624 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1625 : else
1626 768 : prefix = 'a2x_' ! export fields
1627 768 : call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc)
1628 768 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1629 2304 : allocate(fieldnameList(fieldCount))
1630 768 : call ESMF_StateGet(exportState, itemNameList=fieldnameList, rc=rc)
1631 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1632 : end if
1633 :
1634 : ! Loop over fields in import or export state
1635 46848 : do nf = 1,fieldCount
1636 :
1637 45312 : if (trim(fieldnameList(nf)) == flds_scalar_name) CYCLE
1638 :
1639 : ! Determine dimension of field
1640 43776 : if (nloop == 1) then
1641 21504 : call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1642 21504 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1643 : else
1644 22272 : call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1645 22272 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1646 : end if
1647 43776 : call ESMF_FieldGet(lfield, rank=lrank, rc=rc)
1648 43776 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1649 :
1650 89088 : if (lrank == 1) then
1651 :
1652 39168 : call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc)
1653 39168 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1654 39168 : varname = trim(prefix)//trim(fieldnameList(nf))
1655 39168 : rcode = pio_inq_varid(File,trim(varname) ,varid)
1656 39168 : if (rcode == pio_noerr) then
1657 39168 : call pio_read_darray(File, varid, iodesc, fldptr, rcode)
1658 : else
1659 0 : if (masterproc) then
1660 0 : write(iulog,*)'cam_read_srfrest warning: field ',trim(varname),' is not on restart file'
1661 0 : write(iulog,*)'for backwards compatibility will set it to 0'
1662 : end if
1663 0 : fldptr(:) = 0._r8
1664 : end if
1665 :
1666 4608 : else if (lrank == 2) then
1667 :
1668 : ! There is an output variable for each element of the undistributed dimension
1669 4608 : call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc)
1670 4608 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1671 4608 : call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc)
1672 4608 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1673 4608 : if (gridToFieldMap(1) == 1) then
1674 0 : lsize = size(fldptr2d, dim=1)
1675 4608 : else if (gridToFieldMap(1) == 2) then
1676 4608 : lsize = size(fldptr2d, dim=2)
1677 : end if
1678 :
1679 13824 : allocate(tmpptr(lsize))
1680 19968 : do n = 1,ungriddedUBound(1)
1681 15360 : write(cvalue,'(i0)') n
1682 15360 : varname = trim(prefix)//trim(fieldnameList(nf))//trim(cvalue)
1683 15360 : rcode = pio_inq_varid(File,trim(varname) ,varid)
1684 :
1685 15360 : if (rcode == pio_noerr) then
1686 15360 : call pio_read_darray(File, varid, iodesc, tmpptr, rcode)
1687 : else
1688 0 : if (masterproc) then
1689 0 : write(iulog,*)'cam_read_srfrest warning: field ',trim(varname),' is not on restart file'
1690 0 : write(iulog,*)'for backwards compatibility will set it to 0'
1691 : end if
1692 0 : tmpptr(:) = 0._r8
1693 : end if
1694 19968 : if (gridToFieldMap(1) == 1) then
1695 0 : fldptr2d(:,n) = tmpptr(:)
1696 15360 : else if (gridToFieldMap(1) == 2) then
1697 1959360 : fldptr2d(n,:) = tmpptr(:)
1698 : end if
1699 : end do
1700 4608 : deallocate(tmpptr)
1701 :
1702 : end if ! end lrank if block
1703 : end do
1704 2304 : deallocate(fieldnameList)
1705 : end do
1706 :
1707 : ! ------------------------------
1708 : ! Close file
1709 : ! ------------------------------
1710 :
1711 768 : call pio_seterrorhandling(File, pio_internal_error)
1712 768 : call pio_freedecomp(File, iodesc)
1713 768 : call cam_pio_closefile(File)
1714 :
1715 6144 : end subroutine cam_read_srfrest
1716 :
1717 : !===========================================================================================
1718 1536 : subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc )
1719 :
1720 : ! Arguments
1721 : type(ESMF_GridComp) :: gcomp
1722 : integer , intent(in) :: yr_spec ! Simulation year
1723 : integer , intent(in) :: mon_spec ! Simulation month
1724 : integer , intent(in) :: day_spec ! Simulation day
1725 : integer , intent(in) :: sec_spec ! Seconds into current simulation day
1726 : integer , intent(out) :: rc ! error code
1727 :
1728 : ! Local variables
1729 : type(ESMF_State) :: importState, exportState
1730 : type(ESMF_Field) :: lField
1731 : integer :: lrank
1732 : integer :: rcode ! return error code
1733 : integer :: dimid(1), nf, n
1734 : type(file_desc_t) :: file
1735 : type(io_desc_t) :: iodesc
1736 : integer :: fieldCount
1737 1536 : character(ESMF_MAXSTR),allocatable :: fieldnameList(:)
1738 : type(var_desc_t) :: varid
1739 1536 : real(r8), pointer :: fldptr1d(:)
1740 1536 : real(r8), pointer :: fldptr2d(:,:)
1741 : character(len=PIO_MAX_NAME) :: varname
1742 : character(len=256) :: fname_srf_cam ! surface restart filename
1743 : character(len=8) :: cvalue
1744 : integer :: nloop
1745 : character(len=4) :: prefix
1746 : integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds
1747 : integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds
1748 : !-----------------------------------------------------------------------
1749 :
1750 1536 : rc = ESMF_SUCCESS
1751 :
1752 : ! ----------------------
1753 : ! Get import and export states
1754 : ! ----------------------
1755 :
1756 1536 : call ESMF_GridCompGet(gcomp, importState=importState, exportState=exportState, rc=rc)
1757 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1758 :
1759 : ! ----------------------
1760 : ! Open surface restart dataset
1761 : ! ----------------------
1762 :
1763 : fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, &
1764 1536 : yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec )
1765 :
1766 1536 : call cam_pio_createfile(File, fname_srf_cam, 0)
1767 3072 : call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc)
1768 :
1769 : ! ----------------------
1770 : ! Define dimensions
1771 : ! ----------------------
1772 :
1773 1536 : rcode = pio_def_dim(File, 'x2a_nx', ngcols, dimid(1))
1774 1536 : rcode = pio_def_dim(File, 'a2x_nx', ngcols, dimid(1))
1775 :
1776 : ! ----------------------
1777 : ! Define import and export variable ids
1778 : ! ----------------------
1779 :
1780 4608 : do nloop = 1,2
1781 :
1782 3072 : if (nloop == 1) then
1783 1536 : prefix = 'x2a_' ! import fields
1784 1536 : call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc)
1785 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1786 4608 : allocate(fieldNameList(fieldCount))
1787 1536 : call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc)
1788 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1789 : else
1790 1536 : prefix = 'a2x_' ! export fields
1791 1536 : call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc)
1792 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1793 4608 : allocate(fieldNameList(fieldCount))
1794 1536 : call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc)
1795 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1796 : end if
1797 :
1798 93696 : do nf = 1,fieldCount
1799 :
1800 90624 : if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE
1801 :
1802 87552 : if (nloop == 1) then
1803 43008 : call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1804 43008 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1805 : else
1806 44544 : call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1807 44544 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1808 : end if
1809 87552 : call ESMF_FieldGet(lfield, rank=lrank, rc=rc)
1810 87552 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1811 :
1812 178176 : if (lrank == 1) then
1813 :
1814 78336 : varname = trim(prefix)//trim(fieldNameList(nf))
1815 78336 : rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid)
1816 78336 : rcode = pio_put_att(File, varid, "_fillvalue", fillvalue)
1817 :
1818 9216 : else if (lrank == 2) then
1819 :
1820 : ! Determine the size of the ungridded dimension and the
1821 : ! index where the undistributed dimension is located
1822 9216 : call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc)
1823 9216 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1824 :
1825 : ! Output for each ungriddedUbound index
1826 39936 : do n = 1,ungriddedUBound(1)
1827 30720 : write(cvalue,'(i0)') n
1828 30720 : varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue)
1829 30720 : rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid)
1830 39936 : rcode = pio_put_att(File, varid, "_fillvalue", fillvalue)
1831 : end do
1832 :
1833 : end if ! end if-block over rank size
1834 :
1835 : end do ! end loop over import or export fieldsfields
1836 4608 : deallocate(fieldNameList)
1837 : end do
1838 :
1839 : ! ----------------------
1840 : ! End definition phase
1841 : ! ----------------------
1842 :
1843 1536 : rcode = pio_enddef(File) ! don't check return code, might be enddef already
1844 :
1845 : ! ----------------------
1846 : ! Write the restart data for the import fields and export fields
1847 : ! ----------------------
1848 :
1849 4608 : do nloop = 1,2
1850 :
1851 3072 : if (nloop == 1) then
1852 1536 : prefix = 'x2a_' ! import fields
1853 1536 : call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc)
1854 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1855 4608 : allocate(fieldNameList(fieldCount))
1856 1536 : call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc)
1857 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1858 : else
1859 1536 : prefix = 'a2x_' ! export fields
1860 1536 : call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc)
1861 1536 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1862 4608 : allocate(fieldNameList(fieldCount))
1863 1536 : call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc)
1864 3072 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1865 : end if
1866 :
1867 93696 : do nf = 1,fieldCount
1868 :
1869 90624 : if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE
1870 :
1871 87552 : if (nloop == 1) then
1872 43008 : call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1873 43008 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1874 : else
1875 44544 : call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc)
1876 44544 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1877 : end if
1878 87552 : call ESMF_FieldGet(lfield, rank=lrank, rc=rc)
1879 87552 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1880 :
1881 178176 : if (lrank == 1) then
1882 :
1883 78336 : varname = trim(prefix)//trim(fieldNameList(nf))
1884 78336 : rcode = pio_inq_varid(File, trim(varname), varid)
1885 78336 : call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc)
1886 78336 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1887 78336 : call pio_write_darray(File, varid, iodesc, fldptr1d, rcode)
1888 :
1889 9216 : else if (lrank == 2) then
1890 :
1891 : ! There is an output variable for each element of the undistributed dimension
1892 9216 : call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc)
1893 9216 : if (chkerr(rc,__LINE__,u_FILE_u)) return
1894 9216 : call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc)
1895 9216 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1896 :
1897 39936 : do n = 1,ungriddedUBound(1)
1898 30720 : write(cvalue,'(i0)') n
1899 30720 : varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue)
1900 30720 : rcode = pio_inq_varid(File, trim(varname), varid)
1901 39936 : if (gridToFieldMap(1) == 1) then
1902 0 : call pio_write_darray(File, varid, iodesc, fldptr2d(:,n), rcode, fillval=fillvalue)
1903 30720 : else if (gridToFieldMap(1) == 2) then
1904 30720 : call pio_write_darray(File, varid, iodesc, fldptr2d(n,:), rcode, fillval=fillvalue)
1905 : end if
1906 : end do
1907 :
1908 : end if
1909 : end do ! end loop over import or export fields
1910 4608 : deallocate(fieldNameList)
1911 :
1912 : end do ! end of nloop
1913 :
1914 : ! ----------------------
1915 : ! close the file
1916 : ! ----------------------
1917 :
1918 1536 : call pio_freedecomp(File,iodesc)
1919 1536 : call cam_pio_closefile(File)
1920 :
1921 3072 : end subroutine cam_write_srfrest
1922 :
1923 : !===============================================================================
1924 0 : subroutine cam_write_clockrest( clock, yr_spec, mon_spec, day_spec, sec_spec, rc )
1925 :
1926 : ! When there is no mediator, the driver needs to have restart information to start up
1927 : ! This routine writes this out and the driver reads it back in on a restart run
1928 :
1929 : ! Arguments
1930 : type(ESMF_Clock) , intent(in) :: clock
1931 : integer , intent(in) :: yr_spec ! Simulation year
1932 : integer , intent(in) :: mon_spec ! Simulation month
1933 : integer , intent(in) :: day_spec ! Simulation day
1934 : integer , intent(in) :: sec_spec ! Seconds into current simulation day
1935 : integer , intent(out) :: rc ! error code
1936 :
1937 : ! Local variables
1938 : type(ESMF_Time) :: startTime
1939 : type(ESMF_Time) :: currTime
1940 : type(ESMF_Time) :: nextTime
1941 : integer :: unitn
1942 : type(file_desc_t) :: File
1943 : integer :: start_ymd
1944 : integer :: start_tod
1945 : integer :: curr_ymd
1946 : integer :: curr_tod
1947 : integer :: yy,mm,dd ! Temporaries for time query
1948 : type(var_desc_t) :: varid_start_ymd
1949 : type(var_desc_t) :: varid_start_tod
1950 : type(var_desc_t) :: varid_curr_ymd
1951 : type(var_desc_t) :: varid_curr_tod
1952 : integer :: rcode
1953 : character(ESMF_MAXSTR) :: restart_pfile
1954 : character(ESMF_MAXSTR) :: restart_file
1955 : !-----------------------------------------------------------------------
1956 :
1957 0 : rc = ESMF_SUCCESS
1958 :
1959 : ! Get properties from clock
1960 0 : call ESMF_ClockGet( clock, startTime=startTime, currTime=currTime, rc=rc)
1961 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1962 0 : call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc)
1963 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1964 :
1965 0 : call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc )
1966 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1967 0 : call shr_cal_ymd2date(yy,mm,dd,start_ymd)
1968 :
1969 0 : call ESMF_TimeGet( nextTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc )
1970 : !call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc )
1971 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
1972 0 : call shr_cal_ymd2date(yy,mm,dd,curr_ymd)
1973 :
1974 : ! Open clock info restart dataset
1975 : restart_file = interpret_filename_spec( '%c.cpl.r.%y-%m-%d-%s.nc', &
1976 0 : yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec )
1977 :
1978 0 : if (masterproc) then
1979 0 : write(iulog,*) " In this configuration, there is no mediator"
1980 0 : write(iulog,*) " Normally, the mediator restart file provides the restart time info"
1981 0 : write(iulog,*) " In this case, CAM will create the rpointer.cpl and cpl restart file"
1982 0 : write(iulog,*) " containing this information"
1983 0 : write(iulog,*) " writing rpointer file for driver clock info, rpointer.cpl"
1984 0 : write(iulog,*) " writing restart clock info for driver= "//trim(restart_file)
1985 0 : open(newunit=unitn, file='rpointer.cpl', form='FORMATTED')
1986 0 : write(unitn,'(a)') trim(restart_file)
1987 0 : close(unitn)
1988 : endif
1989 :
1990 0 : call cam_pio_createfile(File, trim(restart_file), 0)
1991 0 : rcode = pio_def_var(File, 'start_ymd', PIO_INT, varid_start_ymd)
1992 0 : rcode = pio_def_var(File, 'start_tod', PIO_INT, varid_start_tod)
1993 0 : rcode = pio_def_var(File, 'curr_ymd' , PIO_INT, varid_curr_ymd)
1994 0 : rcode = pio_def_var(File, 'curr_tod' , PIO_INT, varid_curr_tod)
1995 0 : rcode = pio_enddef(File)
1996 0 : rcode = pio_put_var(File, varid_start_ymd, start_ymd)
1997 0 : rcode = pio_put_var(File, varid_start_tod, start_tod)
1998 0 : rcode = pio_put_var(File, varid_curr_ymd, curr_ymd)
1999 0 : rcode = pio_put_var(File, varid_curr_tod, curr_tod)
2000 0 : call cam_pio_closefile(File)
2001 :
2002 0 : end subroutine cam_write_clockrest
2003 :
2004 : !===============================================================================
2005 0 : subroutine cam_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc)
2006 :
2007 : ! Generate a mesh for single column
2008 : use netcdf
2009 :
2010 : ! input/output variables
2011 : real(r8) , intent(in) :: scol_lon
2012 : real(r8) , intent(in) :: scol_lat
2013 : type(ESMF_Mesh) , intent(out) :: mesh
2014 : integer , intent(out) :: rc
2015 :
2016 : ! local variables
2017 : type(ESMF_Grid) :: lgrid
2018 : integer :: maxIndex(2)
2019 : real(r8) :: mincornerCoord(2)
2020 : real(r8) :: maxcornerCoord(2)
2021 : character(len=*), parameter :: subname= ' (lnd_set_mesh_for_single_column) '
2022 : !-------------------------------------------------------------------------------
2023 :
2024 0 : rc = ESMF_SUCCESS
2025 :
2026 : ! Use center and come up with arbitrary area delta lon and lat = .1 degree
2027 0 : maxIndex(1) = 1 ! number of lons
2028 0 : maxIndex(2) = 1 ! number of lats
2029 0 : mincornerCoord(1) = scol_lon - .1_r8 ! min lon
2030 0 : mincornerCoord(2) = scol_lat - .1_r8 ! min lat
2031 0 : maxcornerCoord(1) = scol_lon + .1_r8 ! max lon
2032 0 : maxcornerCoord(2) = scol_lat + .1_r8 ! max lat
2033 :
2034 : ! create the ESMF grid
2035 : lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, &
2036 : mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, &
2037 0 : staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc)
2038 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
2039 :
2040 : ! create the mesh from the lgrid
2041 0 : mesh = ESMF_MeshCreate(lgrid, rc=rc)
2042 0 : if (ChkErr(rc,__LINE__,u_FILE_u)) return
2043 :
2044 0 : end subroutine cam_set_mesh_for_single_column
2045 :
2046 : !===============================================================================
2047 : subroutine cam_pio_checkerr(ierror, description)
2048 : use pio, only : PIO_NOERR
2049 : integer , intent(in) :: ierror
2050 : character(*), intent(in) :: description
2051 : if (ierror /= PIO_NOERR) then
2052 : write (*,'(6a)') 'ERROR ', trim(description)
2053 : call shr_sys_abort()
2054 : endif
2055 : end subroutine cam_pio_checkerr
2056 :
2057 : end module atm_comp_nuopc
|
