ROMS
Loading...
Searching...
No Matches
mod_esmf_esm.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE mod_esmf_esm
3#if defined MODEL_COUPLING && defined ESMF_LIB && !defined CMEPS
4!
5!git $Id$
6!=======================================================================
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license Hernan G. Arango !
9! See License_ROMS.md Ufuk Utku Turuncoglu !
10!=======================================================================
11! !
12! This module defines the structures and variables for Earth System !
13! Model (ESM) coupling using the ESMF/NUOPC library. It also includes !
14! several support routines: !
15! !
16! allocate_esmf_esm Allocatess and initializes module structures !
17! variables. !
18! !
19! clock_report Inquire ESM driver and component clocks and !
20! reports current information. !
21! !
22! def_FieldAtt Creates output NetCDF file containing the !
23! field attribute varaibles needed to perform !
24! the time interpolation in concurrent coupling !
25! and when ESM components import time snapshots.!
26! !
27! field_index Scans an array structure of type ESM_Field !
28! containing a list of export or import fields !
29! short names (short_name) for requested field !
30! and returns its location index in the list. !
31! !
32! get_atm_Ngrids Reads atmosphere model number of nested grids !
33! (NgridsA) from input script or namelist. !
34! !
35! get_roms_Ngrids Reads ROMS number of nested grids (NgridsR) !
36! from input script (like ocean.in). !
37! !
38! get_weights Sets or reads in melding weights coefficients !
39! needed by the atmosphere model to merge fields!
40! from DATA and other ESM components because of !
41! incongruent grids. !
42! !
43! load_IFS Loads DATA Model source files information !
44! into the DataSet(:)%IFS structure. !
45! !
46! read_ESMconfig Reads in and reports ESM coupling coupling !
47! configuration parameter from standard input !
48! script (like coupling_esmf.in). !
49! !
50! report_timestamp Reports coupling time-stamp for requested !
51! field. !
52! !
53! set_metadata Process ESM coupling import and export fields !
54! metadata and adds fields to NUOPC dictionary. !
55! !
56! ESMF: Earth System Modeling Framework (Version 7 or higher) !
57! https://www.earthsystemcog.org/projects/esmf !
58! !
59! NUOPC: National Unified Operational Prediction Capability !
60! https://www.earthsystemcog.org/projects/nuopc !
61! !
62!=======================================================================
63!
64 USE esmf
65 USE nuopc
66!
67 USE mod_kinds
68 USE mod_iounits, ONLY : t_io
69!
70 implicit none
71!
72!-----------------------------------------------------------------------
73! ESM support routines.
74!-----------------------------------------------------------------------
75!
76 PRIVATE :: load_ifs
77!
78 PUBLIC :: allocate_esmf_esm
79 PUBLIC :: clock_report
80 PUBLIC :: def_fieldatt
81 PUBLIC :: field_index
82 PUBLIC :: get_atm_ngrids
83 PUBLIC :: get_roms_ngrids
84 PUBLIC :: get_weights
85 PUBLIC :: read_esmconfig
86 PUBLIC :: report_timestamp
87 PUBLIC :: set_metadata
88!
89!-----------------------------------------------------------------------
90! ESM generic data types structures.
91!-----------------------------------------------------------------------
92!
93! ESM coupling time managing variables and ESMF objects.
94
95 TYPE esm_clock
96 logical :: restarted
97
98 integer (i8b) :: advancecount ! advance counter
99
100 real (dp) :: current_time ! seconds
101 real (dp) :: time_reference ! seconds
102 real (dp) :: time_restart ! seconds
103 real (dp) :: time_start ! seconds
104 real (dp) :: time_stop ! seconds
105 real (dp) :: time_step ! seconds
106!
107 character (len=22) :: name
108 character (len=22) :: calendarstring ! 360_day, gregorian
109 character (len=22) :: time_referencestring
110 character (len=22) :: time_restartstring
111 character (len=22) :: time_startstring
112 character (len=22) :: time_stopstring
113!
114 TYPE (esmf_calendar) :: calendar
115 TYPE (esmf_clock) :: clock
116 TYPE (esmf_direction_flag) :: direction
117 TYPE (esmf_time) :: currenttime
118 TYPE (esmf_time) :: referencetime
119 TYPE (esmf_time) :: restarttime
120 TYPE (esmf_time) :: starttime
121 TYPE (esmf_time) :: stoptime
122 TYPE (esmf_timeinterval) :: timestep
123 END TYPE esm_clock
124!
125! ESM coupled state sets. If appropriate, it includes the logic for
126! connecting nested grids. The export state COUPLED(:)%ExportState(:,:)
127! will be only allocated and used here by the DATA component, for
128! example exporting to a specified atmosphere nested grid 'ng':
129!
130! COUPLED(Idata)%ExportState(ng,Iatmos)
131!
132! Notice that it is matrix because it is possible that the same dataset
133! will be used multiple times for different coupled sets (during
134! nesting), and likely, also needed by other ESM component(s).
135!
136! In other ESM components, the import and export states are defined and
137! allocated in the MODELS structure as vectors (see below).
138!
139 TYPE esm_cplset
140 logical, allocatable :: linkedgrid(:,:) ! connected grid
141!
142 integer, allocatable :: datacoupledsets(:,:) ! DATA linked sets
143!
144 character (len=100), allocatable :: setlabel(:) ! set label
145 character (len=100), allocatable :: explabel(:) ! export label
146 character (len=100), allocatable :: implabel(:) ! import label
147!
148 TYPE(esmf_state), allocatable :: exportstate(:,:) ! export set
149 END TYPE esm_cplset
150!
151 TYPE (esm_cplset), allocatable, target :: coupled(:)
152!
153! DATA model field processing information.
154!
155 TYPE esm_data
156 logical :: lcycle ! cycling time coordinate
157 logical :: lcoord ! coordinates attribute
158 logical :: lmask ! land/sea mask
159 logical :: lmulti ! field across multi-files
160 logical :: lastrec ! processed last record
161!
162 integer :: icomp ! target component index
163 integer :: ncid ! NetCDF file ID
164 integer :: tid ! time variable ID
165 integer :: vid ! field variable ID
166 integer :: nvdim ! number spatial dimensions
167 integer :: zlevel ! level index to process
168 integer :: nrec ! number of time records
169 integer :: trec ! latest read time record
170 integer :: tindex ! rolling two-time indices
171 integer :: landvalue ! Masking land value
172 integer :: seavalue ! Masking sea value
173!
174 integer, allocatable :: vsize(:) ! dimensions size
175!
176 real(dp) :: add_offset ! add_offset attribute
177 real(dp) :: fillvalue ! _FillValue attribute
178 real(dp) :: scale_factor ! scale_factor attribute
179 real(dp) :: clength ! time cycling length
180 real(r8) :: lonmin ! grid minimum longitude
181 real(r8) :: lonmax ! grid maximum longitude
182 real(r8) :: latmin ! grid minimum latitude
183 real(r8) :: latmax ! grid maximum latitude
184 real(dp) :: tscale ! time scale to day
185 real(dp) :: tmono ! monotonic time (days)
186 real(dp) :: tmin ! time minimum value
187 real(dp) :: tmax ! time maximum value
188 real(dp) :: tstr ! lower time-snapshot
189 real(dp) :: tend ! upper time-snapshot
190 real(r8) :: vmin ! variable minimum value
191 real(r8) :: vmax ! variable maximum value
192 real(dp) :: tintrp(2) ! interpolation time (days)
193 real(dp) :: vtime(2) ! latest two-time values
194 real(dp) :: date(6,2) ! time-snapshots dates
195! YYYY,MM,DD hh:mm:ss.ss
196 character(len=30), allocatable :: dname(:) ! variable
197! dimensions names
198 character(len=20), allocatable :: vcoord(:) ! variable
199! coordinates names
200 character(len=22 ) :: datestring(2) ! date-snapshots string
201 character(len=30 ) :: specialaction ! special processing
202 character(len=100) :: tname ! time variable name
203 character(len=100) :: tunits ! time variable units
204 character(len=100) :: vname ! variable name
205 character(len=100) :: vunits ! variable units
206 character(len=256) :: vdescriptor ! Variable descriptive name
207 character(len=256) :: vlongname ! long_name attribute
208 character(len=256) :: ncfile ! NetCDF filename
209!
210 real(r8), allocatable :: lon(:,:) ! field longitude
211 real(r8), allocatable :: lat(:,:) ! field latitude
212 real(r8), allocatable :: mask(:,:) ! field land/sea mask
213!
214 real(r8), allocatable :: a2d(:,:) ! time interpolated 2D data
215 real(r8), allocatable :: a3d(:,:,:) ! time interpolated 3d data
216 real(r8), allocatable :: a2dg(:,:,:) ! latest 2D data snapsnots
217 real(r8), allocatable :: a3dg(:,:,:,:)! latest 3D data snapsnots
218!
219 TYPE (esmf_field) :: field ! field object
220 TYPE (esmf_grid) :: grid ! field grid object
221 TYPE (esmf_routehandle) :: rhandle ! field RouteHandle
222 END TYPE esm_data
223!
224! DATA model high-level structure.
225!
226 TYPE esm_dataset
227 integer :: nfields ! number of fields
228 integer :: nfiles ! number of input files
229!
230 character(len=20), allocatable :: ctarget(:) ! component target
231 character(len=20), allocatable :: field(:) ! field short-name
232!
233 TYPE (esm_data), allocatable :: export(:) ! Export field
234! structure
235 TYPE (t_io), allocatable :: ifs(:) ! Input Files
236! Structure
237 END TYPE esm_dataset
238!
239! Import and export fields metadata information.
240!
241 TYPE esm_field
242 logical :: connected ! connected to coupler
243 logical :: debug_write ! write exchanged field
244 logical :: enable_integral_adj ! area integral adjusted
245
246 integer :: fid ! internal field ID
247 integer :: gtype ! field grid mesh type
248 integer :: etype ! field extrapolation flag
249 integer :: itype ! field interpolation flag
250 integer :: tindex ! rolling two-time indices
251
252 character (len=20) :: ctarget ! component destination
253 character (len=22) :: datestring(2) ! date-snapshots string
254
255 character (len=:), allocatable :: short_name ! short name
256 character (len=:), allocatable :: standard_name ! standard name
257 character (len=:), allocatable :: long_name ! long name
258 character (len=:), allocatable :: dst_gtype ! DST grid type
259 character (len=:), allocatable :: dst_units ! DST units
260 character (len=:), allocatable :: src_gtype ! SRC grid type
261 character (len=:), allocatable :: src_units ! SRC units
262 character (len=:), allocatable :: nc_vname ! DATA Vname
263 character (len=:), allocatable :: nc_tname ! DATA Tname
264 character (len=:), allocatable :: regridmethod ! regrid method
265 character (len=:), allocatable :: extrapmethod ! extrapolate
266
267 real (r8) :: scale_factor ! field scale factor
268 real (r8) :: add_offset ! field add offset value
269 real (r8) :: tmin ! DATA time minimum value
270 real (r8) :: tmax ! DATA time maximum value
271 real (r8) :: tstr ! DATA lower time-snapshot
272 real (r8) :: tend ! DATA upper time-snapshot
273 real (r8) :: tintrp(2) ! interpolation time (days)
274 real (r8) :: vtime(2) ! latest two-time values
275
276 TYPE (esmf_routehandle) :: rhandle ! field RouteHandle
277 END TYPE esm_field
278!
279! Import and export fields mesh data.
280!
281 TYPE esm_mesh
282 integer :: gid ! grid ID
283 integer :: gtype ! grid mesh type
284
285 integer (i4b), allocatable :: mask(:,:) ! grid land/sea mask
286
287 real (r8), allocatable :: lon(:,:) ! grid longitude
288 real (r8), allocatable :: lat(:,:) ! grid latitude
289 real (r8), allocatable :: area(:,:) ! grid area
290 END TYPE esm_mesh
291!
292! Melding coefficients used to combine fields from DATA and ESM
293! components. The weight factors are read from the input NetCDF
294! specified in the "WeightsFile(atmos)" keyword. The user has
295! full control of how the merging is done. It is recommended to
296! provide a gradual transition between the two components.
297!
298! Recall that the DATA component supplies needed data to a particular
299! ESM component. For example, it may export data to the atmosphere
300! model at locations not covered by the other ESM components because
301! of smaller grid coverage. If the atmosphere and ocean model grids
302! are incongruent, the atmosphere component needs to import sea surface
303! temperature (SST) on those grid points not covered by the ocean
304! component. Thus, the weighting coefficients are used to merge the
305! SST data:
306!
307! SST_atm(:,:) = Cesm(:,:) * SST_esm(;,;) + Cdat(:,:) * SST_dat(:,:)
308!
309! where Cesm(:,:) + Cdat(:,:) = 1.
310!
311 TYPE esm_meld
312 integer :: nestedgrid ! grid needing merged field
313
314 character(len=100) :: vnamedata ! DATA weights variable name
315 character(len=100) :: vnameesm ! ESM weights variable name
316 character(len=256) :: ncfile ! Weights NetCDF filename
317
318 real (r8), allocatable :: cdat(:,:) ! coefficients for DATA
319 real (r8), allocatable :: cesm(:,:) ! coefficients for ESM
320 END TYPE esm_meld
321!
322 TYPE (esm_meld), allocatable, target :: weights(:)
323!
324 real(dp) :: weightdat = 0.0_dp ! DATA component weight
325 real(dp) :: weightesm = 1.0_dp ! ESM component weight
326!
327! Coupled models high-level data structure, [Nmodels].
328!
329! The coupling field (Import/Export) exchange is determined by the
330! TimeStep/TimeFrac. Where TimeStep is the coupling driver interval
331! and TimeFrac is the fraction from Time/Step between the connector
332! between two ESM components.
333!
334 TYPE esm_model
335 logical :: isactive ! active for coupling
336
337 integer (i4b) :: landvalue ! land mask value
338 integer (i4b) :: seavalue ! sea mask value
339
340 integer :: ngrids ! number nested grids
341
342 integer :: exportcalls ! export CALL counter
343 integer :: importcalls ! import CALL counter
344
345 integer :: npets ! number model PETs
346 integer, allocatable :: petlist(:) ! model PETs list
347
348 integer, allocatable :: timefrac(:,:) ! driver time fraction
349
350 character (len=100) :: name ! model name
351
352 TYPE (esmf_grid), allocatable :: grid(:) ! grid object
353 TYPE (esm_mesh), allocatable :: mesh(:) ! mesh
354 TYPE (esm_field), allocatable :: importfield(:) ! import fields
355 TYPE (esm_field), allocatable :: exportfield(:) ! export fields
356 TYPE (esmf_state), allocatable :: importstate(:) ! import state
357 TYPE (esmf_state), allocatable :: exportstate(:) ! export state
358 END TYPE esm_model
359!
360 TYPE (esm_model), allocatable, target :: models(:)
361!
362! Coupling models connector used for the interpolation/extrapolaton
363! between source and destination fields, [Nmodels, Nmodels].
364!
365 TYPE esm_conn
366 logical :: isactive ! active connector
367
368 integer :: divdt
369 integer :: maskinteraction ! connector mask interaction
370
371 integer :: npets ! number of connector PETs
372 integer, allocatable :: petlist(:) ! connector PETs list
373
374 character (len=100) :: name ! connector name
375 END TYPE esm_conn
376!
377 TYPE (esm_conn), allocatable, target :: connectors(:,:)
378!
379! ESM import and export fields dictionary. The fields are read from
380! metadata file (CPLname).
381!
382 integer, parameter :: maxnumberfields = 200
383 integer :: nfields ! processed and loaded
384!
385 TYPE (esm_field) :: fields(maxnumberfields)
386!
387! Define DATA Model field processing information from input data files,
388! [1:Nmodels]. Currently, the DATA Model only export fields and it
389! only supports input NetCDF files.
390!
391 TYPE (esm_dataset), allocatable, target :: dataset(:)
392!
393! ESM clock for driver (zeroth element) and coupled components,
394! [0:Nmodels].
395!
396 TYPE (esm_clock), allocatable, target :: clockinfo(:)
397!
398!-----------------------------------------------------------------------
399! ESM coupling parameters.
400!-----------------------------------------------------------------------
401!
402! Number of coupled ESM gridded components. Currently, five
403! ESM components are supported (ROMS, DATA, Atmosphere, Sea-ice, and
404! wave model).
405!
406! All supported components are accounted here even if we are running
407! an application with less number of models. The IsActive switches
408! are use to operate only on the desired coupled components. This
409! is done to have complete infornation in the above structures. The
410! gridded arrays are never allocated if a particular component is not
411! active.
412!
413 integer :: nmodels = 5
414!
415! Number of nested grids. Initialize to just one grid; its values
416! are overwritten during processing.
417!
418! (An additional variable NgridsR is created to avoid using ROMS
419! module "mod_param" in the generic interface. Both Ngrids and
420! NgridsR have the same value)
421!
422 integer :: ngridsa = 1 ! Atmosphere Model
423 integer :: ngridsd = 1 ! DATA Model
424 integer :: ngridsi = 1 ! Sea-ice Model
425 integer :: ngridsr = 1 ! ROMS
426 integer :: ngridsw = 1 ! Wave Model
427!
428! Coupled models identification indices. ROMS needs to be the
429! first index since we are using several of its modules to
430! initialize the coupled system.
431!
432 integer :: idriver = 0
433 integer :: iroms = 1
434 integer :: iatmos = 2
435 integer :: idata = 3
436 integer :: iseaice = 4
437 integer :: iwave = 5
438!
439! Generic ESM component labels used in the CASE constructs. We cannot
440! use the identification indices because the vector Iroms(:) cannot
441! be defined as a parameter and a non constant expression is illegal:
442!
443! CASE ( Iroms(1) : Iroms(NgridsR) )
444!
445 character (len= 3), allocatable :: clabel(:)
446 character (len=10), allocatable :: cmodel(:)
447!
448! Number of ESM import and export fields, [Nmodels].
449!
450 integer, allocatable :: nimport(:)
451 integer, allocatable :: nexport(:)
452!
453! Model coupling type: [1] Explicit, [otherwise] Semi-Implicit.
454!
455! In explicit coupling, exchange fields at the next time-step are
456! defined using known values from the time-step before it. Explicit
457! methods require less computational effort and are accurate for
458! small coupling time-steps.
459!
460! In implicit coupling, exchange fields at the next time-step are
461! defined by including values at the next time-step. Implicit methods
462! are stable and allow longer coupling time-steps but are expensier.
463!
464! In semi-implicit coupling, ROMS -> ATM is explicit, ATM -> ROMS is
465! implicit.
466!
467 integer :: couplingtype = 1
468!
469! Driver virtual Machine (VM) parallel enviroment object.
470!
471 TYPE (esmf_vm) :: vmdriver
472!
473! PET layout: sequential or concurrent.
474!
475 character (len=10) :: petlayoutoption
476!
477! Total number of PETs needed in concurrent PET layout and rank for
478! each PET.
479!
480 integer :: sumpets
481 integer :: petrank
482!
483! MPI Communicator handle for each ESM component.
484!
485 integer, allocatable :: esmcomm(:)
486!
487! Driver clock parameters specified in configuration script. A integer
488! vector with six elements:
489!
490! (1) year including century, like 2017
491! (2) month of the year, 1 to 12
492! (3) day of the month
493! (4) hour of the day, 0 to 23
494! (5) minutes of the hour, 0 to 59
495! (6) seconds of the minute, 0 to 59
496!
497 integer :: referencedate(6) ! reference date
498 integer :: restartdate(6) ! restarting date
499 integer :: startdate(6) ! starting date
500 integer :: stopdate(6) ! stopping date
501 integer :: timestep(6) ! coupling interval
502!
503! Today date string.
504!
505 character (len=44) :: todaydatestring
506!
507! ESM coupling simulation reference date number:
508!
509! (1) seconds
510! (2) fractional days
511!
512 real(dp) :: referencedatenumber(2)
513!
514! DATA component parallel distributed-memory domain partions in the
515! I- and J-directions (lon,lat).
516!
517 integer :: itiled
518 integer :: jtiled
519!
520! Coupling debugging flag:
521!
522! [0] no debugging
523! [1] reports informative messages
524! [2] '1' plus writes grid information in VTK format
525! [3] '2' plus writes exchage fields into NetCDF files
526!
527 integer :: debuglevel = 0
528!
529! Execution tracng flag:
530!
531! [0] no tracing
532! [1] reports sequence of coupling subroutine calls
533! [2] <1> plus writes voluminous ESMF library tracing
534! information which slowdown performace, and
535! creates large log file
536!
537 integer :: tracelevel = 0
538!
539! Switch to trace/track run sequence during debugging. All information
540! is written to Fortan unit trac. For now, use standard output unit.
541!
542 logical :: esm_track = .false. ! trace/track CALL sequence switch
543 integer :: trac = 6 ! trace/track CALL sequence unit
544!
545! Coupled model staggered grid-cell type indices:
546!
547! Arakawa B-grid Arakawa C-grid
548!
549! q --------- q q --- v --- q
550! | | | |
551! | c | u c u
552! | | | |
553! q --------- q q --- v --- q
554!
555! COAMPS, C-grid
556! RegCM, B-grid
557! ROMS, C-grid (c = RHO-point, q = PSI-point)
558! WRF, C-grid
559!
560 integer, parameter :: inan = 0 ! unstaggered, cell center
561 integer, parameter :: icenter = 1 ! cell center
562 integer, parameter :: icorner = 2 ! cell corners
563 integer, parameter :: iupoint = 3 ! right and left cell faces
564 integer, parameter :: ivpoint = 4 ! upper and lower cell faces
565!
566 character (len=6), dimension(0:4) :: gridtype = &
567 & (/ 'N/A ', &
568 & 'Center', &
569 & 'Corner', &
570 & 'U ', &
571 & 'V ' /)
572!
573! REGRID interpolation method between source and destination fields.
574!
575 integer, parameter :: inone = 0 ! none
576 integer, parameter :: ibilin = 1 ! bilinear
577 integer, parameter :: ipatch = 2 ! high-order patch recovery
578 integer, parameter :: iconsv1 = 3 ! first-order conservative
579 integer, parameter :: iconsv2 = 4 ! second-order conservative
580 integer, parameter :: instod = 5 ! nearest neighbor Src 2 Dst
581 integer, parameter :: indtos = 6 ! nearest neighbor Dst 2 Src
582!
583 character (len=4), dimension(0:6) :: intrptype = &
584 & (/ 'NONE', &
585 & 'BLIN', &
586 & 'PTCH', &
587 & 'CNS1', &
588 & 'CNS2', &
589 & 'NS2D', &
590 & 'ND2S' /)
591!
592! Extrapolation method for unmapped destination points.
593!
594 integer, parameter :: enone = 0 ! none
595 integer, parameter :: exstod = 1 ! nearear neighbor Src 2 Dst
596 integer, parameter :: eidavg = 2 ! inverse distance average
597 integer, parameter :: ecreep = 3 ! creep fill
598 integer, parameter :: e2steps = 4 ! Turuncoglu two steps
599!
600 character (len=4), dimension(0:4) :: extrptype = &
601 & (/ 'NONE', &
602 & 'NS2D', &
603 & 'IDAV', &
604 & 'CREE', &
605 & '2STP' /)
606!
607! The number of levels to output for the extrapolation methods that
608! fill levels, like creep fill (ESMF_EXTRAPMETHOD_CREEP). Unmapped
609! destination points are supplied by repeatedly moving data from
610! mapped locations to neighboring unmapped locations for a user-
611! specified number of levels. For each creeped point, its value is
612! the average of the values of the immediate neighbors from the
613! mapped points from regridding (ESMF Reference Manual, v 8.0.0).
614!
615 integer :: extrapnumlevels = 1
616!
617! Interpolation connectors mask interaction flags.
618!
619 integer, parameter :: overland = 1
620 integer, parameter :: overocean = 2
621 integer, parameter :: overall = 3
622!
623 character (len=3), dimension(3) :: masktype = &
624 & (/ 'LND', &
625 & 'OCN', &
626 & 'ALL'/)
627!
628! Coupling run mode: sequential or concurrent.
629!
630 integer, parameter :: iseq = 1
631 integer, parameter :: ipar = 2
632!
633 character (len=10), dimension(2) :: runmode = &
634 & (/ 'SEQUENTIAL', &
635 & 'CONCURRENT' /)
636!
637! Compling standard input parameters filename.
638!
639 character (len=256) :: cinpname
640!
641! ESM free-format run sequence configuration filename
642!
643 character (len=256) :: confname
644!
645! Coupling Import/Export variable metadata filename.
646!
647 character (len=256) :: cplname
648!
649! Standard input filename for each coupled model, [Nmodels].
650!
651 character (len=256), allocatable :: inpname(:)
652!
653! Standard output units coupler and log messages filename
654! for coupler and ESMF library.
655!
656 integer :: cplout = 77 ! coupling driver
657 integer :: dataout = 77 ! data component
658!
659 character (len= 8), parameter :: esmnamelog = 'log.esmf'
660 character (len=11), parameter :: couplerlog = 'log.coupler'
661!
662! Output NetCDF file used to store field snapshot attributes needed for
663! time interpolation by the ESM component kernel during concurrent
664! coupling.
665!
666 character (len=17), parameter :: attfilename = 'time_intrp_att.nc'
667!
668!-----------------------------------------------------------------------
669! ESM constants
670!-----------------------------------------------------------------------
671!
672 integer (i4b), parameter :: mapped_mask = 99_i4b
673 integer (i4b), parameter :: unmapped_mask = 98_i4b
674
675 real (dp), parameter :: missing_dp = 1.0e20_dp
676 real (r4), parameter :: missing_r4 = 1.0e20_r4
677 real (r8), parameter :: missing_r8 = 1.0e20_r8
678
679 real (dp), parameter :: tol_dp = 0.001e20_dp
680 real (r4), parameter :: tol_r4 = 0.001e20_r4
681 real (r8), parameter :: tol_r8 = 0.001e20_r8
682!
683 CONTAINS
684!
685 SUBROUTINE allocate_esmf_esm
686!
687!=======================================================================
688! !
689! This routine allocates module coupling structures. !
690! !
691!=======================================================================
692!
693! Local variable definitions.
694!
695 integer :: i, j, ng
696
697 character (len= 1), parameter :: blank = ' '
698 character (len=50) :: mylabel
699!
700!-----------------------------------------------------------------------
701! Allocate coupling structures.
702!-----------------------------------------------------------------------
703!
704! Allocate coupled models high-level data structure.
705!
706 IF (.not.allocated(models)) THEN
707 allocate ( models(nmodels) )
708 END IF
709 DO i=1,nmodels
710 models(i) % IsActive = .false.
711 models(i) % nPETs = 0
712 models(i) % Ngrids = 0
713 END DO
714!
715! Allocate coupled state set high-level structure.
716!
717 IF (.not.allocated(coupled)) THEN
718 allocate ( coupled(nmodels) )
719 END IF
720
721# ifdef DATA_COUPLING
722!
723! Allocate melding weights structure.
724!
725 IF (.not.allocated(weights)) THEN
726 allocate ( weights(nmodels) )
727 END IF
728 DO i=1,nmodels
729 weights(i) % VnameDATA = blank
730 weights(i) % VnameESM = blank
731 weights(i) % ncfile = blank
732 weights(i) % NestedGrid = 0
733 END DO
734# endif
735!
736! Set counter for ESM component calls to export and import routines.
737! It is used to check if the ESM component has the two time-snapshots
738! to performs time interpolation of export and import fields.
739!
740 DO i=1,nmodels
741 models(i) % ExportCalls = 0
742 models(i) % ImportCalls = 0
743 END DO
744!
745! Allocate coupled models connector structure.
746!
747 IF (.not.allocated(connectors)) THEN
748 allocate ( connectors(nmodels,nmodels) )
749 END IF
750 DO j=1,nmodels
751 DO i=1,nmodels
752 connectors(i,j) % IsActive = .false.
753 connectors(i,j) % MaskInteraction = overocean
754 connectors(i,j) % nPETs = 0
755 END DO
756 END DO
757!
758! Allocate drivers and coupled models clock information structure.
759!
760 IF (.not.allocated(clockinfo)) THEN
761 allocate ( clockinfo(0:nmodels) )
762 END IF
763 DO i=0,nmodels
764 clockinfo(i)%Restarted=.false.
765 END DO
766!
767! Allocate MPI communicator handle for each ESM component.
768!
769 IF (.not.allocated(esmcomm)) THEN
770 allocate ( esmcomm(0:nmodels) )
771 END IF
772 esmcomm=0
773!
774! Allocate number of import and export ESM fields.
775!
776 IF (.not.allocated(nimport)) THEN
777 allocate ( nimport(nmodels) )
778 END IF
779 nimport=0
780!
781 IF (.not.allocated(nexport)) THEN
782 allocate ( nexport(nmodels) )
783 END IF
784 nexport=0
785!
786! Allocate DATA Model high-level structure.
787!
788 IF (.not.allocated(dataset)) THEN
789 allocate ( dataset(nmodels) )
790 END IF
791 DO i=1,nmodels
792 dataset(i)%Nfields=0
793 dataset(i)%Nfiles=0
794 END DO
795!
796! Standard input filename for each ESM component.
797!
798 IF (.not.allocated(inpname)) THEN
799 allocate ( inpname(nmodels) )
800 END IF
801 DO i=1,nmodels
802 inpname(i)=blank
803 END DO
804!
805! Generic ESM component labels used in the CASE constructs.
806!
807 IF (.not.allocated(cmodel)) THEN
808 allocate ( clabel(nmodels) )
809 END IF
810 clabel(iroms )='OCN'
811 clabel(iatmos )='ATM'
812 clabel(idata )='DAT'
813 clabel(iseaice)='ICE'
814 clabel(iwave )='WAV'
815!
816 IF (.not.allocated(cmodel)) THEN
817 allocate ( cmodel(nmodels) )
818 END IF
819 cmodel(iroms )='ROMS'
820# if defined COAMPS_COUPLING
821 cmodel(iatmos )='COAMPS'
822# elif defined REGCM_COUPLING
823 cmodel(iatmos )='RegCM'
824# elif defined WRF_COUPLING
825 cmodel(iatmos )='WRF'
826# else
827 cmodel(iatmos )='ATMOS'
828# endif
829 cmodel(idata )='DATA'
830# if defined CICE_COUPLING
831 cmodel(iseaice)='CICE'
832# else
833 cmodel(iseaice)='SEAICE'
834# endif
835# if defined WAM_COUPLING
836 cmodel(iwave )='WAM'
837# else
838 cmodel(iwave )='WAVES'
839# endif
840!
841! Set ESM component name.
842!
843 DO i=1,nmodels
844 models(i)%name=trim(cmodel(i))
845 END DO
846!
847 RETURN
848 END SUBROUTINE allocate_esmf_esm
849!
850 SUBROUTINE clock_report (model, Icomp, localPET, source, rc)
851!
852!=======================================================================
853! !
854! Inquire ESM driver and component clock and report information. !
855! !
856! On Input: !
857! !
858! model ESM component ESMF object (ESMF_GridComp) !
859! Icomp Component index in ESM structures (integer) !
860! localPET Local Persistent Execution Thread (integer) !
861! source calling routine (string) !
862! !
863! On Output: !
864! !
865! DataSet Updata DATA Model high-level structure in module !
866! !
867!=======================================================================
868!
869! Imported variable declarations.
870!
871 integer, intent(in) :: icomp, localpet
872 integer, intent(out) :: rc
873!
874 character (len=*) :: source
875!
876 TYPE (esmf_gridcomp) :: model
877!
878! Local variable declarations.
879!
880 logical :: isactive
881!
882 integer :: i, is
883 integer :: alarmcount(0:nmodels)
884
885 integer (i8b) :: advancecount(0:nmodels)
886!
887 real (dp) :: scale
888 real (dp) :: runtimestepcount(0:nmodels)
889 real (dp) :: timecurr(0:nmodels)
890 real (dp) :: timenext(0:nmodels)
891 real (dp) :: timeprev(0:nmodels)
892 real (dp) :: timestart(0:nmodels)
893 real (dp) :: timestop(0:nmodels)
894 real (dp) :: time_dura(0:nmodels)
895 real (dp) :: time_step(0:nmodels)
896!
897 character (len=22) :: clockname(0:nmodels)
898 character (len=22) :: directionstring(0:nmodels)
899 character (len=22) :: timecurrstring(0:nmodels)
900 character (len=22) :: timenextstring(0:nmodels)
901 character (len=22) :: timeprevstring(0:nmodels)
902 character (len=22) :: timestartstring(0:nmodels)
903 character (len=22) :: timestopstring(0:nmodels)
904
905 character (len=*), parameter :: myfile = &
906 & __FILE__//", clock_report"
907!
908 TYPE (esmf_clock) :: clock(0:nmodels)
909 TYPE (esmf_direction_flag) :: direction(0:nmodels)
910 TYPE (esmf_timeinterval) :: runduration(0:nmodels)
911 TYPE (esmf_timeinterval) :: timestep(0:nmodels)
912 TYPE (esmf_time) :: currtime(0:nmodels)
913 TYPE (esmf_time) :: prevtime(0:nmodels)
914 TYPE (esmf_time) :: starttime(0:nmodels)
915 TYPE (esmf_time) :: stoptime(0:nmodels)
916!
917!-----------------------------------------------------------------------
918! Initialize return code flag to success state (no error).
919!-----------------------------------------------------------------------
920!
921 rc=esmf_success
922!
923!-----------------------------------------------------------------------
924! Inquire driver and compones clocks.
925!-----------------------------------------------------------------------
926!
927 scale=1.0_dp/86400.0_dp
928!
929 DO i=0,nmodels
930 IF (i.eq.0) THEN
931 isactive=.true. ! ESM driver
932 ELSE
933 isactive=models(i)%IsActive ! ESM components
934 END IF
935 IF (isactive) THEN
936 clock(i)=clockinfo(i)%Clock
937 CALL esmf_clockget (clock(i), &
938 & timestep = timestep(i), &
939 & starttime = starttime(i), &
940 & stoptime = stoptime(i), &
941 & runduration = runduration(i), &
942 & runtimestepcount = runtimestepcount(i), &
943 & currtime = currtime(i), &
944 & prevtime = prevtime(i), &
945 & advancecount = advancecount(i), &
946 & alarmcount = alarmcount(i), &
947 & direction = direction(i), &
948 & name = clockname(i), &
949 & rc = rc)
950 IF (esmf_logfounderror(rctocheck=rc, &
951 & msg=esmf_logerr_passthru, &
952 & line=__line__, &
953 & file=myfile)) THEN
954 RETURN
955 END IF
956 IF (direction(i).eq.esmf_direction_forward) THEN
957 directionstring(i)='FORWARD'
958 ELSE
959 directionstring(i)='REVERSE'
960 END IF
961 clockinfo(i)%AdvanceCount=advancecount(i)
962!
963 CALL esmf_timeget (starttime(i), &
964 & s_r8=timestart(i), &
965 & timestring=timestartstring(i), &
966 & rc=rc)
967 IF (esmf_logfounderror(rctocheck=rc, &
968 & msg=esmf_logerr_passthru, &
969 & line=__line__, &
970 & file=myfile)) THEN
971 RETURN
972 END IF
973 is=index(timestartstring(i), 'T') ! remove 'T' in
974 IF (is.gt.0) timestartstring(i)(is:is)=' ' ! ISO 8601 format
975!
976 CALL esmf_timeget (stoptime(i), &
977 & s_r8=timestop(i), &
978 & timestring=timestopstring(i), &
979 & rc=rc)
980 IF (esmf_logfounderror(rctocheck=rc, &
981 & msg=esmf_logerr_passthru, &
982 & line=__line__, &
983 & file=myfile)) THEN
984 RETURN
985 END IF
986 is=index(timestopstring(i), 'T') ! remove 'T' in
987 IF (is.gt.0) timestopstring(i)(is:is)=' ' ! ISO 8601 format
988!
989 CALL esmf_timeget (prevtime(i), &
990 & s_r8=timeprev(i), &
991 & timestring=timeprevstring(i), &
992 & rc=rc)
993 IF (esmf_logfounderror(rctocheck=rc, &
994 & msg=esmf_logerr_passthru, &
995 & line=__line__, &
996 & file=myfile)) THEN
997 RETURN
998 END IF
999 is=index(timeprevstring(i), 'T') ! remove 'T' in
1000 IF (is.gt.0) timeprevstring(i)(is:is)=' ' ! ISO 8601 format
1001!
1002 CALL esmf_timeget (currtime(i), &
1003 & s_r8=timecurr(i), &
1004 & timestring=timecurrstring(i), &
1005 & rc=rc)
1006 IF (esmf_logfounderror(rctocheck=rc, &
1007 & msg=esmf_logerr_passthru, &
1008 & line=__line__, &
1009 & file=myfile)) THEN
1010 RETURN
1011 END IF
1012 is=index(timecurrstring(i), 'T') ! remove 'T' in
1013 IF (is.gt.0) timecurrstring(i)(is:is)=' ' ! ISO 8601 format
1014!
1015 CALL esmf_timeget (currtime(i)+timestep(i), &
1016 & s_r8=timenext(i), &
1017 & timestring=timenextstring(i), &
1018 & rc=rc)
1019 IF (esmf_logfounderror(rctocheck=rc, &
1020 & msg=esmf_logerr_passthru, &
1021 & line=__line__, &
1022 & file=myfile)) THEN
1023 RETURN
1024 END IF
1025 is=index(timenextstring(i), 'T') ! remove 'T' in
1026 IF (is.gt.0) timenextstring(i)(is:is)=' ' ! ISO 8601 format
1027!
1028 CALL esmf_timeintervalget (timestep(i), &
1029 & s_r8=time_step(i), &
1030 & rc=rc)
1031 IF (esmf_logfounderror(rctocheck=rc, &
1032 & msg=esmf_logerr_passthru, &
1033 & line=__line__, &
1034 & file=myfile)) THEN
1035 RETURN
1036 END IF
1037!
1038 CALL esmf_timeintervalget (runduration(i), &
1039 & s_r8=time_dura(i), &
1040 & rc=rc)
1041 IF (esmf_logfounderror(rctocheck=rc, &
1042 & msg=esmf_logerr_passthru, &
1043 & line=__line__, &
1044 & file=myfile)) THEN
1045 RETURN
1046 END IF
1047!
1048! Report clock information
1049!
1050 IF ((debuglevel.gt.0).and.(localpet.eq.0)) THEN
1051 WRITE (cplout,10) &
1052 & ' Clock Name: ', trim(clockname(i))//' in '//source,&
1053 & ' Start Time: ', trim(timestartstring(i)), &
1054 & timestart(i)*scale, &
1055 & ' Stop Time: ', trim(timestopstring(i)), &
1056 & timestop(i)*scale, &
1057 & ' Prev Time: ', trim(timeprevstring(i)), &
1058 & timeprev(i)*scale, &
1059 & ' Current Time: ', trim(timecurrstring(i)), &
1060 & timecurr(i)*scale, &
1061 & ' Next Time: ', trim(timenextstring(i)), &
1062 & timenext(i)*scale, &
1063 & ' Time Interval: ', time_step(i), time_step(i)*scale, &
1064 & ' Run Duration: ', time_dura(i), time_dura(i)*scale, &
1065 & ' Stepping Count: ', runtimestepcount(i), &
1066 & ' Advance Count: ', advancecount(i), &
1067 & 'Current Direction: ', trim(directionstring(i)), &
1068 & ' Alarm Count: ', alarmcount(i)
1069 END IF
1070 END IF
1071 END DO
1072 IF (debuglevel.gt.0) FLUSH (cplout)
1073!
1074! Store the clock advance counter.
1075!
1076 10 FORMAT(/,4x,a,a,/,5(4x,a,a,2x,f15.8,/),2(4x,a,f19.8,2x,f15.8,/), &
1077 & 4x,a,f19.8,/,4x,a,2x,i8,/,4x,a,a,/,4x,a,2x,i8,/)
1078!
1079 RETURN
1080 END SUBROUTINE clock_report
1081!
1082 INTEGER FUNCTION field_index (Fnames, Fvalue) RESULT (Findex)
1083!
1084!=======================================================================
1085! !
1086! This integer function scans an array structure of type ESM_Field !
1087! containing fields short_name list for specific field value and !
1088! returns its location index in the list. !
1089! !
1090!=======================================================================
1091!
1092! Imported variable declarations.
1093!
1094 character (len=*), intent(in) :: fvalue
1095
1096 TYPE (esm_field), intent(in) :: fnames(:)
1097!
1098! Local variable declarations.
1099!
1100 integer :: mfields
1101 integer :: i
1102!
1103!-----------------------------------------------------------------------
1104! Find index of specified field from names list.
1105!-----------------------------------------------------------------------
1106!
1107 mfields=SIZE(fnames, dim=1)
1108 findex=-1
1109!
1110 DO i=1,mfields
1111 IF (trim(fnames(i)%short_name).eq.trim(fvalue)) THEN
1112 findex=i
1113 EXIT
1114 END IF
1115 END DO
1116!
1117 RETURN
1118 END FUNCTION field_index
1119!
1120 INTEGER FUNCTION get_atm_ngrids (Sname,localPET) RESULT (MyValue)
1121!
1122!=======================================================================
1123! !
1124! This function reads number of nested grids from atmosphere model !
1125! input script or namelist. !
1126! !
1127!=======================================================================
1128!
1129 USE mod_scalars, ONLY : noerror, exit_flag
1130!
1131 USE strings_mod, ONLY : founderror
1132!
1133! Imported variable declarations.
1134!
1135 integer, intent(in) :: localpet
1136!
1137 character (len=*), intent(in) :: sname
1138!
1139! Local variable declarations.
1140!
1141 integer :: equal, ie, is, inp, io_err, out
1142!
1143 character (len= 40) :: keyword
1144 character (len=256) :: io_errmsg, line
1145
1146 character (len=*), parameter :: myfile = &
1147 & __FILE__//", get_atm_Ngrids"
1148
1149#if defined COAMPS_COUPLING || defined WRF_COUPLING
1150!
1151!-----------------------------------------------------------------------
1152! Read atmosphere model number of nested grids from input script or
1153! namelist.
1154!-----------------------------------------------------------------------
1155!
1156 inp=2
1157 out=cplout
1158!
1159# if defined COAMPS_COUPLING
1160 keyword='nnest' ! COAMPS "gridnl" namelist parameter
1161# elif defined WRF_COUPLING
1162 keyword='max_dom' ! WRF "domains" namelist parameter
1163# endif
1164 OPEN (inp, file=trim(sname), form='formatted', status='old', &
1165 & iostat=io_err, iomsg=io_errmsg)
1166 IF (io_err.ne.0) THEN
1167 IF (localpet.eq.0) WRITE (out,30) trim(sname), trim(io_errmsg)
1168 exit_flag=5
1169 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1170 END IF
1171!
1172! Read script/namelist keyword parameter.
1173!
1174 DO WHILE (.true.)
1175 READ (inp,'(a)',err=10,END=20) line
1176 is=index(line, trim(keyword))
1177 equal=index(line, char(61), back=.false.) ! equal sign
1178 IF ((is.ne.0).and.(equal.ne.0)) THEN
1179 is=equal+1
1180 ie=len_trim(line)
1181 READ (line(is:ie),*) myvalue
1182 IF (myvalue.le.0) THEN
1183 IF (localpet.eq.0) WRITE (out,40) trim(keyword), myvalue, &
1184 & 'must be greater than zero.'
1185 exit_flag=5
1186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1187 END IF
1188 END IF
1189 END DO
1190 10 IF (localpet.eq.0) WRITE (out,50) line
1191 exit_flag=4
1192 RETURN
1193 20 CLOSE (inp)
1194!
1195 30 FORMAT (/,' get_atm_Ngrids - Unable to open ROMS input ', &
1196 & 'script file.',/,18x,a,/,18x,'ERROR: ',a)
1197 40 FORMAT (/,' get_atm_Ngrids - Invalid input parameter, ',a,i4,/, &
1198 & 18x,a)
1199 50 FORMAT (/,' get_atm_Ngrids - Error while processing line: ',/,a)
1200
1201#else
1202!
1203!-----------------------------------------------------------------------
1204! Set atmosphere model nested grid parameter to unity.
1205!-----------------------------------------------------------------------
1206!
1207 myvalue=1
1208#endif
1209!
1210 RETURN
1211 END FUNCTION get_atm_ngrids
1212!
1213 INTEGER FUNCTION get_roms_ngrids (Sname,localPET) RESULT (MyValue)
1214!
1215!=======================================================================
1216! !
1217! This function reads number of nested grids (Ngrids) from ROMS input !
1218! script. !
1219! !
1220!=======================================================================
1221!
1222 USE mod_param, ONLY : ngrids
1223 USE mod_scalars, ONLY : noerror, exit_flag, time_ref
1224!
1225 USE inp_decode_mod
1226!
1227 USE dateclock_mod, ONLY : ref_clock
1228 USE strings_mod, ONLY : founderror
1229!
1230! Imported variable declarations.
1231!
1232 integer, intent(in) :: localpet
1233!
1234 character (len=*), intent(in) :: sname
1235!
1236! Local variable declarations.
1237!
1238 integer :: npts, nval, inp, io_err, out, status
1239 integer :: ivalue(1)
1240!
1241 real(r8) :: rvalue(1)
1242
1243 real(dp), dimension(nRval) :: rval
1244!
1245 character (len= 40) :: keyword
1246 character (len=256) :: io_errmsg, line
1247 character (len=256), dimension(nCval) :: cval
1248
1249 character (len=*), parameter :: myfile = &
1250 & __FILE__//", get_roms_Ngrids"
1251!
1252!-----------------------------------------------------------------------
1253! Read ROMS application standard input file to determine the value
1254! of Ngrids. Also, read time reference to check for compactability
1255! with specified coupling value.
1256!-----------------------------------------------------------------------
1257!
1258 inp=2
1259 out=cplout
1260!
1261 OPEN (inp, file=trim(sname), form='formatted', status='old', &
1262 & iostat=io_err, iomsg=io_errmsg)
1263 IF (io_err.ne.0) THEN
1264 IF (localpet.eq.0) WRITE (out,30) trim(sname), trim(io_errmsg)
1265 exit_flag=5
1266 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1267 END IF
1268!
1269 DO WHILE (.true.)
1270 READ (inp,'(a)',err=10,END=20) line
1271 status=decode_line(line, keyword, nval, cval, rval)
1272 IF (status.gt.0) THEN
1273 SELECT CASE (trim(keyword))
1274 CASE ('Ngrids')
1275 npts=load_i(nval, rval, 1, ivalue)
1276 myvalue=ivalue(1)
1277 IF (myvalue.le.0) THEN
1278 IF (localpet.eq.0) WRITE (out,40) 'Ngrids', myvalue, &
1279 & 'must be greater than zero.'
1280 exit_flag=5
1281 IF (founderror(exit_flag, noerror, &
1282 & __line__, myfile)) RETURN
1283 END IF
1284 ngrids=myvalue
1285 CASE ('TIME_REF')
1286 npts=load_r(nval, rval, 1, rvalue)
1287 time_ref=rvalue(1)
1288 CALL ref_clock (time_ref)
1289 END SELECT
1290 END IF
1291 END DO
1292 10 IF (localpet.eq.0) WRITE (out,50) line
1293 exit_flag=4
1294 RETURN
1295 20 CLOSE (inp)
1296!
1297 30 FORMAT (/,' get_roms_Ngrids - Unable to open ROMS input ', &
1298 & 'script file.',/,19x,a,/,19x,a)
1299 40 FORMAT (/,' get_roms_Ngrids - Invalid input parameter, ',a,i4,/, &
1300 & 14x,a)
1301 50 FORMAT (/,' get_roms_Ngrids - Error while processing line: ',/,a)
1302!
1303 RETURN
1304 END FUNCTION get_roms_ngrids
1305!
1306 SUBROUTINE load_ifs (S, Ifiles, Ngrids, Nfiles, Icomp)
1307!
1308!=======================================================================
1309! !
1310! This routine loads the DATA Model source files into Input File !
1311! Structure (IFS). !
1312! !
1313! On Input: !
1314! !
1315! S Input DATA Model source files as read from coupling !
1316! script (TYPE T_IO) !
1317! Ifiles First dimension of S-structure (integer) !
1318! Ngrids Number of nested grids in ESM component (integer) !
1319! Nfiles Number of files per nested grid (integer vector) !
1320! Icomp ESM component index per neste grid (integer) !
1321! !
1322! On Output: !
1323! !
1324! DataSet Updata DATA Model high-level structure in module !
1325! !
1326!=======================================================================
1327!
1328! Imported variable declarations.
1329!
1330 integer, intent(in) :: ifiles, ngrids
1331 integer, intent(in) :: icomp, nfiles(ngrids)
1332!
1333 TYPE (t_io), intent(in) :: s(ifiles,ngrids)
1334!
1335! Local variable declarations.
1336!
1337 integer :: ic, if, j, ng, mf
1338!
1339!-----------------------------------------------------------------------
1340! Load DATA Model source files into IFS.
1341!-----------------------------------------------------------------------
1342!
1343 ic=icomp ! ESM component index
1344 DO ng=1,ngrids
1345 IF (models(icomp)%IsActive) THEN
1346 DO if=1,nfiles(ng)
1347 mf=s(if,ng)%Nfiles ! number of multi-files
1348!
1349! Allocate various variables dimensioned by the number of multi-files.
1350!
1351 allocate ( dataset(ic)%IFS(if)%Nrec(mf) )
1352 allocate ( dataset(ic)%IFS(if)%time_min(mf) )
1353 allocate ( dataset(ic)%IFS(if)%time_max(mf) )
1354 allocate ( dataset(ic)%IFS(if)%Vid(mf) )
1355 allocate ( dataset(ic)%IFS(if)%Tid(mf) )
1356 allocate ( dataset(ic)%IFS(if)%files(mf) )
1357!
1358! Initialize and load fields into structure.
1359!
1360 dataset(ic)%IFS(if)%Nfiles=mf ! number of multi-files
1361 dataset(ic)%IFS(if)%Fcount=1 ! multi-file counter
1362 dataset(ic)%IFS(if)%Rindex=0 ! time index
1363 dataset(ic)%IFS(if)%ncid=-1 ! closed NetCDF state
1364 dataset(ic)%IFS(if)%Vid=-1 ! NetCDF variable ID
1365 dataset(ic)%IFS(if)%Tid=-1 ! NetCDF time ID
1366 dataset(ic)%IFS(if)%Nrec=0 ! number of time records
1367 dataset(ic)%IFS(if)%time_min=0.0_r8 ! starting time
1368 dataset(ic)%IFS(if)%time_max=0.0_r8 ! ending time
1369!
1370! Enter multi-filenames.
1371!
1372 DO j=1,mf
1373 dataset(ic)%IFS(if)%files(j)=trim(s(if,ng)%files(j))
1374 END DO
1375 dataset(ic)%IFS(if)%label=trim(s(if,ng)%label)
1376 dataset(ic)%IFS(if)%name=trim(s(if,ng)%name)
1377 dataset(ic)%IFS(if)%base=trim(s(if,ng)%base)
1378 END DO
1379 END IF
1380 END DO
1381!
1382 RETURN
1383 END SUBROUTINE load_ifs
1384!
1385 SUBROUTINE read_esmconfig (vm, rc)
1386!
1387!=======================================================================
1388! !
1389! This routine reads in the Earth System Models (ESM) coupling !
1390! configuration parameters from standard input file. !
1391! !
1392!=======================================================================
1393!
1394 USE mod_parallel, ONLY : ocn_comm_world, myrank
1395 USE mod_parallel, ONLY : allocate_parallel, initialize_parallel
1396 USE mod_iounits, ONLY : iname, sourcefile, stdout
1397 USE mod_scalars, ONLY : noerror, rclock, exit_flag
1398 USE mod_strings, ONLY : my_cpu, my_fc, my_fflags, my_fort, &
1399 & my_os, rdir
1400!
1401 USE inp_decode_mod
1402!
1403 USE dateclock_mod, ONLY : datenum
1404 USE dateclock_mod, ONLY : get_date
1405 USE dateclock_mod, ONLY : time_string
1406# ifdef DISTRIBUTE
1407 USE distribute_mod, ONLY : mp_bcasts
1408# endif
1409 USE stdout_mod, ONLY : set_stdoutunit, stdout_unit
1410 USE strings_mod, ONLY : lowercase
1411!
1412 implicit none
1413!
1414! Imported variable declarations.
1415!
1416 integer, intent(out) :: rc
1417!
1418 TYPE (esmf_vm) :: vm
1419!
1420! Local variable declarations.
1421!
1422 logical :: doit, first
1423 logical :: lwrite, masterpet
1424 logical :: lvalue(1)
1425 logical, allocatable :: lvaluea(:), lvaluei(:)
1426 logical, allocatable :: lvaluer(:), lvaluew(:)
1427!
1428 integer :: icomp, jcomp, myerror, mysize, nfields, npts, nval
1429 integer :: esmcount, igrids, jgrids, ncplsets, ngrd, nstates
1430 integer :: explstr, implstr, setlstr, lstr
1431 integer :: i, ic, ie, ig, is, j, jg, k, inp, ng, out, status
1432 integer :: ifile, igrid, io_err
1433 integer :: maxd2a_files, maxd2i_files, maxd2r_files, maxd2w_files
1434 integer :: localpet, petcount, mycomm, npets
1435 integer :: cdim, rdim, timefrac
1436 integer :: ivalue(1), nd2a(1), nd2i(1), nd2r(1), nd2w(1)
1437 integer :: newdate(7)
1438 integer :: esmorder(nmodels)
1439 integer :: location(1)
1440
1441 integer, allocatable :: ivaluea(:)
1442 integer, allocatable :: ivaluei(:)
1443 integer, allocatable :: ivaluer(:)
1444 integer, allocatable :: ivaluew(:)
1445
1446 integer, allocatable :: ncount(:,:)
1447!
1448 real(r8) :: rvalue(1)
1449
1450 real(dp), dimension(nRval) :: rval
1451!
1452 character (len= 1), parameter :: blank = ' '
1453 character (len= 5) :: pstr, pend
1454 character (len= 20) :: datecalendar
1455 character (len= 20) :: timereferencestring
1456 character (len= 20) :: timerestartstring
1457 character (len= 20) :: timestartstring
1458 character (len= 20) :: timestopstring
1459 character (len= 40) :: frmt
1460 character (len= 40) :: keyword
1461 character (len= 50) :: mylabel, label
1462 character (len= 80) :: string
1463 character (len=256) :: fname, io_errmsg, line
1464 character (len=256) :: atmname, icename, ocnname, wavname
1465 character (len=256), dimension(nCval) :: cval
1466
1467 character (len=*), parameter :: myfile = &
1468 & __FILE__//", read_ESMconfig"
1469!
1470 character (len= 6), allocatable :: setlabel(:)
1471 character (len= 13), allocatable :: explabel(:), implabel(:)
1472 character (len= 22), dimension(2) :: fcode
1473!
1474 TYPE (esmf_calkind_flag) :: caltype
1475 TYPE (esmf_time) :: mystarttime, myrestarttime
1476!
1477 TYPE(t_io), allocatable :: d2r(:,:) ! DATA -> ROMS source files
1478 TYPE(t_io), allocatable :: d2a(:,:) ! DATA -> ATM source files
1479 TYPE(t_io), allocatable :: d2i(:,:) ! DATA -> ICE source files
1480 TYPE(t_io), allocatable :: d2w(:,:) ! DATA -> WAV source files
1481!
1482 sourcefile=myfile
1483!
1484!-----------------------------------------------------------------------
1485! Initialize return code flag to success state (no error).
1486!-----------------------------------------------------------------------
1487!
1488 rc=esmf_success
1489!
1490!-----------------------------------------------------------------------
1491! Query gridded component.
1492!-----------------------------------------------------------------------
1493!
1494 CALL esmf_vmget (vm, &
1495 & localpet=localpet, &
1496 & petcount=petcount, &
1497 & mpicommunicator=mycomm, &
1498 & rc=rc)
1499 IF (esmf_logfounderror(rctocheck=rc, &
1500 & msg=esmf_logerr_passthru, &
1501 & line=__line__, &
1502 & file=myfile)) THEN
1503 RETURN
1504 END IF
1505 masterpet=localpet.eq.0
1506!
1507! Assign driver communicatior handle to ROMS temporarily. It is needed
1508! since here are using ROMS generic NetCDF and distributed-memory
1509! interface.
1510!
1511 ocn_comm_world=mycomm
1512!
1513! Set the rank for each driver PET. In sequential and concurrent setup,
1514! each couputational node has it unique PET associated with the driver.
1515!
1516 petrank=localpet
1517!
1518! Set the ROMS standard output unit to write verbose execution info.
1519! Notice that the default standard out unit in Fortran is 6.
1520!
1521! In some applications like coupling or disjointed mpi-communications,
1522! it is advantageous to write standard output to a specific filename
1523! instead of the default Fortran standard output unit 6. If that is
1524! the case, it opens such formatted file for writing.
1525!
1526 IF (set_stdoutunit) THEN
1527 stdout=stdout_unit(masterpet)
1528 set_stdoutunit=.false.
1529 END IF
1530!
1531! Open standard output unit for ESM coupler information and messages.
1532! It is advisable to have such infomation separated from other standard
1533! output from the coupled models.
1534!
1535! IF (MasterPET) THEN
1536 OPEN (cplout, file=trim(couplerlog), form='formatted', &
1537 & status='replace')
1538! END IF
1539!
1540!-----------------------------------------------------------------------
1541! Determine coupling standard input filename. In distributed-memory,
1542! this name is assigned at the executtion command line and processed
1543! with the Unix routine GETARG. The ROMS input parameter script name
1544! is specified in this coupling script.
1545!-----------------------------------------------------------------------
1546!
1547 lwrite=masterpet
1548 inp=100
1549 out=cplout
1550!
1551 IF (localpet.eq.0) THEN
1552 CALL my_getarg (1, cinpname)
1553 CALL get_date (todaydatestring)
1554 END IF
1555 CALL mp_bcasts (1, 1, cinpname)
1556 CALL mp_bcasts (1, 1, todaydatestring)
1557 OPEN (inp, file=trim(cinpname), form='formatted', status='old', &
1558 & iostat=io_err, iomsg=io_errmsg)
1559 IF (io_err.ne.0) THEN
1560 IF (localpet.eq.0) WRITE (out,10) trim(io_errmsg)
1561 exit_flag=5
1562 rc=esmf_rc_file_open
1563 RETURN
1564 10 FORMAT (/,' read_ESMconfig - Unable to open coupling input', &
1565 & ' script.',/,19x,'ERROR: ',a,/, &
1566 & /,19x,'In distributed-memory applications, the input', &
1567 & /,19x,'script file is processed in parallel. The Unix', &
1568 & /,19x,'routine GETARG is used to get script filename.', &
1569 & /,19x,'For example, in MPI applications make sure that',&
1570 & /,19x,'command line is something like:',/, &
1571 & /,19x,'mpirun -np 4 romsM coupling_esmf.in',/, &
1572 & /,19x,'and not',/, &
1573 & /,19x,'mpirun -np 4 romsM < coupling_esmf.in',/)
1574 END IF
1575!
1576!-----------------------------------------------------------------------
1577! Read in multiple models coupling parameters. Then, load input
1578! data into module. Take into account nested grid configurations.
1579!-----------------------------------------------------------------------
1580!
1581! Initialize.
1582!
1583 ifile=1 ! multiple file counter
1584 igrid=1 ! nested grid counter
1585 DO i=1,len(label)
1586 label(i:i)=blank
1587 END DO
1588 cdim=SIZE(cval,1)
1589 rdim=SIZE(rval,1)
1590!
1591! Read in coupling parameters.
1592!
1593 DO WHILE (.true.)
1594 READ (inp,'(a)',err=20,END=30) line
1595 status=decode_line(line, keyword, nval, cval, rval)
1596 IF (status.gt.0) THEN
1597 SELECT CASE (trim(keyword))
1598 CASE ('CPLname')
1599 cplname=trim(adjustl(cval(nval)))
1600 CASE ('CONFname')
1601 confname=trim(adjustl(cval(nval)))
1602 CASE ('INPname(roms)')
1603 ocnname=trim(adjustl(cval(nval)))
1604 ngridsr=get_roms_ngrids(ocnname,localpet)
1605 IF (exit_flag.ne.noerror) THEN
1606 rc=esmf_rc_file_read
1607 RETURN
1608 END IF
1609 IF (.not.allocated(lvaluer)) THEN
1610 allocate ( lvaluer(ngridsr) )
1611 lvaluer(1:ngridsr)=.false.
1612 END IF
1613 IF (.not.allocated(ivaluer)) THEN
1614 allocate ( ivaluer(ngridsr) )
1615 ivaluer(1:ngridsr)=0
1616 END IF
1617 CASE ('INPname(atmos)')
1618 atmname=trim(adjustl(cval(nval)))
1619 ngridsa=get_atm_ngrids(atmname,localpet)
1620 IF (exit_flag.ne.noerror) THEN
1621 rc=esmf_rc_file_read
1622 RETURN
1623 END IF
1624 IF (.not.allocated(lvaluea)) THEN
1625 allocate ( lvaluea(ngridsa) )
1626 lvaluea(1:ngridsa)=.false.
1627 END IF
1628 IF (.not.allocated(ivaluea)) THEN
1629 allocate ( ivaluea(ngridsa) )
1630 ivaluea(1:ngridsa)=0
1631 END IF
1632 CASE ('INPname(seaice)')
1633 icename=trim(adjustl(cval(nval)))
1634 IF (.not.allocated(lvaluei)) THEN
1635 allocate ( lvaluei(ngridsi) )
1636 lvaluei(1:ngridsi)=.false.
1637 END IF
1638 IF (.not.allocated(ivaluei)) THEN
1639 allocate ( ivaluei(ngridsi) )
1640 ivaluei(1:ngridsi)=0
1641 END IF
1642 CASE ('INPname(waves)')
1643 wavname=trim(adjustl(cval(nval)))
1644 IF (.not.allocated(lvaluew)) THEN
1645 allocate ( lvaluew(ngridsw) )
1646 lvaluew(1:ngridsw)=.false.
1647 END IF
1648 IF (.not.allocated(ivaluew)) THEN
1649 allocate ( ivaluew(ngridsw) )
1650 ivaluew(1:ngridsw)=0
1651 END IF
1652 CASE ('IsActive(roms)')
1653 npts=load_l(nval, cval, 1, lvalue)
1654 CALL allocate_esmf_esm
1655 esmcomm(idriver)=mycomm
1656 iname=trim(adjustl(ocnname)) ! needed by ROMS
1657 inpname(iroms)=trim(adjustl(ocnname))
1658 models(iroms)%IsActive=lvalue(1)
1659 IF (models(iroms)%IsActive) THEN
1660 models(iroms)%Ngrids=ngridsr
1661 IF (.not.allocated(models(iroms)%ExportState)) THEN
1662 allocate ( models(iroms)%ExportState(ngridsr) )
1663 END IF
1664 IF (.not.allocated(models(iroms)%ImportState)) THEN
1665 allocate ( models(iroms)%ImportState(ngridsr) )
1666 END IF
1667 IF (.not.allocated(coupled(iroms)%LinkedGrid)) THEN
1668 allocate ( coupled(iroms)%LinkedGrid(ngridsr, &
1669 & nmodels) )
1670 coupled(iroms)%LinkedGrid=.false.
1671 END IF
1672 IF (.not.allocated(models(iroms)%TimeFrac)) THEN
1673 allocate ( models(iroms)%TimeFrac(ngridsr,nmodels) )
1674 models(iroms)%TimeFrac=1
1675 END IF
1676 END IF
1677!
1678! In some setups, the information below is needed before
1679! ROMS initialization (if active or not) because of calls
1680! from other components to the distribute and netcdf
1681! modules.
1682!
1683 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
1684 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
1685 CALL allocate_parallel (ngridsr)
1686 CALL initialize_parallel
1687 CASE ('IsActive(atmos)')
1688 npts=load_l(nval, cval, 1, lvalue)
1689 inpname(iatmos)=trim(adjustl(atmname))
1690 models(iatmos)%IsActive=lvalue(1)
1691 IF (models(iatmos)%IsActive) THEN
1692 models(iatmos)%Ngrids=ngridsa
1693 IF (.not.allocated(models(iatmos)%ExportState)) THEN
1694 allocate ( models(iatmos)%ExportState(ngridsa) )
1695 END IF
1696 IF (.not.allocated(models(iatmos)%ImportState)) THEN
1697 allocate ( models(iatmos)%ImportState(ngridsa) )
1698 END IF
1699 IF (.not.allocated(coupled(iatmos)%LinkedGrid)) THEN
1700 allocate ( coupled(iatmos)%LinkedGrid(ngridsa, &
1701 & nmodels) )
1702 coupled(iatmos)%LinkedGrid=.false.
1703 END IF
1704 IF (.not.allocated(models(iatmos)%TimeFrac)) THEN
1705 allocate ( models(iatmos)%TimeFrac(ngridsa,nmodels) )
1706 models(iatmos)%TimeFrac=1
1707 END IF
1708 END IF
1709 CASE ('IsActive(seaice)')
1710 npts=load_l(nval, cval, 1, lvalue)
1711 inpname(iseaice)=trim(adjustl(icename))
1712 models(iseaice)%IsActive=lvalue(1)
1713 IF (models(iseaice)%IsActive) THEN
1714 models(iseaice)%Ngrids=ngridsi
1715 IF (.not.allocated(models(iseaice)%ExportState)) THEN
1716 allocate ( models(iseaice)%ExportState(ngridsi) )
1717 END IF
1718 IF (.not.allocated(models(iseaice)%ImportState)) THEN
1719 allocate ( models(iseaice)%ImportState(ngridsi) )
1720 END IF
1721 IF (.not.allocated(coupled(iseaice)%LinkedGrid)) THEN
1722 allocate( coupled(iseaice)%LinkedGrid(ngridsi, &
1723 & nmodels) )
1724 coupled(iseaice)%LinkedGrid=.false.
1725 END IF
1726 IF (.not.allocated(models(iseaice)%TimeFrac)) THEN
1727 allocate ( models(iseaice)%TimeFrac(ngridsi,nmodels) )
1728 models(iseaice)%TimeFrac=1
1729 END IF
1730 END IF
1731 CASE ('IsActive(waves)')
1732 npts=load_l(nval, cval, 1, lvalue)
1733 inpname(iwave)=trim(adjustl(wavname))
1734 models(iwave)%IsActive=lvalue(1)
1735 IF (models(iwave)%IsActive) THEN
1736 models(iwave)%Ngrids=ngridsw
1737 IF (.not.allocated(models(iwave)%ExportState)) THEN
1738 allocate ( models(iwave)%ExportState(ngridsw) )
1739 END IF
1740 IF (.not.allocated(models(iwave)%ImportState)) THEN
1741 allocate ( models(iwave)%ImportState(ngridsw) )
1742 END IF
1743 IF (.not.allocated(coupled(iwave)%LinkedGrid)) THEN
1744 allocate ( coupled(iwave)%LinkedGrid(ngridsw, &
1745 & nmodels) )
1746 coupled(iwave)%LinkedGrid=.false.
1747 END IF
1748 IF (.not.allocated(models(iwave)%TimeFrac)) THEN
1749 allocate ( models(iwave)%TimeFrac(ngridsw,nmodels) )
1750 models(iwave)%TimeFrac=1
1751 END IF
1752 END IF
1753 CASE ('IsActive(data)')
1754# ifdef DATA_COUPLING
1755 npts=load_l(nval, cval, 1, lvalue)
1756 models(idata)%IsActive=lvalue(1)
1757 IF (models(idata)%IsActive) THEN
1758 models(idata)%Ngrids=ngridsd
1759 IF (.not.allocated(models(idata)%TimeFrac)) THEN
1760 allocate ( models(idata)%TimeFrac(ngridsd,nmodels) )
1761 models(idata)%TimeFrac=1
1762 END IF
1763 END IF
1764# endif
1765 CASE ('Coupled(ATM2OCN)') ! ESM to OCN
1766 npts=load_l(nval, cval, ngridsr, lvaluer)
1767 IF (models(iatmos)%IsActive.and. &
1768 & models(iroms )%IsActive) THEN
1769 DO ng=1,ngridsr
1770 coupled(iroms)%LinkedGrid(ng,iatmos)=lvaluer(ng)
1771 END DO
1772 IF (any(lvaluer)) THEN
1773 connectors(iatmos,iroms)%IsActive=.true.
1774 END IF
1775 END IF
1776 CASE ('Coupled(ICE2OCN)')
1777 npts=load_l(nval, cval, ngridsr, lvaluer)
1778 IF (models(iseaice)%IsActive.and. &
1779 & models(iroms )%IsActive) THEN
1780 DO ng=1,ngridsr
1781 coupled(iroms)%LinkedGrid(ng,iseaice)=lvaluer(ng)
1782 END DO
1783 IF (any(lvaluer)) THEN
1784 connectors(iseaice,iroms)%IsActive=.true.
1785 END IF
1786 END IF
1787 CASE ('Coupled(WAV2OCN)')
1788 npts=load_l(nval, cval, ngridsr, lvaluer)
1789 IF (models(iwave)%IsActive.and. &
1790 & models(iroms)%IsActive) THEN
1791 DO ng=1,ngridsr
1792 coupled(iroms)%LinkedGrid(ng,iwave)=lvaluer(ng)
1793 END DO
1794 IF (any(lvaluer)) THEN
1795 connectors(iwave,iroms)%IsActive=.true.
1796 END IF
1797 END IF
1798 CASE ('Coupled(DAT2OCN)')
1799 npts=load_l(nval, cval, ngridsr, lvaluer)
1800 IF (models(idata)%IsActive.and. &
1801 & models(iroms)%IsActive) THEN
1802 DO ng=1,ngridsr
1803 coupled(iroms)%LinkedGrid(ng,idata)=lvaluer(ng)
1804 END DO
1805 IF (any(lvaluer)) THEN
1806 connectors(idata,iroms)%IsActive=.true.
1807 END IF
1808 END IF
1809 CASE ('Coupled(OCN2ATM)') ! ESM to ATM
1810 npts=load_l(nval, cval, ngridsa, lvaluea)
1811 IF (models(iroms )%IsActive.and. &
1812 & models(iatmos)%IsActive) THEN
1813 DO ng=1,ngridsa
1814 coupled(iatmos)%LinkedGrid(ng,iroms)=lvaluea(ng)
1815 END DO
1816 IF (any(lvaluea)) THEN
1817 connectors(iroms,iatmos)%IsActive=.true.
1818 END IF
1819 END IF
1820 CASE ('Coupled(ICE2ATM)')
1821 npts=load_l(nval, cval, ngridsa, lvaluea)
1822 IF (models(iseaice)%IsActive.and. &
1823 & models(iatmos )%IsActive) THEN
1824 DO ng=1,ngridsa
1825 coupled(iatmos)%LinkedGrid(ng,iseaice)=lvaluea(ng)
1826 END DO
1827 IF (any(lvaluea)) THEN
1828 connectors(iseaice,iatmos)%IsActive=.true.
1829 END IF
1830 END IF
1831 CASE ('Coupled(WAV2ATM)')
1832 npts=load_l(nval, cval, ngridsa, lvaluea)
1833 IF (models(iwave )%IsActive.and. &
1834 & models(iatmos)%IsActive) THEN
1835 DO ng=1,ngridsa
1836 coupled(iatmos)%LinkedGrid(ng,iwave)=lvaluea(ng)
1837 END DO
1838 IF (any(lvaluea)) THEN
1839 connectors(iwave,iatmos)%IsActive=.true.
1840 END IF
1841 END IF
1842 CASE ('Coupled(DAT2ATM)')
1843 npts=load_l(nval, cval, ngridsa, lvaluea)
1844 IF (models(idata )%IsActive.and. &
1845 & models(iatmos)%IsActive) THEN
1846 DO ng=1,ngridsa
1847 coupled(iatmos)%LinkedGrid(ng,idata)=lvaluea(ng)
1848 END DO
1849 IF (any(lvaluea)) THEN
1850 connectors(idata,iatmos)%IsActive=.true.
1851 END IF
1852 END IF
1853 CASE ('Coupled(ATM2ICE)') ! ESM to ICE
1854 npts=load_l(nval, cval, ngridsi, lvaluei)
1855 IF (models(iatmos )%IsActive.and. &
1856 & models(iseaice)%IsActive) THEN
1857 DO ng=1,ngridsi
1858 coupled(iseaice)%LinkedGrid(ng,iatmos)=lvaluei(ng)
1859 END DO
1860 IF (any(lvaluei)) THEN
1861 connectors(iatmos,iseaice)%IsActive=.true.
1862 END IF
1863 END IF
1864 CASE ('Coupled(OCN2ICE)')
1865 npts=load_l(nval, cval, ngridsi, lvaluei)
1866 IF (models(iroms )%IsActive.and. &
1867 & models(iseaice)%IsActive) THEN
1868 DO ng=1,ngridsi
1869 coupled(iseaice)%LinkedGrid(ng,iroms)=lvaluei(ng)
1870 END DO
1871 IF (any(lvaluei)) THEN
1872 connectors(iroms,iseaice)%IsActive=.true.
1873 END IF
1874 END IF
1875 CASE ('Coupled(WAV2ICE)')
1876 npts=load_l(nval, cval, ngridsi, lvaluei)
1877 IF (models(iwave )%IsActive.and. &
1878 & models(iseaice)%IsActive) THEN
1879 DO ng=1,ngridsi
1880 coupled(iseaice)%LinkedGrid(ng,iwave)=lvaluei(ng)
1881 END DO
1882 IF (any(lvaluei)) THEN
1883 connectors(iwave,iseaice)%IsActive=.true.
1884 END IF
1885 END IF
1886 CASE ('Coupled(DAT2ICE)')
1887 npts=load_l(nval, cval, ngridsi, lvaluei)
1888 IF (models(idata )%IsActive.and. &
1889 & models(iseaice)%IsActive) THEN
1890 DO ng=1,ngridsi
1891 coupled(iseaice)%LinkedGrid(ng,idata)=lvaluei(ng)
1892 END DO
1893 IF (any(lvaluei)) THEN
1894 connectors(idata,iseaice)%IsActive=.true.
1895 END IF
1896 END IF
1897 CASE ('Coupled(ATM2WAV)') ! ESM to WAV
1898 npts=load_l(nval, cval, ngridsw, lvaluew)
1899 IF (models(iatmos)%IsActive.and. &
1900 & models(iwave )%IsActive) THEN
1901 DO ng=1,ngridsw
1902 coupled(iwave)%LinkedGrid(ng,iatmos)=lvaluew(ng)
1903 END DO
1904 IF (any(lvaluew)) THEN
1905 connectors(iatmos,iwave)%IsActive=.true.
1906 END IF
1907 END IF
1908 CASE ('Coupled(ICE2WAV)')
1909 npts=load_l(nval, cval, ngridsw, lvaluew)
1910 IF (models(iseaice)%IsActive.and. &
1911 & models(iwave )%IsActive) THEN
1912 DO ng=1,ngridsw
1913 coupled(iwave)%LinkedGrid(ng,iseaice)=lvaluew(ng)
1914 END DO
1915 IF (any(lvaluew)) THEN
1916 connectors(iseaice,iwave)%IsActive=.true.
1917 END IF
1918 END IF
1919 CASE ('Coupled(OCN2WAV)')
1920 npts=load_l(nval, cval, ngridsw, lvaluew)
1921 IF (models(iroms)%IsActive.and. &
1922 & models(iwave)%IsActive) THEN
1923 DO ng=1,ngridsw
1924 coupled(iwave)%LinkedGrid(ng,iroms)=lvaluew(ng)
1925 END DO
1926 IF (any(lvaluew)) THEN
1927 connectors(iroms,iwave)%IsActive=.true.
1928 END IF
1929 END IF
1930 CASE ('Coupled(DAT2WAV)')
1931 npts=load_l(nval, cval, ngridsw, lvaluew)
1932 IF (models(idata)%IsActive.and. &
1933 & models(iwave)%IsActive) THEN
1934 DO ng=1,ngridsw
1935 coupled(iwave)%LinkedGrid(ng,idata)=lvaluew(ng)
1936 END DO
1937 IF (any(lvaluew)) THEN
1938 connectors(idata,iwave)%IsActive=.true.
1939 END IF
1940 END IF
1941 CASE ('CouplingType')
1942 npts=load_i(nval, rval, 1, ivalue)
1943 couplingtype=ivalue(1)
1944 CASE ('PETlayoutOption')
1945 npts=load_i(nval, rval, 1, ivalue)
1946 IF (ivalue(1).eq.0) THEN
1947 petlayoutoption='SEQUENTIAL'
1948 ELSE IF (ivalue(1).eq.1) THEN
1949 petlayoutoption='CONCURRENT'
1950 END IF
1951 CASE ('ItileD')
1952 npts=load_i(nval, rval, 1, ivalue)
1953 itiled=ivalue(1)
1954 CASE ('JtileD')
1955 npts=load_i(nval, rval, 1, ivalue)
1956 jtiled=ivalue(1)
1957 IF (models(idata)%IsActive) THEN
1958 models(idata)%nPETs=itiled*jtiled
1959 IF (.not.allocated(models(idata)%PETlist)) THEN
1960 allocate ( models(idata)%PETlist(itiled*jtiled) )
1961 END IF
1962 models(idata)%PETlist=0
1963 ELSE
1964 models(idata)%nPETs=0
1965 END IF
1966 CASE ('Nthreads(roms)')
1967 npts=load_i(nval, rval, 1, ivalue)
1968 IF (models(iroms)%IsActive) THEN
1969 models(iroms)%nPETs=ivalue(1)
1970 IF (.not.allocated(models(iroms)%PETlist)) THEN
1971 allocate ( models(iroms)%PETlist(ivalue(1)) )
1972 END IF
1973 models(iroms)%PETlist=0
1974 ELSE
1975 models(iroms)%nPETs=0
1976 END IF
1977 CASE ('Nthreads(atmos)')
1978 npts=load_i(nval, rval, 1, ivalue)
1979 IF (models(iatmos)%IsActive) THEN
1980 models(iatmos)%nPETs=ivalue(1)
1981 IF (.not.allocated(models(iatmos)%PETlist)) THEN
1982 allocate ( models(iatmos)%PETlist(ivalue(1)) )
1983 END IF
1984 models(iatmos)%PETlist=0
1985 ELSE
1986 models(iatmos)%nPETs=0
1987 END IF
1988 CASE ('Nthreads(seaice)')
1989 npts=load_i(nval, rval, 1, ivalue)
1990 IF (models(iseaice)%IsActive) THEN
1991 models(iseaice)%nPETs=ivalue(1)
1992 IF (.not.allocated(models(iseaice)%PETlist)) THEN
1993 allocate ( models(iseaice)%PETlist(ivalue(1)) )
1994 END IF
1995 models(iseaice)%PETlist=0
1996 ELSE
1997 models(iseaice)%nPETs=0
1998 END IF
1999 CASE ('Nthreads(waves)')
2000 npts=load_i(nval, rval, 1, ivalue)
2001 IF (models(iwave)%IsActive) THEN
2002 models(iwave)%nPETs=ivalue(1)
2003 IF (.not.allocated(models(iwave)%PETlist)) THEN
2004 allocate ( models(iwave)%PETlist(ivalue(1)) )
2005 END IF
2006 models(iwave)%PETlist=0
2007 ELSE
2008 models(iwave)%nPETs=0
2009 END IF
2010 CASE ('ReferenceTime')
2011 npts=load_i(nval, rval, 6, referencedate)
2012 CASE ('StartTime')
2013 npts=load_i(nval, rval, 6, startdate)
2014 CASE ('RestartTime')
2015 npts=load_i(nval, rval, 6, restartdate)
2016 CASE ('StopTime')
2017 npts=load_i(nval, rval, 6, stopdate)
2018 CASE ('TimeStep')
2019 npts=load_i(nval, rval, 6, timestep)
2020 CASE ('Calendar')
2021 datecalendar=trim(adjustl(cval(nval)))
2022 DO i=0,nmodels
2023 clockinfo(i)%CalendarString=trim(datecalendar)
2024 END DO
2025 CASE ('TimeFrac(ATM2OCN)') ! ESM to OCN
2026 npts=load_i(nval, rval, ngridsr, ivaluer)
2027 IF (models(iatmos)%IsActive.and. &
2028 & models(iroms )%IsActive) THEN
2029 DO ng=1,ngridsr
2030 models(iroms)%TimeFrac(ng,iatmos)=ivaluer(ng)
2031 END DO
2032 END IF
2033 CASE ('TimeFrac(ICE2OCN)')
2034 npts=load_i(nval, rval, ngridsr, ivaluer)
2035 IF (models(iseaice)%IsActive.and. &
2036 & models(iroms )%IsActive) THEN
2037 DO ng=1,ngridsr
2038 models(iroms)%TimeFrac(ng,iseaice)=ivaluer(ng)
2039 END DO
2040 END IF
2041 CASE ('TimeFrac(WAV2OCN)')
2042 npts=load_i(nval, rval, ngridsr, ivaluer)
2043 IF (models(iwave)%IsActive.and. &
2044 & models(iroms)%IsActive) THEN
2045 DO ng=1,ngridsr
2046 models(iroms)%TimeFrac(ng,iwave)=ivaluer(ng)
2047 END DO
2048 END IF
2049 CASE ('TimeFrac(DAT2OCN)')
2050 npts=load_i(nval, rval, ngridsr, ivaluer)
2051 IF (models(idata)%IsActive.and. &
2052 & models(iroms)%IsActive) THEN
2053 DO ng=1,ngridsr
2054 models(iroms)%TimeFrac(ng,idata)=ivaluer(ng)
2055 END DO
2056 END IF
2057 CASE ('TimeFrac(OCN2ATM)') ! ESM to ATM
2058 npts=load_i(nval, rval, ngridsa, ivaluea)
2059 IF (models(iroms )%IsActive.and. &
2060 & models(iatmos)%IsActive) THEN
2061 DO ng=1,ngridsa
2062 models(iatmos)%TimeFrac(ng,iroms)=ivaluea(ng)
2063 END DO
2064 END IF
2065 CASE ('TimeFrac(ICE2ATM)')
2066 npts=load_i(nval, rval, ngridsa, ivaluea)
2067 IF (models(iseaice)%IsActive.and. &
2068 & models(iatmos )%IsActive) THEN
2069 DO ng=1,ngridsa
2070 models(iatmos)%TimeFrac(ng,iseaice)=ivaluea(ng)
2071 END DO
2072 END IF
2073 CASE ('TimeFrac(WAV2ATM)')
2074 npts=load_i(nval, rval, ngridsa, ivaluea)
2075 IF (models(iwave )%IsActive.and. &
2076 & models(iatmos)%IsActive) THEN
2077 DO ng=1,ngridsa
2078 models(iatmos)%TimeFrac(ng,iwave)=ivaluea(ng)
2079 END DO
2080 END IF
2081 CASE ('TimeFrac(DAT2ATM)')
2082 npts=load_i(nval, rval, ngridsa, ivaluea)
2083 IF (models(idata )%IsActive.and. &
2084 & models(iatmos)%IsActive) THEN
2085 DO ng=1,ngridsa
2086 models(iatmos)%TimeFrac(ng,idata)=ivaluea(ng)
2087 END DO
2088 END IF
2089 CASE ('TimeFrac(ATM2ICE)') ! ESM to ICE
2090 npts=load_i(nval, rval, ngridsi, ivaluei)
2091 IF (models(iatmos )%IsActive.and. &
2092 & models(iseaice)%IsActive) THEN
2093 DO ng=1,ngridsi
2094 models(iseaice)%TimeFrac(ng,iatmos)=ivaluei(ng)
2095 END DO
2096 END IF
2097 CASE ('TimeFrac(OCN2ICE)')
2098 npts=load_i(nval, rval, ngridsi, ivaluei)
2099 IF (models(iroms )%IsActive.and. &
2100 & models(iseaice)%IsActive) THEN
2101 DO ng=1,ngridsi
2102 models(iseaice)%TimeFrac(ng,iroms)=ivaluei(ng)
2103 END DO
2104 END IF
2105 CASE ('TimeFrac(WAV2ICE)')
2106 npts=load_i(nval, rval, ngridsi, ivaluei)
2107 IF (models(iwave )%IsActive.and. &
2108 & models(iseaice)%IsActive) THEN
2109 DO ng=1,ngridsi
2110 models(iseaice)%TimeFrac(ng,iwave)=ivaluei(ng)
2111 END DO
2112 END IF
2113 CASE ('TimeFrac(DAT2ICE)')
2114 npts=load_i(nval, rval, ngridsi, ivaluei)
2115 IF (models(idata )%IsActive.and. &
2116 & models(iseaice)%IsActive) THEN
2117 DO ng=1,ngridsi
2118 models(iseaice)%TimeFrac(ng,idata)=ivaluei(ng)
2119 END DO
2120 END IF
2121 CASE ('TimeFrac(ATM2WAV)') ! ESM to WAV
2122 npts=load_i(nval, rval, ngridsw, ivaluew)
2123 IF (models(iatmos)%IsActive.and. &
2124 & models(iwave )%IsActive) THEN
2125 DO ng=1,ngridsw
2126 models(iwave)%TimeFrac(ng,iatmos)=ivaluew(ng)
2127 END DO
2128 END IF
2129 CASE ('TimeFrac(ICE2WAV)')
2130 npts=load_i(nval, rval, ngridsw, ivaluew)
2131 IF (models(iseaice)%IsActive.and. &
2132 & models(iwave )%IsActive) THEN
2133 DO ng=1,ngridsw
2134 models(iwave)%TimeFrac(ng,iseaice)=ivaluew(ng)
2135 END DO
2136 END IF
2137 CASE ('TimeFrac(OCN2WAV)')
2138 npts=load_i(nval, rval, ngridsw, ivaluew)
2139 IF (models(iroms)%IsActive.and. &
2140 & models(iwave)%IsActive) THEN
2141 DO ng=1,ngridsw
2142 models(iwave)%TimeFrac(ng,iroms)=ivaluew(ng)
2143 END DO
2144 END IF
2145 CASE ('TimeFrac(DAT2WAV)')
2146 npts=load_i(nval, rval, ngridsw, ivaluew)
2147 IF (models(idata)%IsActive.and. &
2148 & models(iwave)%IsActive) THEN
2149 DO ng=1,ngridsw
2150 models(iwave)%TimeFrac(ng,idata)=ivaluew(ng)
2151 END DO
2152 END IF
2153 CASE ('extrapNumLevels')
2154 npts=load_i(nval, rval, 1, ivalue)
2155 extrapnumlevels=ivalue(1)
2156# ifdef DATA_COUPLING
2157 CASE ('WeightsFile(atmos)')
2158 IF ((models(iatmos)%IsActive).and. &
2159 & (models(idata )%IsActive)) THEN
2160 weights(iatmos)%ncfile=trim(adjustl(cval(nval)))
2161 END IF
2162 CASE ('VnameDATA(atmos)')
2163 IF ((models(iatmos)%IsActive).and. &
2164 & (models(idata )%IsActive)) THEN
2165 weights(iatmos)%VnameDATA=trim(adjustl(cval(nval)))
2166 END IF
2167 CASE ('VnameESM(atmos)')
2168 IF ((models(iatmos)%IsActive).and. &
2169 & (models(idata )%IsActive)) THEN
2170 weights(iatmos)%VnameESM=trim(adjustl(cval(nval)))
2171 END IF
2172 CASE ('NestedGrid(atmos)')
2173 npts=load_i(nval, rval, 1, ivalue)
2174 IF ((models(iatmos)%IsActive).and. &
2175 & (models(idata )%IsActive)) THEN
2176 weights(iatmos)%NestedGrid=ivalue(1)
2177 END IF
2178# endif
2179 CASE ('DebugLevel')
2180 npts=load_i(nval, rval, 1, ivalue)
2181 debuglevel=ivalue(1)
2182 CASE ('TraceLevel')
2183 npts=load_i(nval, rval, 1, ivalue)
2184 tracelevel=ivalue(1)
2185 IF (tracelevel.gt.0) THEN
2186 esm_track=.true.
2187 END IF
2188 CASE ('Nimport(roms)')
2189 npts=load_i(nval, rval, 1, ivalue)
2190 IF (ivalue(1).gt.0) THEN
2191 IF (.not.allocated(models(iroms)%ImportField)) THEN
2192 allocate ( models(iroms)%ImportField(ivalue(1)) )
2193 END IF
2194 nimport(iroms)=ivalue(1)
2195 END IF
2196 CASE ('Nexport(roms)')
2197 npts=load_i(nval, rval, 1, ivalue)
2198 IF (ivalue(1).gt.0) THEN
2199 IF (.not.allocated(models(iroms)%ExportField)) THEN
2200 allocate ( models(iroms)%ExportField(ivalue(1)) )
2201 END IF
2202 nexport(iroms)=ivalue(1)
2203 END IF
2204 CASE ('Import(roms)')
2205 IF ((nimport(iroms).gt.0).and. &
2206 & (nval.le.nimport(iroms))) THEN
2207 models(iroms)%ImportField(nval)%short_name= &
2208 & trim(adjustl(cval(nval)))
2209 END IF
2210 CASE ('Export(roms)')
2211 IF ((nexport(iroms).gt.0).and. &
2212 & (nval.le.nexport(iroms))) THEN
2213 models(iroms)%ExportField(nval)%short_name= &
2214 & trim(adjustl(cval(nval)))
2215 END IF
2216 CASE ('Nimport(atmos)')
2217 npts=load_i(nval, rval, 1, ivalue)
2218 IF (ivalue(1).gt.0) THEN
2219 IF (models(iatmos)%IsActive) THEN
2220 IF (.not.allocated(models(iatmos)%ImportField)) THEN
2221 allocate ( models(iatmos)%ImportField(ivalue(1)) )
2222 END IF
2223 nimport(iatmos)=ivalue(1)
2224 END IF
2225 END IF
2226 CASE ('Nexport(atmos)')
2227 npts=load_i(nval, rval, 1, ivalue)
2228 IF (ivalue(1).gt.0) THEN
2229 IF (models(iatmos)%IsActive) THEN
2230 IF (.not.allocated(models(iatmos)%ExportField)) THEN
2231 allocate ( models(iatmos)%ExportField(ivalue(1)) )
2232 END IF
2233 nexport(iatmos)=ivalue(1)
2234 END IF
2235 END IF
2236 CASE ('Import(atmos)')
2237 IF (models(iatmos)%IsActive) THEN
2238 IF ((nimport(iatmos).gt.0).and. &
2239 & (nval.le.nimport(iatmos))) THEN
2240 models(iatmos)%ImportField(nval)%short_name= &
2241 & trim(adjustl(cval(nval)))
2242 END IF
2243 END IF
2244 CASE ('Export(atmos)')
2245 IF (models(iatmos)%IsActive) THEN
2246 IF ((nexport(iatmos).gt.0).and. &
2247 & (nval.le.nexport(iatmos))) THEN
2248 models(iatmos)%ExportField(nval)%short_name= &
2249 & trim(adjustl(cval(nval)))
2250 END IF
2251 END IF
2252 CASE ('Nimport(seaice)')
2253 npts=load_i(nval, rval, 1, ivalue)
2254 IF (ivalue(1).gt.0) THEN
2255 IF (models(iseaice)%IsActive) THEN
2256 IF (.not.allocated(models(iseaice)%ImportField)) THEN
2257 allocate ( models(iseaice)%ImportField(ivalue(1)) )
2258 END IF
2259 nimport(iseaice)=ivalue(1)
2260 END IF
2261 END IF
2262 CASE ('Nexport(seaice)')
2263 npts=load_i(nval, rval, 1, ivalue)
2264 IF (ivalue(1).gt.0) THEN
2265 IF (models(iseaice)%IsActive) THEN
2266 IF (.not.allocated(models(iseaice)%ExportField)) THEN
2267 allocate ( models(iseaice)%ExportField(ivalue(1)) )
2268 END IF
2269 nexport(iseaice)=ivalue(1)
2270 END IF
2271 END IF
2272 CASE ('Import(seaice)')
2273 IF (models(iseaice)%IsActive) THEN
2274 IF ((nimport(iseaice).gt.0).and. &
2275 & (nval.le.nimport(iseaice))) THEN
2276 models(iseaice)%ImportField(nval)%short_name= &
2277 & trim(adjustl(cval(nval)))
2278 END IF
2279 END IF
2280 CASE ('Export(seaice)')
2281 IF (models(iseaice)%IsActive) THEN
2282 IF ((nexport(iseaice).gt.0).and. &
2283 & (nval.le.nexport(iseaice))) THEN
2284 models(iseaice)%ExportField(nval)%short_name= &
2285 & trim(adjustl(cval(nval)))
2286 END IF
2287 END IF
2288 CASE ('Nimport(waves)')
2289 npts=load_i(nval, rval, 1, ivalue)
2290 IF (ivalue(1).gt.0) THEN
2291 IF (models(iwave)%IsActive) THEN
2292 IF (.not.allocated(models(iwave)%ImportField)) THEN
2293 allocate ( models(iwave)%ImportField(ivalue(1)) )
2294 END IF
2295 nimport(iwave)=ivalue(1)
2296 END IF
2297 END IF
2298 CASE ('Nexport(waves)')
2299 npts=load_i(nval, rval, 1, ivalue)
2300 IF (ivalue(1).gt.0) THEN
2301 IF (models(iwave)%IsActive) THEN
2302 IF (.not.allocated(models(iwave)%ExportField)) THEN
2303 allocate ( models(iwave)%ExportField(ivalue(1)) )
2304 END IF
2305 nexport(iwave)=ivalue(1)
2306 END IF
2307 END IF
2308 CASE ('Import(waves)')
2309 IF (models(iwave)%IsActive) THEN
2310 IF ((nimport(iwave).gt.0).and. &
2311 & (nval.le.nimport(iwave))) THEN
2312 models(iwave)%ImportField(nval)%short_name= &
2313 & trim(adjustl(cval(nval)))
2314 END IF
2315 END IF
2316 CASE ('Export(waves)')
2317 IF (models(iwave)%IsActive) THEN
2318 IF ((nexport(iwave).gt.0).and. &
2319 & (nval.le.nexport(iwave))) THEN
2320 models(iwave)%ExportField(nval)%short_name= &
2321 & trim(adjustl(cval(nval)))
2322 END IF
2323 END IF
2324
2325# ifdef DATA_COUPLING
2326 CASE ('nDataExport(roms)')
2327 npts=load_i(nval, rval, 1, ivalue)
2328 icomp=iroms
2329 IF (models(idata)%IsActive.and. &
2330 & models(icomp)%IsActive) THEN
2331 dataset(icomp)%Nfields=ivalue(1)
2332 IF (dataset(icomp)%Nfields.gt.0) THEN
2333 nexport(idata)=nexport(idata)+ivalue(1)
2334 IF (.not.allocated(dataset(icomp)%Export)) THEN
2335 allocate ( dataset(icomp)%Export(ivalue(1)) )
2336 END IF
2337 IF (.not.allocated(dataset(icomp)%Field)) THEN
2338 allocate ( dataset(icomp)%Field(ivalue(1)) )
2339 END IF
2340 IF (.not.allocated(dataset(icomp)%Ctarget)) THEN
2341 allocate ( dataset(icomp)%Ctarget(ivalue(1)) )
2342 END IF
2343 DO i=1,dataset(icomp)%Nfields
2344 dataset(icomp)%Ctarget(i)=trim(models(icomp)%name)
2345 END DO
2346 END IF
2347 END IF
2348 CASE ('nDataFiles(roms)')
2349 npts=load_i(nval, rval, 1, nd2r)
2350 icomp=iroms
2351 IF (models(idata)%IsActive.and. &
2352 & models(icomp)%IsActive) THEN
2353 dataset(icomp)%Nfiles=nd2r(1)
2354 IF (dataset(icomp)%Nfiles.gt.0) THEN
2355 IF (.not.allocated(dataset(icomp)%IFS)) THEN
2356 allocate( dataset(icomp)%IFS(nd2r(1)) )
2357 END IF
2358 END IF
2359 END IF
2360 IF (dataset(icomp)%Nfiles.gt.0) THEN
2361 IF (allocated(ncount)) THEN
2362 deallocate ( ncount )
2363 END IF
2364 allocate ( ncount(nd2r(1),1) )
2365 ncount=0
2366 IF (.not.allocated(d2r)) THEN
2367 allocate ( d2r(nd2r(1),1) ) ! 2D structure so we
2368 END IF ! use "load_s2d"
2369 END IF
2370 CASE ('DataExport(roms)')
2371 IF (models(idata)%IsActive.and. &
2372 & models(iroms)%IsActive) THEN
2373 nfields=dataset(icomp)%Nfields
2374 IF ((nfields.gt.0).and.(nval.le.nfields)) THEN
2375 dataset(iroms)%Field(nval)=trim(adjustl(cval(nval)))
2376 END IF
2377 END IF
2378 CASE ('DataFiles(roms)')
2379 IF (models(idata)%IsActive.and. &
2380 & (dataset(iroms)%Nfiles.gt.0)) THEN
2381 label='D2R - Data Model export fields to ROMS'
2382 npts=load_s2d(nval, cval, cdim, line, label, ifile, &
2383 & igrid, 1, nd2r, ncount, nd2r(1), inp_lib, &
2384 & d2r)
2385 END IF
2386 CASE ('nDataExport(atmos)')
2387 npts=load_i(nval, rval, 1, ivalue)
2388 icomp=iatmos
2389 IF (models(idata)%IsActive.and. &
2390 & models(icomp)%IsActive) THEN
2391 dataset(icomp)%Nfields=ivalue(1)
2392 IF (dataset(icomp)%Nfields.gt.0) THEN
2393 nexport(idata)=nexport(idata)+ivalue(1)
2394 IF (.not.allocated(dataset(icomp)%Field)) THEN
2395 allocate ( dataset(icomp)%Field(ivalue(1)) )
2396 END IF
2397 IF (.not.allocated(dataset(icomp)%Export)) THEN
2398 allocate ( dataset(icomp)%Export(ivalue(1)) )
2399 END IF
2400 IF (.not.allocated(dataset(icomp)%Ctarget)) THEN
2401 allocate ( dataset(icomp)%Ctarget(ivalue(1)) )
2402 END IF
2403 DO i=1,dataset(icomp)%Nfields
2404 dataset(icomp)%Ctarget(i)=trim(models(icomp)%name)
2405 END DO
2406 END IF
2407 END IF
2408 CASE ('nDataFiles(atmos)')
2409 npts=load_i(nval, rval, 1, nd2a)
2410 icomp=iatmos
2411 IF (models(idata)%IsActive.and. &
2412 & models(icomp)%IsActive) THEN
2413 dataset(icomp)%Nfiles=nd2a(1)
2414 IF (dataset(icomp)%Nfiles.gt.0) THEN
2415 IF (.not.allocated(dataset(icomp)%IFS)) THEN
2416 allocate ( dataset(icomp)%IFS(nd2a(1)) )
2417 END IF
2418 END IF
2419 END IF
2420 IF (dataset(icomp)%Nfiles.gt.0) THEN
2421 IF (allocated(ncount)) THEN
2422 deallocate ( ncount )
2423 END IF
2424 allocate ( ncount(nd2a(1),1) )
2425 ncount=0
2426 IF (.not.allocated(d2a)) THEN
2427 allocate ( d2a(nd2a(1),1) ) ! 2D structure so we
2428 END IF ! use "load_s2d"
2429 END IF
2430 CASE ('DataExport(atmos)')
2431 IF (models(idata )%IsActive.and. &
2432 & models(iatmos)%IsActive) THEN
2433 nfields=dataset(iatmos)%Nfields
2434 IF ((nfields.gt.0).and.(nval.le.nfields)) THEN
2435 dataset(iatmos)%Field(nval)=trim(adjustl(cval(nval)))
2436 END IF
2437 END IF
2438 CASE ('DataFiles(atmos)')
2439 IF (models(idata)%IsActive.and. &
2440 & (dataset(iatmos)%Nfiles.gt.0)) THEN
2441 label='D2A - Data Model export fields to ATM model'
2442 npts=load_s2d(nval, cval, cdim, line, label, ifile, &
2443 & igrid, 1, nd2a, ncount, nd2a(1), inp_lib, &
2444 & d2a)
2445 END IF
2446 CASE ('nDataExport(seaice)')
2447 npts=load_i(nval, rval, 1, ivalue)
2448 icomp=iseaice
2449 IF (models(idata)%IsActive.and. &
2450 & models(icomp)%IsActive) THEN
2451 dataset(icomp)%Nfields=ivalue(1)
2452 IF (dataset(icomp)%Nfields.gt.0) THEN
2453 nexport(idata)=nexport(idata)+ivalue(1)
2454 IF (.not.allocated(dataset(icomp)%Field)) THEN
2455 allocate ( dataset(icomp)%Field(ivalue(1)) )
2456 END IF
2457 IF (.not.allocated(dataset(icomp)%Export)) THEN
2458 allocate ( dataset(icomp)%Export(ivalue(1)) )
2459 END IF
2460 IF (.not.allocated(dataset(icomp)%Ctarget)) THEN
2461 allocate ( dataset(icomp)%Ctarget(ivalue(1)) )
2462 END IF
2463 DO i=1,dataset(icomp)%Nfields
2464 dataset(icomp)%Ctarget(i)=trim(models(icomp)%name)
2465 END DO
2466 END IF
2467 END IF
2468 CASE ('nDataFiles(seaice)')
2469 npts=load_i(nval, rval, 1, nd2i)
2470 icomp=iseaice
2471 IF (models(idata)%IsActive.and. &
2472 & models(icomp)%IsActive) THEN
2473 dataset(icomp)%Nfiles=nd2i(1)
2474 IF (dataset(icomp)%Nfiles.gt.0) THEN
2475 IF (.not.allocated(dataset(icomp)%IFS)) THEN
2476 allocate( dataset(icomp)%IFS(nd2i(1)) )
2477 END IF
2478 END IF
2479 END IF
2480 IF (dataset(icomp)%Nfiles.gt.0) THEN
2481 IF (allocated(ncount)) THEN
2482 deallocate ( ncount )
2483 END IF
2484 allocate ( ncount(nd2i(1),1) )
2485 ncount=0
2486 IF (.not.allocated(d2i)) THEN
2487 allocate ( d2i(nd2i(1),1) ) ! 2D structure so we
2488 END IF ! use "load_s2d"
2489 END IF
2490 CASE ('DataExport(seaice)')
2491 IF (models(idata )%IsActive.and. &
2492 & models(iseaice)%IsActive) THEN
2493 nfields=dataset(iseaice)%Nfields
2494 IF ((nfields.gt.0).and.(nval.le.nfields)) THEN
2495 dataset(iseaice)%Field(nval)=trim(adjustl(cval(nval)))
2496 END IF
2497 END IF
2498 CASE ('DataFiles(seaice)')
2499 IF (models(idata)%IsActive.and. &
2500 & (dataset(iseaice)%Nfiles.gt.0)) THEN
2501 label='D2I - Data Model export fields to Sea ICE model'
2502 npts=load_s2d(nval, cval, cdim, line, label, ifile, &
2503 & igrid, 1, nd2i, ncount, nd2i(1), inp_lib, &
2504 & d2i)
2505 END IF
2506 CASE ('nDataExport(waves)')
2507 npts=load_i(nval, rval, 1, ivalue)
2508 icomp=iwave
2509 IF (models(idata)%IsActive.and. &
2510 & models(icomp)%IsActive) THEN
2511 dataset(icomp)%Nfields=ivalue(1)
2512 IF (dataset(icomp)%Nfields.gt.0) THEN
2513 nexport(idata)=nexport(idata)+ivalue(1)
2514 IF (.not.allocated(dataset(icomp)%Field)) THEN
2515 allocate ( dataset(icomp)%Field(ivalue(1)) )
2516 END IF
2517 IF (.not.allocated(dataset(icomp)%Export)) THEN
2518 allocate ( dataset(icomp)%Export(ivalue(1)) )
2519 END IF
2520 IF (.not.allocated(dataset(icomp)%Ctarget)) THEN
2521 allocate ( dataset(icomp)%Ctarget(ivalue(1)) )
2522 END IF
2523 DO i=1,dataset(icomp)%Nfields
2524 dataset(icomp)%Ctarget(i)=trim(models(icomp)%name)
2525 END DO
2526 END IF
2527 END IF
2528 CASE ('nDataFiles(waves)')
2529 npts=load_i(nval, rval, 1, nd2w)
2530 icomp=iwave
2531 IF (models(idata)%IsActive.and. &
2532 & models(icomp)%IsActive) THEN
2533 dataset(icomp)%Nfiles=nd2w(1)
2534 IF (dataset(icomp)%Nfiles.gt.0) THEN
2535 IF (.not.allocated(dataset(icomp)%IFS)) THEN
2536 allocate( dataset(icomp)%IFS(nd2w(1)) )
2537 END IF
2538 END IF
2539 END IF
2540 IF (dataset(icomp)%Nfiles.gt.0) THEN
2541 IF (allocated(ncount)) THEN
2542 deallocate ( ncount )
2543 END IF
2544 allocate ( ncount(nd2w(1),1) )
2545 ncount=0
2546 IF (.not.allocated(d2w)) THEN
2547 allocate ( d2w(nd2w(1),1) ) ! 2D structure so we
2548 END IF ! use "load_s2d"
2549 END IF
2550 CASE ('DataExport(waves)')
2551 IF (models(idata)%IsActive.and. &
2552 & models(iwave)%IsActive) THEN
2553 nfields=dataset(iwave)%Nfields
2554 IF ((nfields.gt.0).and.(nval.le.nfields)) THEN
2555 dataset(iwave)%Field(nval)=trim(adjustl(cval(nval)))
2556 END IF
2557 END IF
2558 CASE ('DataFiles(waves)')
2559 IF (models(idata)%IsActive.and. &
2560 & (dataset(iwave)%Nfiles.gt.0)) THEN
2561 label='D2W - Data Model export fields to Wave model'
2562 npts=load_s2d(nval, cval, cdim, line, label, ifile, &
2563 & igrid, 1, nd2w, ncount, nd2w(1), inp_lib, &
2564 & d2w)
2565 END IF
2566# endif
2567 END SELECT
2568 END IF
2569 END DO
2570 20 IF (localpet.eq.0) WRITE (out,40) line
2571 exit_flag=4
2572 rc=esmf_rc_file_read
2573 RETURN
2574 30 CLOSE (inp)
2575 40 FORMAT (/,' read_ESMconfig - Error while processing line: ',/,a)
2576!
2577!-----------------------------------------------------------------------
2578! Set ESM, import state, and export state unique labels. They are
2579! used for adding and advertising import/export state including
2580! nested grids.
2581!-----------------------------------------------------------------------
2582!
2583! Determine the number of DATA component states when connected to other
2584! ESM components nested grids. Recall that the DATA component has
2585! a single grid with no nesting.
2586!
2587 IF (models(idata)%IsActive) THEN
2588 nstates=1
2589 DO i=1,nmodels
2590 ic=0
2591 IF (i.ne.idata) THEN
2592 DO ng=1,models(i)%Ngrids
2593 IF (coupled(i)%LinkedGrid(ng,idata)) THEN
2594 ic=ic+1
2595 END IF
2596 END DO
2597 nstates=max(nstates,ic)
2598 END IF
2599 END DO
2600 IF (.not.allocated(coupled(idata)%LinkedGrid)) THEN
2601 allocate ( coupled(idata)%LinkedGrid(nstates,nmodels) )
2602 coupled(idata)%LinkedGrid=.false.
2603 DO i=1,nmodels
2604 ic=0
2605 IF (i.ne.idata) THEN
2606 DO ng=1,models(i)%Ngrids
2607 IF (coupled(i)%LinkedGrid(ng,idata)) THEN
2608 ic=ic+1
2609 coupled(idata)%LinkedGrid(ic,i)=.true.
2610 END IF
2611 END DO
2612 END IF
2613 END DO
2614 END IF
2615 IF (.not.allocated(coupled(idata)%DataCoupledSets)) THEN
2616 allocate ( coupled(idata)%DataCoupledSets(nstates,nmodels) )
2617 coupled(idata)%DataCoupledSets=0
2618 END IF
2619 IF (.not.allocated(coupled(idata)%ExportState)) THEN
2620 allocate ( coupled(idata)%ExportState(nstates,nmodels) )
2621 END IF
2622 END IF
2623!
2624! Allocate coupled sets and states variables, which are needed when
2625! calling "NUOPC_AddNestedState"
2626!
2627 DO i=1,nmodels
2628 IF (models(i)%IsActive) THEN
2629 IF (i.eq.idata) THEN
2630 ngrd=nstates
2631 ELSE
2632 ngrd=models(i)%Ngrids
2633 END IF
2634 IF (.not.allocated(models(i)%grid)) THEN
2635 allocate ( models(i)%grid(ngrd) )
2636 END IF
2637 IF (.not.allocated(coupled(i)%SetLabel)) THEN
2638 allocate ( coupled(i)%SetLabel(ngrd) )
2639 DO ng=1,ngrd
2640 coupled(i)%SetLabel(ng)=blank
2641 END DO
2642 END IF
2643 IF (.not.allocated(coupled(i)%ExpLabel)) THEN
2644 allocate ( coupled(i)%ExpLabel(ngrd) )
2645 DO ng=1,ngrd
2646 coupled(i)%ExpLabel(ng)=blank
2647 END DO
2648 END IF
2649 IF (.not.allocated(coupled(i)%ImpLabel)) THEN
2650 allocate ( coupled(i)%ImpLabel(ngrd) )
2651 DO ng=1,ngrd
2652 coupled(i)%ImpLabel(ng)=blank
2653 END DO
2654 END IF
2655 END IF
2656 END DO
2657!
2658! Determine the number of coupled state sets as the maximum number of
2659! connected nested grids in a ESM component and track its location.
2660! If Ncplsets=1, choose as location the component with the maximum
2661! connections to other ESM component.
2662!
2663 ncplsets=maxval(models(:)%Ngrids, mask=models(:)%IsActive)
2664 IF ((ncplsets.eq.1).and.(nstates.eq.1)) THEN
2665 ic=0
2666 location(1)=1
2667 DO i=1,nmodels
2668 IF (models(i)%IsActive) THEN
2669 j=count(coupled(i)%LinkedGrid)
2670 IF (j.gt.ic) THEN
2671 ic=j
2672 location(1)=i
2673 END IF
2674 END IF
2675 END DO
2676 ELSE
2677 location=maxloc(models(:)%Ngrids, mask=models(:)%IsActive)
2678 END IF
2679 esmorder=0
2680!
2681! The ESM component with the maximum number of connected nested grids
2682! determines the different coupled sets. Order the active and connected
2683! components accordingly to facilitate the setting of import and
2684! export state labels.
2685!
2686 ic=1
2687 esmorder(ic)=location(1)
2688 DO i=1,nmodels
2689 IF (models(i)%IsActive.and.(i.ne.location(1))) THEN
2690 ic=ic+1
2691 esmorder(ic)=i
2692 END IF
2693 END DO
2694 esmcount=ic
2695!
2696! Define coupled sets labels.
2697!
2698 IF (.not.allocated(setlabel)) THEN
2699 allocate ( setlabel(ncplsets) )
2700 END IF
2701 IF (.not.allocated(explabel)) THEN
2702 allocate ( explabel(ncplsets) )
2703 END IF
2704 IF (.not.allocated(implabel)) THEN
2705 allocate ( implabel(ncplsets) )
2706 END IF
2707 DO i=1,ncplsets
2708 WRITE (setlabel(i), '(a,i2.2)') 'ESM_', i
2709 WRITE (explabel(i), '(a,i2.2)') 'Export_ESM_', i
2710 WRITE (implabel(i), '(a,i2.2)') 'Import_ESM_', i
2711 END DO
2712!
2713! Set coupled sets and import/export state labels.
2714!
2715 DO j=1,esmcount
2716 jcomp=esmorder(j)
2717 IF (jcomp.eq.idata) THEN
2718 jgrids=nstates
2719 ELSE
2720 jgrids=models(jcomp)%Ngrids
2721 END IF
2722 DO i=1,esmcount
2723 icomp=esmorder(i)
2724 IF (icomp.eq.idata) THEN
2725 igrids=nstates
2726 ELSE
2727 igrids=models(icomp)%Ngrids
2728 END IF
2729 IF (icomp.ne.jcomp) THEN
2730 DO jg=1,jgrids
2731 DO ig=1,igrids
2732 IF (coupled(icomp)%LinkedGrid(ig,jcomp).or. &
2733 & coupled(jcomp)%LinkedGrid(jg,icomp)) THEN
2734 ng=max(ig,jg)
2735 setlstr=len_trim(coupled(jcomp)%SetLabel(jg))
2736 IF (setlstr.eq.0) THEN
2737 coupled(jcomp)%SetLabel(jg)=trim(setlabel(ng))
2738 END IF
2739!
2740 explstr=len_trim(coupled(jcomp)%ExpLabel(jg))
2741 IF (nexport(jcomp).gt.0) THEN
2742 IF (explstr.eq.0) THEN
2743 coupled(jcomp)%ExpLabel(jg)=trim(explabel(ng))
2744 END IF
2745 ELSE
2746 IF (explstr.eq.0) THEN
2747 coupled(jcomp)%ExpLabel(jg)='NONE'
2748 END IF
2749 END IF
2750!
2751 implstr=len_trim(coupled(jcomp)%ImpLabel(jg))
2752 IF (nimport(jcomp).gt.0) THEN
2753 IF (implstr.eq.0) THEN
2754 coupled(jcomp)%ImpLabel(jg)=trim(implabel(ng))
2755 END IF
2756 ELSE
2757 IF (implstr.eq.0) THEN
2758 coupled(jcomp)%ImpLabel(jg)='NONE'
2759 END IF
2760 END IF
2761!
2762 doit=coupled(idata)%DataCoupledSets(jg,jcomp).eq.0
2763 IF (coupled(jcomp)%LinkedGrid(jg,idata).and.doit) THEN
2764 coupled(idata)%DataCoupledSets(jg,jcomp)=ng
2765 END IF
2766 END IF
2767 END DO
2768 END DO
2769 END IF
2770 END DO
2771 END DO
2772!
2773!-----------------------------------------------------------------------
2774! Set ESM time managing variables.
2775!-----------------------------------------------------------------------
2776!
2777! Create ESM calendar for driver and components.
2778!
2779 SELECT CASE (trim(lowercase(datecalendar)))
2780 CASE ('gregorian')
2781 caltype=esmf_calkind_gregorian
2782 CASE ('year_360_day', '360_day')
2783 caltype=esmf_calkind_360day
2784 END SELECT
2785!
2786 clockinfo(idriver)%Calendar=esmf_calendarcreate(caltype, rc=rc)
2787 IF (esmf_logfounderror(rctocheck=rc, &
2788 & msg=esmf_logerr_passthru, &
2789 & line=__line__, &
2790 & file=myfile)) THEN
2791 RETURN
2792 END IF
2793 clockinfo(idriver)%Name='Driver_clock'
2794!
2795! Set ESM coupling simulation reference date number.
2796!
2797 CALL datenum (referencedatenumber, &
2798 & referencedate(1), &
2799 & referencedate(2), &
2800 & referencedate(3), &
2801 & referencedate(4), &
2802 & referencedate(5), &
2803 & real(referencedate(6),dp))
2804!
2805! Set ESM coupling simulation reference time.
2806!
2807 CALL esmf_timeset (clockinfo(idriver)%ReferenceTime, &
2808 & yy=referencedate(1), &
2809 & mm=referencedate(2), &
2810 & dd=referencedate(3), &
2811 & h= referencedate(4), &
2812 & m= referencedate(5), &
2813 & s= referencedate(6), &
2814 & calkindflag=caltype, &
2815 & rc=rc)
2816 IF (esmf_logfounderror(rctocheck=rc, &
2817 & msg=esmf_logerr_passthru, &
2818 & line=__line__, &
2819 & file=myfile)) THEN
2820 RETURN
2821 END IF
2822!
2823 CALL esmf_timeget (clockinfo(idriver)%ReferenceTime, &
2824 & s_r8=clockinfo(idriver)%Time_Reference, &
2825 & timestring=timereferencestring)
2826 IF (esmf_logfounderror(rctocheck=rc, &
2827 & msg=esmf_logerr_passthru, &
2828 & line=__line__, &
2829 & file=myfile)) THEN
2830 RETURN
2831 END IF
2832 is=index(timereferencestring, 'T') ! remove 'T' in
2833 IF (is.gt.0) timereferencestring(is:is)=' ' ! ISO 8601 format
2834!
2835 clockinfo(idriver)%Time_ReferenceString=trim(timereferencestring)
2836 DO i=1,nmodels
2837 clockinfo(i)%ReferenceTime=clockinfo(idriver)%ReferenceTime
2838 clockinfo(i)%Time_Reference=clockinfo(idriver)%Time_Reference
2839 clockinfo(i)%Time_ReferenceString=trim(timereferencestring)
2840 END DO
2841!
2842! Set ESM coupling driver interval.
2843!
2844 CALL esmf_timeintervalset (clockinfo(idriver)%TimeStep, &
2845 & calendar=clockinfo(idriver)%Calendar, &
2846 & yy=timestep(1), &
2847 & mm=timestep(2), &
2848 & d_r8=real(timestep(3),dp), &
2849 & h= timestep(4), &
2850 & m= timestep(5), &
2851 & s= timestep(6), &
2852 & rc=rc)
2853 IF (esmf_logfounderror(rctocheck=rc, &
2854 & msg=esmf_logerr_passthru, &
2855 & line=__line__, &
2856 & file=myfile)) THEN
2857 RETURN
2858 END IF
2859!
2860 CALL esmf_timeintervalget (clockinfo(idriver)%TimeStep, &
2861 & s_r8=clockinfo(idriver)%Time_Step)
2862 IF (esmf_logfounderror(rctocheck=rc, &
2863 & msg=esmf_logerr_passthru, &
2864 & line=__line__, &
2865 & file=myfile)) THEN
2866 RETURN
2867 END IF
2868!
2869 DO i=1,nmodels
2870 clockinfo(i)%TimeStep=clockinfo(idriver)%TimeStep
2871 clockinfo(i)%Time_Step=clockinfo(idriver)%Time_Step
2872 END DO
2873!
2874! Set ESM coupling driver Start Time.
2875!
2876 CALL esmf_timeset (mystarttime, &
2877 & yy=startdate(1), &
2878 & mm=startdate(2), &
2879 & dd=startdate(3), &
2880 & h= startdate(4), &
2881 & m= startdate(5), &
2882 & s= startdate(6), &
2883 & calkindflag=caltype, &
2884 & rc=rc)
2885 IF (esmf_logfounderror(rctocheck=rc, &
2886 & msg=esmf_logerr_passthru, &
2887 & line=__line__, &
2888 & file=myfile)) THEN
2889 RETURN
2890 END IF
2891
2892# ifdef REGRESS_STARTCLOCK
2893!
2894! If regressing start time clock, SUBSTRACT a coupling interval to
2895! the provided start date to allow the proper initialization of the
2896! import and export states. Also, it facilitates the processing and
2897! exchange of the two time-level (LOWER and UPPER) snapshots between
2898! ESM components before time stepping. The LOWER snapshop is exchanged
2899! during initialization. The UPPER snapshot is exchanged on the first
2900! call to the "XXXX_ModelAdvance" routine in the component NUOPC cap
2901! module, but no time-stepping occurs.
2902!
2903 CALL esmf_timeget (mystarttime-clockinfo(idriver)%TimeStep, &
2904 & yy=newdate(1), &
2905 & mm=newdate(2), &
2906 & dd=newdate(3), &
2907 & h= newdate(4), &
2908 & m= newdate(5), &
2909 & s= newdate(6), &
2910 & ms=newdate(7), &
2911 & timestring=timestartstring, &
2912 & rc=rc)
2913 IF (esmf_logfounderror(rctocheck=rc, &
2914 & msg=esmf_logerr_passthru, &
2915 & line=__line__, &
2916 & file=myfile)) THEN
2917 RETURN
2918 END IF
2919! Regressed Start Time
2920 CALL esmf_timeset (clockinfo(idriver)%StartTime, &
2921 & yy=newdate(1), &
2922 & mm=newdate(2), &
2923 & dd=newdate(3), &
2924 & h= newdate(4), &
2925 & m= newdate(5), &
2926 & s= newdate(6), &
2927 & ms=newdate(7), &
2928 & calkindflag=caltype, &
2929 & rc=rc)
2930 IF (esmf_logfounderror(rctocheck=rc, &
2931 & msg=esmf_logerr_passthru, &
2932 & line=__line__, &
2933 & file=myfile)) THEN
2934 RETURN
2935 END IF
2936# else
2937 clockinfo(idriver)%StartTime=mystarttime
2938# endif
2939!
2940 CALL esmf_timeget (clockinfo(idriver)%StartTime, &
2941 & s_r8=clockinfo(idriver)%Time_Start, &
2942 & timestring=timestartstring)
2943 IF (esmf_logfounderror(rctocheck=rc, &
2944 & msg=esmf_logerr_passthru, &
2945 & line=__line__, &
2946 & file=myfile)) THEN
2947 RETURN
2948 END IF
2949 is=index(timestartstring, 'T') ! remove 'T' in
2950 IF (is.gt.0) timestartstring(is:is)=' ' ! ISO 8601 format
2951!
2952 clockinfo(idriver)%Time_StartString=trim(timestartstring)
2953 DO i=1,nmodels
2954 clockinfo(i)%StartTime=clockinfo(idriver)%StartTime
2955 clockinfo(i)%Time_Start=clockinfo(idriver)%Time_Start
2956 clockinfo(i)%Time_StartString=trim(timestartstring)
2957 END DO
2958!
2959! Set ESM coupling driver Restart Time.
2960!
2961 CALL esmf_timeset (myrestarttime, &
2962 & yy=restartdate(1), &
2963 & mm=restartdate(2), &
2964 & dd=restartdate(3), &
2965 & h= restartdate(4), &
2966 & m= restartdate(5), &
2967 & s= restartdate(6), &
2968 & calkindflag=caltype, &
2969 & rc=rc)
2970 IF (esmf_logfounderror(rctocheck=rc, &
2971 & msg=esmf_logerr_passthru, &
2972 & line=__line__, &
2973 & file=myfile)) THEN
2974 RETURN
2975 END IF
2976
2977# ifdef REGRESS_STARTCLOCK
2978!
2979! If regressing start time clock, SUBSTRACT coupling interval to the
2980! Restart Time for the same reasons mentioned above.
2981!
2982 CALL esmf_timeget (myrestarttime-clockinfo(idriver)%TimeStep, &
2983 & yy=newdate(1), &
2984 & mm=newdate(2), &
2985 & dd=newdate(3), &
2986 & h= newdate(4), &
2987 & m= newdate(5), &
2988 & s= newdate(6), &
2989 & ms=newdate(7), &
2990 & timestring=timerestartstring, &
2991 & rc=rc)
2992 IF (esmf_logfounderror(rctocheck=rc, &
2993 & msg=esmf_logerr_passthru, &
2994 & line=__line__, &
2995 & file=myfile)) THEN
2996 RETURN
2997 END IF
2998! Regressed Restart Time
2999 CALL esmf_timeset (clockinfo(idriver)%RestartTime, &
3000 & yy=newdate(1), &
3001 & mm=newdate(2), &
3002 & dd=newdate(3), &
3003 & h= newdate(4), &
3004 & m= newdate(5), &
3005 & s= newdate(6), &
3006 & ms=newdate(7), &
3007 & calkindflag=caltype, &
3008 & rc=rc)
3009 IF (esmf_logfounderror(rctocheck=rc, &
3010 & msg=esmf_logerr_passthru, &
3011 & line=__line__, &
3012 & file=myfile)) THEN
3013 RETURN
3014 END IF
3015# else
3016 clockinfo(idriver)%RestartTime=myrestarttime
3017# endif
3018!
3019 CALL esmf_timeget (clockinfo(idriver)%RestartTime, &
3020 & s_r8=clockinfo(idriver)%Time_Restart, &
3021 & timestring=timerestartstring)
3022 IF (esmf_logfounderror(rctocheck=rc, &
3023 & msg=esmf_logerr_passthru, &
3024 & line=__line__, &
3025 & file=myfile)) THEN
3026 RETURN
3027 END IF
3028 is=index(timerestartstring, 'T') ! remove 'T' in
3029 IF (is.gt.0) timerestartstring(is:is)=' ' ! ISO 8601 format
3030!
3031 clockinfo(idriver)%Time_RestartString=trim(timerestartstring)
3032 DO i=1,nmodels
3033 clockinfo(i)%RestartTime=clockinfo(idriver)%RestartTime
3034 clockinfo(i)%Time_Restart=clockinfo(idriver)%Time_Restart
3035 clockinfo(i)%Time_RestartString=trim(timerestartstring)
3036 END DO
3037!
3038! ESM coupling driver stop time.
3039!
3040 CALL esmf_timeset (clockinfo(idriver)%StopTime, &
3041 & yy=stopdate(1), &
3042 & mm=stopdate(2), &
3043 & dd=stopdate(3), &
3044 & h= stopdate(4), &
3045 & m= stopdate(5), &
3046 & s= stopdate(6), &
3047 & calkindflag=caltype, &
3048 & rc=rc)
3049 IF (esmf_logfounderror(rctocheck=rc, &
3050 & msg=esmf_logerr_passthru, &
3051 & line=__line__, &
3052 & file=myfile)) THEN
3053 RETURN
3054 END IF
3055!
3056 CALL esmf_timeget (clockinfo(idriver)%StopTime, &
3057 & s_r8=clockinfo(idriver)%Time_Stop, &
3058 & timestring=timestopstring)
3059 IF (esmf_logfounderror(rctocheck=rc, &
3060 & msg=esmf_logerr_passthru, &
3061 & line=__line__, &
3062 & file=myfile)) THEN
3063 RETURN
3064 END IF
3065 is=index(timestopstring, 'T') ! remove 'T' in
3066 IF (is.gt.0) timestopstring(is:is)=' ' ! ISO 8601 format
3067!
3068 clockinfo(idriver)%Time_StopString=trim(timestopstring)
3069 DO i=1,nmodels
3070 clockinfo(i)%StopTime=clockinfo(idriver)%StopTime
3071 clockinfo(i)%Time_Stop=clockinfo(idriver)%Time_Stop
3072 clockinfo(i)%Time_StopString=trim(timestopstring)
3073 END DO
3074!
3075! Get time string from ROMS routine for debugging purposes.
3076
3077 CALL time_string (clockinfo(idriver)%Time_Start- &
3078 & clockinfo(idriver)%Time_Reference, fcode(1))
3079 CALL time_string (clockinfo(idriver)%Time_Stop- &
3080 & clockinfo(idriver)%Time_Reference, fcode(2))
3081
3082# ifdef DATA_COUPLING
3083!
3084!-----------------------------------------------------------------------
3085! Load DATA model source files into Input File Structure (IFS).
3086!-----------------------------------------------------------------------
3087!
3088 IF (models(idata)%IsActive.and. &
3089 & models(iroms)%IsActive.and. &
3090 & (dataset(iroms)%Nfiles.gt.0)) THEN
3091 CALL load_ifs (d2r, nd2r(1), 1, nd2r, iroms)
3092 END IF
3093
3094 IF (models(idata )%IsActive.and. &
3095 & models(iatmos)%IsActive.and. &
3096 & (dataset(iatmos)%Nfiles.gt.0)) THEN
3097 CALL load_ifs (d2a, nd2a(1), 1, nd2a, iatmos)
3098 END IF
3099
3100 IF (models(idata )%IsActive.and. &
3101 & models(iseaice)%IsActive.and. &
3102 & (dataset(iseaice)%Nfiles.gt.0)) THEN
3103 CALL load_ifs (d2i, nd2i(1), 1, nd2i, iseaice)
3104 END IF
3105
3106 IF (models(idata)%IsActive.and. &
3107 models(iwave)%IsActive.and. &
3108 & (dataset(iwave)%Nfiles.gt.0)) THEN
3109 CALL load_ifs (d2w, nd2w(1), 1, nd2w, iwave)
3110 END IF
3111!
3112! Set total of DATA model export fields.
3113!
3114 nimport(idata)=0 ! DATA model does not to import fields
3115 nexport(idata)=0
3116 IF (models(idata)%IsActive) THEN
3117 DO i=1,nmodels
3118 IF (models(i)%IsActive.and.(i.ne.idata)) THEN
3119 nfields=dataset(i)%Nfields
3120 nexport(idata)=nexport(idata)+nfields
3121 END IF
3122 END DO
3123 IF (.not.allocated(models(idata)%ExportField)) THEN
3124 allocate ( models(idata)%ExportField(nexport(idata)) )
3125 END IF
3126 ic=0
3127 DO i=1,nmodels
3128 IF (models(i)%IsActive.and.(i.ne.idata)) THEN
3129 nfields=dataset(i)%Nfields
3130 DO j=1,nfields
3131 ic=ic+1
3132 models(idata)%ExportField(ic)%short_name= &
3133 & trim(dataset(i)%Field(j))
3134 END DO
3135 END IF
3136 END DO
3137 END IF
3138# endif
3139!
3140!-----------------------------------------------------------------------
3141! Set several parameters.
3142!-----------------------------------------------------------------------
3143!
3144! Assign PET list for each active ESM component.
3145!
3146 SELECT CASE (trim(petlayoutoption))
3147 CASE ('SEQUENTIAL')
3148 DO j=1,nmodels
3149 IF (models(j)%IsActive) THEN
3150 DO i=1,models(j)%nPETs
3151 models(j)%PETlist(i)=i-1
3152 END DO
3153 END IF
3154 END DO
3155 CASE ('CONCURRENT')
3156 ic=-1
3157 sumpets=0
3158 DO j=1,nmodels
3159 IF (models(j)%IsActive) THEN
3160 DO i=1,models(j)%nPETs
3161 ic=ic+1
3162 models(j)%PETlist(i)=ic
3163 END DO
3164 sumpets=sumpets+models(j)%nPETs
3165 END IF
3166 END DO
3167 END SELECT
3168!
3169! Assign PET list to connectors. Notice that the DATA component only
3170! exports fields and the connection is one way (DATA-TO-XXXX) and the
3171! importing of fields is very unlikely (XXXX-TO-DATA). Thefore, the
3172! import connector to the DATA component is never active.
3173!
3174 DO i=1,nmodels
3175 DO j=1,nmodels
3176 IF (connectors(i,j)%IsActive) THEN
3177 connectors(i,j)%name=trim(models(i)%name)//'-TO-'// &
3178 & trim(models(j)%name)
3179 SELECT CASE (trim(petlayoutoption))
3180 CASE ('SEQUENTIAL')
3181 npets=models(i)%nPETs
3182 connectors(i,j)%nPETs=npets
3183 IF (.not.allocated(connectors(i,j)%PETlist)) THEN
3184 allocate ( connectors(i,j)%PETlist(npets) )
3185 END IF
3186 DO k=1,npets
3187 connectors(i,j)%PETlist(k)=models(i)%PETlist(k)
3188 END DO
3189 CASE ('CONCURRENT')
3190 npets=models(i)%nPETs+models(j)%nPETs
3191 connectors(i,j)%nPETs=npets
3192 IF (.not.allocated(connectors(i,j)%PETlist)) THEN
3193 allocate ( connectors(i,j)%PETlist(npets) )
3194 END IF
3195 DO k=1,models(i)%nPETs
3196 connectors(i,j)%PETlist(k)=models(i)%PETlist(k)
3197 END DO
3198 ic=models(i)%nPETs
3199 DO k=1,models(i)%nPETs
3200 ic=ic+1
3201 connectors(i,j)%PETlist(ic)=models(j)%PETlist(k)
3202 END DO
3203 END SELECT
3204 END IF
3205 END DO
3206 END DO
3207!
3208!-----------------------------------------------------------------------
3209! Report coupling input parameters.
3210!-----------------------------------------------------------------------
3211!
3212 IF (lwrite) THEN
3213 lstr=index(my_fflags, 'free')-2
3214 IF (lstr.le.0) lstr=len_trim(my_fflags)
3215 WRITE (out,70) trim(esmf_version_string), &
3216 & trim(todaydatestring), &
3217 & trim(rdir), &
3218 & trim(my_os), &
3219 & trim(my_cpu), &
3220 & trim(my_fort), &
3221 & trim(my_fc), &
3222 & my_fflags(1:lstr), &
3223 & mycomm, petcount
3224 WRITE (out,80) ' Coupling Input Parameters Filename = ', &
3225 & trim(cinpname)
3226 WRITE (out,80) ' Coupling Run Sequence Filename = ', &
3227 & trim(confname)
3228 WRITE (out,80) ' Coupling Input Metadata Filename = ', &
3229 & trim(cplname)
3230 WRITE (out,80) ' ROMS Input Parameters Filename = ', &
3231 & trim(inpname(iroms))
3232
3233 IF (models(iatmos)%IsActive) THEN
3234 WRITE (out,80) ' ATM Model Input Parameters Filename = ', &
3235 & trim(inpname(iatmos))
3236 END IF
3237 IF (models(iseaice)%IsActive) THEN
3238 WRITE (out,80) ' SEAICE Model Input Parameters Filename = ', &
3239 & trim(inpname(iseaice))
3240 END IF
3241 IF (models(iwave)%IsActive) THEN
3242 WRITE (out,80) ' WAVE Model Input Parameters Filename = ', &
3243 & trim(inpname(iwave))
3244 END IF
3245!
3246 WRITE (out,'(a)') char(10) ! new line
3247
3248 IF (models(iroms)%IsActive) THEN
3249 IF (ngridsr.gt.1) THEN
3250 string=trim(models(iroms)%name)// &
3251 & ' component with nested grids is coupled.'
3252 ELSE
3253 string=trim(models(iroms)%name)//' component is coupled.'
3254 END IF
3255 ELSE
3256 string=trim(models(iroms)%name)//' component is not coupled.'
3257 END IF
3258 WRITE (out,100) models(iroms)%IsActive, 'IsActive(roms)', &
3259 & trim(string)
3260
3261 IF (models(iatmos)%IsActive) THEN
3262 IF (ngridsa.gt.1) THEN
3263 string=trim(models(iatmos)%name)// &
3264 & ' components with nested grids is coupled.'
3265 ELSE
3266 string=trim(models(iatmos)%name)//' component is coupled.'
3267 END IF
3268 ELSE
3269 string=trim(models(iatmos)%name)//' component is not coupled.'
3270 END IF
3271 WRITE (out,100) models(iatmos)%IsActive, 'IsActive(atmos)', &
3272 & trim(string)
3273
3274 IF (models(idata)%IsActive) THEN
3275 string=trim(models(idata)%name)//' component is coupled.'
3276 ELSE
3277 string=trim(models(idata)%name)//' component is not coupled.'
3278 END IF
3279 WRITE (out,100) models(idata)%IsActive, 'IsActive(data)', &
3280 & trim(string)
3281
3282 IF (models(iseaice)%IsActive) THEN
3283 IF (ngridsi.gt.1) THEN
3284 string=trim(models(iseaice)%name)// &
3285 & ' components with nested grids is coupled.'
3286 ELSE
3287 string=trim(models(iseaice)%name)//' component is coupled.'
3288 END IF
3289 ELSE
3290 string=trim(models(iseaice)%name)//' component is not coupled.'
3291 END IF
3292 WRITE (out,100) models(iseaice)%IsActive, 'IsActive(seaice)', &
3293 & trim(string)
3294
3295 IF (models(iwave)%IsActive) THEN
3296 IF (ngridsw.gt.1) THEN
3297 string=trim(models(iwave)%name)// &
3298 & ' components with nested grids is coupled.'
3299 ELSE
3300 string=trim(models(iwave)%name)//' component is coupled.'
3301 END IF
3302 ELSE
3303 string=trim(models(iwave)%name)//' component is not coupled.'
3304 END IF
3305 WRITE (out,100) models(iseaice)%IsActive, 'IsActive(waves)', &
3306 & trim(string)
3307!
3308! Notice that if the DATA component is activated, the reporting is
3309! suppressed for COUPLED(Idata)%LinkedGrid(:,:) since the DATA
3310! component does not import fields from others (like ATM -> DATA).
3311! It only exports fields (like DATA -> ATM). That is, its connector
3312! is only possible in the export direction. Its "LinkedGrid" switches
3313! are only used for setting the coupled set and export state labels
3314! above.
3315!
3316 DO j=1,nmodels
3317 IF (models(j)%IsActive.and.(j.ne.idata)) THEN
3318 ngrd=models(j)%Ngrids
3319 DO i=1,nmodels
3320 DO ng=1,ngrd
3321 IF (coupled(j)%LinkedGrid(ng,i).and.(i.ne.j)) THEN
3322 WRITE (out,110) coupled(j)%LinkedGrid(ng,i), &
3323 & 'Coupled('// &
3324 & trim(clabel(i))//'2'// &
3325 & trim(clabel(j))//')', &
3326 & trim(models(i)%name), &
3327 & trim(models(j)%name), ng
3328 END IF
3329 END DO
3330 END DO
3331 END IF
3332 END DO
3333!
3334 IF (models(idata )%IsActive.or. &
3335 & models(iatmos )%IsActive.or. &
3336 & models(iseaice)%IsActive.or. &
3337 & models(iwave )%IsActive) THEN
3338 IF (couplingtype.eq.1) THEN
3339 string='Explicit coupling method.'
3340 ELSE IF (couplingtype.eq.2) THEN
3341 string='Semi-Implicit coupling method.'
3342 ELSE
3343 WRITE (out,210) 'CouplingType', couplingtype
3344 rc=esmf_rc_val_wrong
3345 exit_flag=7
3346 RETURN
3347 END IF
3348 WRITE (out,120) couplingtype, 'CouplingType', trim(string)
3349 END IF
3350!
3351 IF (models(iatmos )%IsActive.or. &
3352 & models(idata )%IsActive.or. &
3353 & models(iseaice)%IsActive.or. &
3354 & models(iwave )%IsActive) THEN
3355 SELECT CASE(trim(petlayoutoption))
3356 CASE ('SEQUENTIAL')
3357 string='Sequential, models run on all PETs.'
3358 CASE ('CONCURRENT')
3359 string='Concurrent, each model runs on a subset of PETs.'
3360 CASE DEFAULT
3361 WRITE (out,210) 'PETlayoutOption', petlayoutoption
3362 rc=esmf_rc_val_wrong
3363 exit_flag=7
3364 RETURN
3365 END SELECT
3366 WRITE (out,130) trim(petlayoutoption), 'PETlayoutOption', &
3367 & trim(string)
3368 END IF
3369!
3370 IF (models(idata )%IsActive) THEN
3371 WRITE (out,120) itiled, 'ItileD', &
3372 & 'DATA model tile partition in the I-direction.'
3373 WRITE (out,120) jtiled, 'JtileD', &
3374 & 'DATA model tile partition in the J-direction.'
3375 END IF
3376!
3377 IF (models(iatmos )%IsActive.or. &
3378 & models(idata )%IsActive.or. &
3379 & models(iseaice)%IsActive.or. &
3380 & models(iwave )%IsActive) THEN
3381 SELECT CASE(trim(petlayoutoption))
3382 CASE ('SEQUENTIAL')
3383 IF (models(iroms)%IsActive) THEN
3384 icomp=iroms
3385 npets=models(icomp)%nPETs
3386 IF (npets.eq.petcount) THEN
3387 WRITE (out,150) npets, 'Nthreads(roms)', &
3388 & 'Assigned number of PETs for '// &
3389 & trim(models(icomp)%name)//'.'
3390 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3391 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3392 IF (npets.gt.1) THEN
3393 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3394 & trim(adjustl(pend))
3395 ELSE
3396 WRITE (out,290) trim(adjustl(pstr))
3397 END IF
3398 ELSE
3399 WRITE (out,220) 'Nthreads(roms)', ng, npets, &
3400 & petcount
3401 rc=esmf_rc_val_wrong
3402 exit_flag=7
3403 RETURN
3404 END IF
3405 END IF
3406 IF (models(iatmos)%IsActive) THEN
3407 icomp=iatmos
3408 npets=models(icomp)%nPETs
3409 IF (npets.eq.petcount) THEN
3410 WRITE (out,150) npets, 'Nthreads(atmos)', &
3411 & 'Assigned number of PETs for '// &
3412 & trim(models(icomp)%name)//'.'
3413 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3414 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3415 IF (npets.gt.1) THEN
3416 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3417 & trim(adjustl(pend))
3418 ELSE
3419 WRITE (out,290) trim(adjustl(pstr))
3420 END IF
3421 ELSE
3422 WRITE (out,230) 'Nthreads(atmos)', npets, petcount
3423 rc=esmf_rc_val_wrong
3424 exit_flag=7
3425 RETURN
3426 END IF
3427 END IF
3428 IF (models(iseaice)%IsActive) THEN
3429 icomp=iseaice
3430 npets=models(icomp)%nPETs
3431 IF (npets.eq.petcount) THEN
3432 WRITE (out,150) npets, 'Nthreads(seaice)', &
3433 & 'Assigned number of PETs for '// &
3434 & trim(models(icomp)%name)//'.'
3435 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3436 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3437 IF (npets.gt.1) THEN
3438 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3439 & trim(adjustl(pend))
3440 ELSE
3441 WRITE (out,290) trim(adjustl(pstr))
3442 END IF
3443 ELSE
3444 WRITE (out,230) 'Nthreads(seaice)', npets, petcount
3445 rc=esmf_rc_val_wrong
3446 exit_flag=7
3447 RETURN
3448 END IF
3449 END IF
3450 IF (models(iwave)%IsActive) THEN
3451 icomp=iwave
3452 npets=models(iwave)%nPETs
3453 IF (npets.eq.petcount) THEN
3454 WRITE (out,150) npets, 'Nthreads(waves)', &
3455 & 'Assigned number of PETs for '// &
3456 & trim(models(icomp)%name)//'.'
3457 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3458 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3459 IF (npets.gt.1) THEN
3460 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3461 & trim(adjustl(pend))
3462 ELSE
3463 WRITE (out,290) trim(adjustl(pstr))
3464 END IF
3465 ELSE
3466 WRITE (out,230) 'Nthreads(waves)', npets, petcount
3467 rc=esmf_rc_val_wrong
3468 exit_flag=7
3469 RETURN
3470 END IF
3471 END IF
3472 IF (models(idata)%IsActive) THEN
3473 icomp=idata
3474 npets=models(icomp)%nPETs
3475 IF (npets.eq.petcount) THEN
3476 WRITE (out,150) npets, 'Nthreads(data)', &
3477 & 'Assigned number of PETs for '// &
3478 & trim(models(icomp)%name)// &
3479 & ', ItileD * JtileD.'
3480 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3481 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3482 IF (npets.gt.1) THEN
3483 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3484 & trim(adjustl(pend))
3485 ELSE
3486 WRITE (out,290) trim(adjustl(pstr))
3487 END IF
3488 ELSE
3489 WRITE (out,230) 'ItileD * JtileD', npets, petcount
3490 rc=esmf_rc_val_wrong
3491 exit_flag=7
3492 RETURN
3493 END IF
3494 END IF
3495 CASE ('CONCURRENT')
3496 IF (sumpets.eq.petcount) THEN
3497 IF (models(iroms)%IsActive) THEN
3498 icomp=iroms
3499 npets=models(icomp)%nPETs
3500 WRITE (out,150) npets, 'Nthreads(roms)', &
3501 & 'Assigned number of PETs for '// &
3502 & trim(models(icomp)%name)//'.'
3503 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3504 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3505 IF (npets.gt.1) THEN
3506 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3507 & trim(adjustl(pend))
3508 ELSE
3509 WRITE (out,290) trim(adjustl(pstr))
3510 END IF
3511 END IF
3512 IF (models(idata)%IsActive) THEN
3513 icomp=idata
3514 npets=models(icomp)%nPETs
3515 WRITE (out,150) npets, 'Nthreads(data)', &
3516 & 'Assigned number of PETs for '// &
3517 & trim(models(icomp)%name)// &
3518 & ', ItileD * JtileD.'
3519 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3520 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3521 IF (npets.gt.1) THEN
3522 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3523 & trim(adjustl(pend))
3524 ELSE
3525 WRITE (out,290) trim(adjustl(pstr))
3526 END IF
3527 END IF
3528 IF (models(iatmos)%IsActive) THEN
3529 icomp=iatmos
3530 npets=models(icomp)%nPETs
3531 WRITE (out,150) npets, 'Nthreads(atmos)', &
3532 & 'Assigned number of PETs for '// &
3533 & trim(models(icomp)%name)//'.'
3534 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3535 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3536 IF (npets.gt.1) THEN
3537 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3538 & trim(adjustl(pend))
3539 ELSE
3540 WRITE (out,290) trim(adjustl(pstr))
3541 END IF
3542 END IF
3543 IF (models(iseaice)%IsActive) THEN
3544 icomp=iseaice
3545 npets=models(icomp)%nPETs
3546 WRITE (out,150) npets, 'Nthreads(seaice)', &
3547 & 'Assigned number of PETs for '// &
3548 & trim(models(icomp)%name)//'.'
3549 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3550 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3551 IF (npets.gt.1) THEN
3552 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3553 & trim(adjustl(pend))
3554 ELSE
3555 WRITE (out,290) trim(adjustl(pstr))
3556 END IF
3557 END IF
3558 IF (models(iwave)%IsActive) THEN
3559 icomp=iwave
3560 npets=models(icomp)%nPETs
3561 WRITE (out,150) npets, 'Nthreads(waves)', &
3562 & 'Assigned number of PETs for '// &
3563 & trim(models(icomp)%name)//'.'
3564 WRITE (pstr,'(i5)') models(icomp)%PETlist(1)
3565 WRITE (pend,'(i5)') models(icomp)%PETlist(npets)
3566 IF (npets.gt.1) THEN
3567 WRITE (out,290) trim(adjustl(pstr))//' to '// &
3568 & trim(adjustl(pend))
3569 ELSE
3570 WRITE (out,290) trim(adjustl(pstr))
3571 END IF
3572 END IF
3573 ELSE
3574 WRITE (out,240) sumpets, petcount
3575 rc=esmf_rc_val_wrong
3576 exit_flag=7
3577 RETURN
3578 END IF
3579 END SELECT
3580 ELSE ! ROMS standalone
3581 IF (models(iroms)%IsActive) THEN
3582 npets=models(iroms)%nPETs
3583 IF (npets.eq.petcount) THEN
3584 WRITE (out,150) npets, 'Nthreads(roms)', &
3585 & 'Assigned number of PETs for ROMS.'
3586 ELSE
3587 WRITE (out,220) 'Nthreads(roms)', ng, npets, petcount
3588 rc=esmf_rc_val_wrong
3589 exit_flag=7
3590 RETURN
3591 END IF
3592 END IF
3593 END IF
3594!
3595 SELECT CASE (trim(datecalendar))
3596 CASE ('gregorian')
3597 WRITE (out,170) ' gregorian', 'Calendar', &
3598 & 'ESM components date calendar.'
3599 CASE ('year_360_day')
3600 WRITE (out,170) 'year_360_day', 'Calendar', &
3601 & 'ESM components date calendar.'
3602 CASE DEFAULT
3603 WRITE (out,250) 'Calendar', trim(datecalendar)
3604 rc=esmf_rc_val_wrong
3605 exit_flag=7
3606 RETURN
3607 END SELECT
3608!
3609 WRITE (out,160) (referencedate(i), i=1,6), 'ReferenceTime', &
3610 & 'Coupling driver reference time.'
3611 WRITE (out,160) (startdate(i), i=1,6), 'StartTime', &
3612 & 'Simulation start time.'
3613 WRITE (out,160) (restartdate(i), i=1,6), 'RestartTime', &
3614 & 'Simulation re-start time.'
3615 WRITE (out,160) (stopdate(i), i=1,6), 'StopTime', &
3616 & 'Simulation stop time.'
3617 IF (models(iatmos )%IsActive.or. &
3618 & models(idata )%IsActive.or. &
3619 & models(iseaice)%IsActive.or. &
3620 & models(iwave )%IsActive) THEN
3621 WRITE (out,160) (timestep(i), i=1,6), 'TimeStep', &
3622 & 'Driver coupling time interval.'
3623 ELSE
3624 WRITE (out,160) (timestep(i), i=1,6), 'TimeStep', &
3625 & 'Simulation elapsed time interval.'
3626 END IF
3627!
3628 DO j=1,nmodels
3629 IF (models(j)%IsActive) THEN
3630 IF (j.eq.idata) THEN
3631 ngrd=1 ! DATA has no nested grids
3632 ELSE
3633 ngrd=SIZE(coupled(j)%LinkedGrid,dim=1)
3634 END IF
3635 DO i=1,nmodels
3636 DO ng=1,ngrd
3637 IF (coupled(j)%LinkedGrid(ng,i).and.(i.ne.j)) THEN
3638 timefrac=models(j)%TimeFrac(ng,i)
3639 string='TimeFrac('// &
3640 & trim(clabel(i))//'2'// &
3641 & trim(clabel(j))//')'
3642 IF (timefrac.gt.0) THEN
3643 WRITE (out,180) timefrac, trim(string), &
3644 & 'Coupling TimeStep fraction for '// &
3645 & trim(models(i)%name)//' -> '// &
3646 & trim(models(j)%name)//', grid: ', ng
3647 ELSE
3648 WRITE (out,210) trim(string), timefrac
3649 rc=esmf_rc_val_wrong
3650 exit_flag=7
3651 RETURN
3652 END IF
3653 END IF
3654 END DO
3655 END DO
3656 END IF
3657 END DO
3658!
3659 WRITE (out,120) extrapnumlevels, 'extrapNumLevels', &
3660 & 'Number of levels for creep fill extrapolation.'
3661
3662# ifdef DATA_COUPLING
3663!
3664 IF (models(iatmos)%IsActive.and. &
3665 & models(idata )%IsActive) THEN
3666 WRITE (out,310) 1, 'WeightsFile(atmos)', &
3667 & trim(models(iatmos)%name)// &
3668 & ' component melding weights coefficients NetCDF file:', &
3669 & trim(weights(iatmos)%ncfile)
3670 WRITE (out,320) trim(weights(iatmos)%VnameDATA), &
3671 & 'VnameDATA(atmos)', &
3672 & 'DATA component weights NetCDF variable name.'
3673 WRITE (out,320) trim(weights(iatmos)%VnameESM), &
3674 & 'VnameESM(atmos)', &
3675 & 'ESM component weights NetCDF variable name.'
3676 WRITE (out,190) weights(iatmos)%NestedGrid, &
3677 & 'NestedGrid(atmos)', &
3678 & 'Grid needing merged fields from DATA-ESM components.'
3679 END IF
3680# endif
3681!
3682 IF ((0.le.debuglevel).and.(debuglevel.le.4)) THEN
3683 WRITE (out,190) debuglevel, 'DebugLevel', &
3684 & 'Coupling debugging level flag.'
3685 ELSE
3686 WRITE (out,210) 'DebugLevel', debuglevel
3687 rc=esmf_rc_val_wrong
3688 exit_flag=7
3689 RETURN
3690 END IF
3691!
3692 WRITE (out,190) tracelevel, 'traceLevel', &
3693 & 'Execution tracing level flag.'
3694!
3695 DO j=1,nmodels
3696 IF (models(j)%IsActive.and.(j.ne.idata)) THEN
3697 string=lowercase(cmodel(j))
3698 WRITE (out,195) nimport(j), &
3699 & 'Nimport('//trim(string)//')', &
3700 & 'Number of '//trim(models(j)%name)// &
3701 & ' component import fields:'
3702 DO i=1,nimport(j)
3703 WRITE (out,200) i, &
3704 & trim(models(j)%ImportField(i)%short_name)
3705 END DO
3706 WRITE (out,195) nexport(j), &
3707 & 'Nexport('//trim(string)//')', &
3708 & 'Number of '//trim(models(j)%name)// &
3709 & ' component export fields:'
3710 DO i=1,nexport(j)
3711 WRITE (out,200) i, &
3712 & trim(models(j)%ExportField(i)%short_name)
3713 END DO
3714!
3715 IF ((nimport(j)+nexport(j)).lt.1) THEN
3716 WRITE (out,260) 'ERROR: The '//trim(models(j)%name)// &
3717 & ' component is not importing or exporting fields.', &
3718 & 'Revise '''//trim(cinpname)//''' script for '// &
3719 & 'Nimport('//trim(string)//') or '// &
3720 & 'Nexport('//trim(string)//').'
3721 rc=esmf_rc_val_wrong
3722 exit_flag=7
3723 RETURN
3724 END IF
3725 END IF
3726 END DO
3727!
3728 DO j=1,nmodels
3729 string=lowercase(cmodel(j))
3730 IF (j.ne.idata) THEN
3731 IF (models(idata)%IsActive.and. &
3732 & models(j)%IsActive.and.(dataset(j)%Nfields.gt.0)) THEN
3733 WRITE (out,270) dataset(j)%Nfields, &
3734 & 'nDataExport('//trim(string)//')', &
3735 & 'Number of export DATA model fields to '//&
3736 & trim(models(j)%name)//' component:'
3737 DO i=1,dataset(j)%Nfields
3738 WRITE (out,200) i, trim(dataset(j)%Field(i))
3739 END DO
3740 WRITE (out,270) dataset(j)%Nfiles, &
3741 & 'nDataFiles('//trim(string)//')', &
3742 & 'Number of source DATA model files for '//&
3743 & trim(models(j)%name)//' component:'
3744 keyword='DataFiles('//trim(string)//')'
3745 DO i=1,dataset(j)%Nfiles
3746 DO ifile=1,dataset(j)%IFS(i)%Nfiles
3747 fname=dataset(j)%IFS(i)%files(ifile)
3748 IF (find_file(ng, out, fname, trim(keyword))) THEN
3749 IF (ifile.eq.1) THEN
3750 WRITE (out,280) i, ': ', trim(fname)
3751 ELSE
3752 WRITE (out,'(t42,6x,a)') trim(fname)
3753 END IF
3754 ELSE
3755 rc=esmf_rc_not_found
3756 exit_flag=4
3757 WRITE (out,300) trim(models(j)%name), ng, &
3758 & trim(fname)
3759 END IF
3760 END DO
3761 END DO
3762 END IF
3763 END IF
3764 END DO
3765!
3766 WRITE (out,340) 'Coupled Import and Export States Name Sets:'
3767 DO i=1,nmodels
3768 IF (models(i)%IsActive) THEN
3769 IF (i.eq.idata) THEN
3770 ngrd=nstates
3771 ELSE
3772 ngrd=models(i)%Ngrids
3773 END IF
3774 DO ng=1,ngrd
3775 is=1
3776 ie=1
3777 string=' '
3778 DO j=1,nmodels
3779 IF (models(j)%IsActive.and.(j.ne.i)) THEN
3780 IF (i.eq.idata) THEN
3781 ig=1 ! single grid, no nesting
3782 IF (coupled(j)%LinkedGrid(ig,i)) THEN
3783 ie=is+len_trim(models(j)%name)
3784 string(is:ie)=trim(models(j)%name)
3785 is=ie+2
3786 END IF
3787 ELSE
3788 ig=ng
3789 IF (coupled(i)%LinkedGrid(ng,j)) THEN
3790 ie=is+len_trim(models(j)%name)
3791 string(is:ie)=trim(models(j)%name)
3792 is=ie+2
3793 END IF
3794 END IF
3795 END IF
3796 END DO
3797 WRITE (out,350) trim(models(i)%name), ig, &
3798 & trim(coupled(i)%SetLabel(ng)), &
3799 & trim(coupled(i)%ImpLabel(ng)), &
3800 & trim(coupled(i)%ExpLabel(ng)), &
3801 & trim(string)
3802 END DO
3803 END IF
3804 END DO
3805!
3806 END IF
3807!
3808! Flush standard output buffer.
3809!
3810 FLUSH (out)
3811!
3812 70 FORMAT (80('-'),/, &
3813 & ' Earth System Models Coupling: ESMF/NUOPC Library,', &
3814 & ' Version ',a,/,31x,a,/, &
3815 & 80('-'), &
3816 & /,1x,'Repository Root : ',a, &
3817 & /,1x,'Operating System : ',a, &
3818 & /,1x,'CPU Hardware : ',a, &
3819 & /,1x,'Compiler System : ',a, &
3820 & /,1x,'Compiler Command : ',a, &
3821 & /,1x,'Compiler Flags : ',a, &
3822 & /,1x,'MPI Communicator : ',i0,2x,'PET size = ',i0, &
3823 & /,80('-'),/)
3824 80 FORMAT (1x,a,a)
3825 90 FORMAT (18x,l1,2x,a,t42,a,i2.2,'.')
3826 100 FORMAT (18x,l1,2x,a,t42,a)
3827 110 FORMAT (18x,l1,2x,a,t42,'Connector ',a,' -> ',a, &
3828 & ' is activated, grid: ',i2.2,'.')
3829 120 FORMAT (9x,i10,2x,a,t42,a)
3830 130 FORMAT (9x,a,2x,a,t42,a)
3831 150 FORMAT (15x,i4,2x,a,t42,a)
3832 160 FORMAT (i4.4,'-',i2.2,'-',i2.2,1x,i2.2,':',i2.2,':',i2.2,2x, &
3833 & a,t42,a)
3834 170 FORMAT (7x,a,2x,a,t42,a)
3835 180 FORMAT (18x,i1,2x,a,t42,a,i2.2,'.')
3836 190 FORMAT (18x,i1,2x,a,t42,a,i2.2)
3837 195 FORMAT (17x,i2,2x,a,t42,a,i2.2)
3838 200 FORMAT (t42,2x,i2.2,':',1x,a)
3839 210 FORMAT (/,' read_ESMconfig - Invalid input parameter, ',a, &
3840 & ': ',i1)
3841 220 FORMAT (/,' read_ESMconfig - Illegal input parameter, ',a, &
3842 & ' for grid ',i2.2,': ',2i4)
3843 230 FORMAT (/,' read_ESMconfig - Illegal input parameter, ',a, &
3844 & ': ',2i4)
3845 240 FORMAT (/,' read_ESMconfig - Inconsistent number of PETs for', &
3846 & ' concurrent execution:',/,18x,'sumPETs = ',i4,2x, &
3847 & ' PETcount = ',i4)
3848 250 FORMAT (/,' read_ESMconfig - Invalid input parameter, ',a, &
3849 & ': ',a)
3850 260 FORMAT (/,21x,a,/,21x,a)
3851 270 FORMAT (18x,i1,2x,a,t42,a,i2.2,'.')
3852 280 FORMAT (t42,2x,i2.2,a,a)
3853 290 FORMAT (t44,'Coupling Driver PETs: ',a)
3854 300 FORMAT (/,' read_ESMconfig - ',a,' Grid ',i2.2, &
3855 & ', could not find input file:',/,18x,a)
3856 310 FORMAT (17x,i2,2x,a,t42,a,/,t44,a)
3857 320 FORMAT (a19,t22,a,t42,a)
3858 330 FORMAT (6x,1p,e13.6,2x,a,t42,a)
3859 340 FORMAT (/,a,/, 42('='),/,/, 'Component', t13,'Grid', &
3860 & t20,'CoupledSet', t33,'ImportState', t50,'ExportState', &
3861 & t67,'ConnectedTo',/, 114('-'))
3862 350 FORMAT (a,t14,i0,t20,a,t33,a,t50,a,t67,a)
3863!
3864 RETURN
3865 END SUBROUTINE read_esmconfig
3866!
3867 SUBROUTINE report_timestamp (field, CurrTime, localPET, string, &
3868 & rc)
3869!
3870!=======================================================================
3871! !
3872! Reports coupling time-stamp. !
3873! !
3874!=======================================================================
3875!
3876! Imported variable declarations.
3877!
3878 integer, intent(in) :: localpet
3879 integer, intent(out) :: rc
3880!
3881 character (len=*), intent(in) :: string
3882!
3883 TYPE (esmf_field), intent(in) :: field
3884 TYPE (esmf_time), intent(in) :: currtime
3885!
3886! Local variable declarations.
3887!
3888 logical :: isvalid
3889 integer :: vtime1(10), vtime2(10)
3890!
3891 TYPE (esmf_time) :: fieldtime
3892!
3893 character (len=*), parameter :: myfile = &
3894 & __FILE__//", report_timestamp"
3895
3896 character (len=22) :: str1, str2
3897!
3898!-----------------------------------------------------------------------
3899! Initialize return code flag to success state (no error).
3900!-----------------------------------------------------------------------
3901!
3902 rc=esmf_success
3903!
3904!-----------------------------------------------------------------------
3905! Get driver current time.
3906!-----------------------------------------------------------------------
3907!
3908 CALL esmf_timeget (currtime, &
3909 & yy=vtime1(1), &
3910 & mm=vtime1(2), &
3911 & dd=vtime1(3), &
3912 & h =vtime1(4), &
3913 & m =vtime1(5), &
3914 & s =vtime1(6), &
3915 & rc=rc)
3916 IF (esmf_logfounderror(rctocheck=rc, &
3917 & msg=esmf_logerr_passthru, &
3918 & line=__line__, &
3919 & file=myfile)) THEN
3920 RETURN
3921 END IF
3922!
3923 WRITE (str1,10) vtime1(1), vtime1(2), vtime1(3), &
3924 & vtime1(4), vtime1(5), vtime1(6)
3925!
3926!-----------------------------------------------------------------------
3927! Get field TimeStamp.
3928!-----------------------------------------------------------------------
3929!
3930 CALL nuopc_gettimestamp (field, &
3931 & isvalid = isvalid, &
3932 & time = fieldtime, &
3933 & rc = rc)
3934 IF (esmf_logfounderror(rctocheck=rc, &
3935 & msg=esmf_logerr_passthru, &
3936 & line=__line__, &
3937 & file=myfile)) THEN
3938 RETURN
3939 END IF
3940!
3941 IF (isvalid) THEN
3942 CALL esmf_timeget (fieldtime, &
3943 & yy=vtime2(1), &
3944 & mm=vtime2(2), &
3945 & dd=vtime2(3), &
3946 & h =vtime2(4), &
3947 & m =vtime2(5), &
3948 & s =vtime2(6), &
3949 & rc=rc)
3950 IF (esmf_logfounderror(rctocheck=rc, &
3951 & msg=esmf_logerr_passthru, &
3952 & line=__line__, &
3953 & file=myfile)) THEN
3954 RETURN
3955 END IF
3956!
3957 WRITE (str2,10) vtime2(1), vtime2(2), vtime2(3), &
3958 & vtime2(4), vtime2(5), vtime2(6)
3959 END IF
3960!
3961!-----------------------------------------------------------------------
3962! Report TimeStamp.
3963!-----------------------------------------------------------------------
3964!
3965 IF (isvalid) THEN
3966 IF (trim(str1).ne.trim(str2)) THEN
3967 IF (localpet.eq.0) THEN
3968 WRITE (cplout,20) trim(string), ': TimeStamp = ', &
3969 & trim(str2), ' not equal ' , &
3970 & trim(str1)
3971 END IF
3972 rc=esmf_rc_val_wrong
3973 RETURN
3974 ELSE
3975 IF (localpet.eq.0) THEN
3976!! WRITE (cplout,30) TRIM(string), ': TimeStamp = ', TRIM(str2)
3977 END IF
3978 END IF
3979 ELSE
3980 IF (localpet.eq.0) THEN
3981 WRITE (cplout,30) trim(string), ': TimeStamp is not valid', &
3982 & ', DriverTime = '//trim(str1)
3983 END IF
3984 END IF
3985!
3986 10 FORMAT (i4.4,2('-',i2.2),1x,i2.2,':',i2.2,':',i2.2)
3987 20 FORMAT (/,1x,a,a,a,a,a)
3988 30 FORMAT (1x,a,a,a)
3989!
3990 RETURN
3991 END SUBROUTINE report_timestamp
3992!
3993 SUBROUTINE set_metadata (vm, rc)
3994!
3995!=======================================================================
3996! !
3997! Process ESM coupling import and export fields metadata. It Adds !
3998! fields to the NUOPC dictionary. !
3999! !
4000!=======================================================================
4001!
4002 USE mod_scalars, ONLY : noerror, exit_flag
4003 USE get_metadata_mod, ONLY : couplingfield, &
4004 & coupling_metadata, &
4005 & metadata_has
4006 USE strings_mod, ONLY : founderror, assign_string, uppercase
4007!
4008! Imported variable declarations.
4009!
4010 integer, intent(out) :: rc
4011!
4012 TYPE (esmf_vm) :: vm
4013!
4014! Local variable declarations.
4015!
4016 TYPE (couplingfield), allocatable :: s(:)
4017!
4018 logical :: exist, lreport, connected
4019!
4020 integer :: i, id, io_err, j, lvar, varid
4021 integer :: localpet, petcount
4022 integer :: etype, gtype, itype
4023!
4024 integer, parameter :: inp = 10
4025!
4026 real(r8) :: add_offset, scale
4027!
4028 character (len=:), allocatable :: smodel
4029
4030 character (len=100) :: sname, units, val
4031 character (len=100) :: shortname, line
4032 character (len=256) :: io_errmsg
4033!
4034 character (len=*), parameter :: myfile = &
4035 & __FILE__//", set_metadata"
4036!
4037!-----------------------------------------------------------------------
4038! Initialize return code flag to success state (no error).
4039!-----------------------------------------------------------------------
4040!
4041 rc=esmf_success
4042!
4043!-----------------------------------------------------------------------
4044! Query gridded component.
4045!-----------------------------------------------------------------------
4046!
4047 CALL esmf_vmget (vm, &
4048 & localpet=localpet, &
4049 & petcount=petcount, &
4050 & rc=rc)
4051 IF (esmf_logfounderror(rctocheck=rc, &
4052 & msg=esmf_logerr_passthru, &
4053 & line=__line__, &
4054 & file=myfile)) THEN
4055 RETURN
4056 END IF
4057!
4058!-----------------------------------------------------------------------
4059! Get ESM coupling export/import variable metadata.
4060!-----------------------------------------------------------------------
4061!
4062! The metadata structure can be read either a YAML file (extention
4063! .yaml) or deprecated ASCII file (extension .dat).
4064!
4065 CALL coupling_metadata (trim(cplname), s)
4066!
4067!-----------------------------------------------------------------------
4068! Search IMPORT fields in metadata dictionary and load information.
4069!-----------------------------------------------------------------------
4070!
4071 DO i=1,nmodels
4072 IF (models(i)%IsActive) THEN
4073 DO j=1,nimport(i)
4074 shortname=models(i)%ImportField(j)%short_name
4075 id=metadata_has(s, trim(shortname))
4076 IF (id.gt.0) THEN
4077 models(i)%ImportField(j)%connected = s(id)%connected
4078 models(i)%ImportField(j)%debug_write = s(id)%debug_write
4079 models(i)%ImportField(j)%add_offset = s(id)%add_offset
4080 models(i)%ImportField(j)%scale_factor = s(id)%scale
4081!
4082! field short name keyword
4083 IF (founderror(assign_string( &
4084 & models(i)%ImportField(j)%short_name, &
4085 & s(id)%short_name), &
4086 & noerror, __line__, myfile)) THEN
4087 rc=esmf_rc_copy_fail
4088 RETURN
4089 END IF
4090! field standard name
4091 IF (founderror(assign_string( &
4092 & models(i)%ImportField(j)%standard_name, &
4093 & s(id)%standard_name), &
4094 & noerror, __line__, myfile)) THEN
4095 rc=esmf_rc_copy_fail
4096 RETURN
4097 END IF
4098! field descriptive long name
4099 IF (founderror(assign_string( &
4100 & models(i)%ImportField(j)%long_name, &
4101 & s(id)%long_name), &
4102 & noerror, __line__, myfile)) THEN
4103 rc=esmf_rc_copy_fail
4104 RETURN
4105 END IF
4106! destination field grid-cell type
4107 IF (founderror(assign_string( &
4108 & models(i)%ImportField(j)%dst_gtype, &
4109 & s(id)%destination_grid), &
4110 & noerror, __line__, myfile)) THEN
4111 rc=esmf_rc_copy_fail
4112 RETURN
4113 END IF
4114! destination field units
4115 IF (founderror(assign_string( &
4116 & models(i)%ImportField(j)%dst_units, &
4117 & s(id)%destination_units), &
4118 & noerror, __line__, myfile)) THEN
4119 rc=esmf_rc_copy_fail
4120 RETURN
4121 END IF
4122! source field grid-cell type
4123 IF (founderror(assign_string( &
4124 & models(i)%ImportField(j)%src_gtype, &
4125 & s(id)%source_grid), &
4126 & noerror, __line__, myfile)) THEN
4127 rc=esmf_rc_copy_fail
4128 RETURN
4129 END IF
4130! source field units
4131 IF (founderror(assign_string( &
4132 & models(i)%ImportField(j)%src_units, &
4133 & s(id)%source_units), &
4134 & noerror, __line__, myfile)) THEN
4135 rc=esmf_rc_copy_fail
4136 RETURN
4137 END IF
4138! DATA NetCDF variable name
4139 IF (founderror(assign_string( &
4140 & models(i)%ImportField(j)%nc_vname, &
4141 & s(id)%data_netcdf_vname), &
4142 & noerror, __line__, myfile)) THEN
4143 rc=esmf_rc_copy_fail
4144 RETURN
4145 END IF
4146! DATA NetCDF time variable name
4147 IF (founderror(assign_string( &
4148 & models(i)%ImportField(j)%nc_tname, &
4149 & s(id)%data_netcdf_tname), &
4150 & noerror, __line__, myfile)) THEN
4151 rc=esmf_rc_copy_fail
4152 RETURN
4153 END IF
4154! field reggriding method
4155 IF (founderror(assign_string( &
4156 & models(i)%ImportField(j)%RegridMethod, &
4157 & s(id)%regrid_method), &
4158 & noerror, __line__, myfile)) THEN
4159 rc=esmf_rc_copy_fail
4160 RETURN
4161 END IF
4162! unmapped extrapolation method
4163 IF (founderror(assign_string( &
4164 & models(i)%ImportField(j)%ExtrapMethod, &
4165 & s(id)%extrapolate_method), &
4166 & noerror, __line__, myfile)) THEN
4167 rc=esmf_rc_copy_fail
4168 RETURN
4169 END IF
4170! source model (used for reporting)
4171 IF (founderror(assign_string(smodel, &
4172 & s(id)%connected_to), &
4173 & noerror, __line__, myfile)) THEN
4174 rc=esmf_rc_copy_fail
4175 RETURN
4176 END IF
4177!
4178 val=uppercase(trim(models(i)%ImportField(j)%src_gtype))
4179 SELECT CASE (trim(val))
4180 CASE ('CENTER_CELL', 'CELL_CENTER', 'CENTER')
4181 gtype=icenter
4182 CASE ('CORNER_CELL', 'CELL_CORNER', 'CORNER')
4183 gtype=icorner
4184 CASE ('U','LEFT_RIGHT_EDGE', 'RIGHT_LEFT_EDGE')
4185 gtype=iupoint
4186 CASE ('V','LOWER_UPPER_EDGE', 'UPPER_LOWER_EDGE')
4187 gtype=ivpoint
4188 CASE DEFAULT
4189 gtype=icenter
4190 END SELECT
4191 models(i)%ImportField(j)%gtype=gtype
4192!
4193 val=uppercase(trim(models(i)%ImportField(j)%RegridMethod))
4194 SELECT CASE (trim(val))
4195 CASE ('BILINEAR')
4196 itype=ibilin
4197 CASE ('PATCH')
4198 itype=ipatch
4199 CASE ('CONSERVATIVE1')
4200 itype=iconsv1
4201 CASE ('CONSERVATIVE2')
4202 itype=iconsv2
4203 CASE ('NEAREST')
4204 itype=instod
4205 CASE DEFAULT
4206 itype=ibilin
4207 END SELECT
4208 models(i)%ImportField(j)%itype=itype
4209!
4210 val=uppercase(trim(models(i)%ImportField(j)%ExtrapMethod))
4211 SELECT CASE (trim(val))
4212 CASE ('NONE')
4213 etype=enone
4214 CASE ('NEAREST')
4215 etype=exstod
4216 CASE ('IDAVG')
4217 etype=eidavg
4218 CASE ('CREEP')
4219 etype=ecreep
4220 CASE ('2STEPS')
4221 etype=e2steps
4222 CASE DEFAULT
4223 etype=enone
4224 END SELECT
4225 models(i)%ImportField(j)%etype=etype
4226 ELSE
4227 IF (localpet.eq.0) THEN
4228 WRITE (cplout,30) 'import field short_name: ', &
4229 & trim(shortname), trim(cplname)
4230 END IF
4231 rc=esmf_rc_not_found
4232 IF (esmf_logfounderror(rctocheck=rc, &
4233 & msg=esmf_logerr_passthru, &
4234 & line=__line__, &
4235 & file=myfile)) RETURN
4236 END IF
4237 END DO
4238 END IF
4239 END DO
4240!
4241!-----------------------------------------------------------------------
4242! Search EXPORT fields in metadata dictionary and load information.
4243!-----------------------------------------------------------------------
4244!
4245! Notice that all export fields are kept in their original form.
4246! The imported component does the proper scaling, physical units
4247! conversion, and other manipulations. It is done to avoid applying
4248! such transformations twice.
4249!
4250 DO i=1,nmodels
4251 IF (models(i)%IsActive) THEN
4252 DO j=1,nexport(i)
4253 shortname=models(i)%ExportField(j)%short_name
4254 id=metadata_has(s, trim(shortname))
4255 IF (id.gt.0) THEN
4256 models(i)%ExportField(j)%connected = s(id)%connected
4257 models(i)%ExportField(j)%debug_write = s(id)%debug_write
4258 models(i)%ExportField(j)%add_offset = 0.0_r8
4259 models(i)%ExportField(j)%scale_factor = 1.0_r8 !no scaling
4260!
4261! field short name keyword
4262 IF (founderror(assign_string( &
4263 & models(i)%ExportField(j)%short_name, &
4264 & s(id)%short_name), &
4265 & noerror, __line__, myfile)) THEN
4266 rc=esmf_rc_copy_fail
4267 RETURN
4268 END IF
4269! field standard name
4270 IF (founderror(assign_string( &
4271 & models(i)%ExportField(j)%standard_name, &
4272 & s(id)%standard_name), &
4273 & noerror, __line__, myfile)) THEN
4274 rc=esmf_rc_copy_fail
4275 RETURN
4276 END IF
4277! field descriptive long name
4278 IF (founderror(assign_string( &
4279 & models(i)%ExportField(j)%long_name, &
4280 & s(id)%long_name), &
4281 & noerror, __line__, myfile)) THEN
4282 rc=esmf_rc_copy_fail
4283 RETURN
4284 END IF
4285! destination field grid-cell type
4286 IF (founderror(assign_string( &
4287 & models(i)%ExportField(j)%dst_gtype, &
4288 & s(id)%destination_grid), &
4289 & noerror, __line__, myfile)) THEN
4290 rc=esmf_rc_copy_fail
4291 RETURN
4292 END IF
4293! destination field units
4294 IF (founderror(assign_string( &
4295 & models(i)%ExportField(j)%dst_units, &
4296 & s(id)%destination_units), &
4297 & noerror, __line__, myfile)) THEN
4298 rc=esmf_rc_copy_fail
4299 RETURN
4300 END IF
4301! source field grid-cell type
4302 IF (founderror(assign_string( &
4303 & models(i)%ExportField(j)%src_gtype, &
4304 & s(id)%source_grid), &
4305 & noerror, __line__, myfile)) THEN
4306 rc=esmf_rc_copy_fail
4307 RETURN
4308 END IF
4309! source field units
4310 IF (founderror(assign_string( &
4311 & models(i)%ExportField(j)%src_units, &
4312 & s(id)%source_units), &
4313 & noerror, __line__, myfile)) THEN
4314 rc=esmf_rc_copy_fail
4315 RETURN
4316 END IF
4317! DATA NetCDF variable name
4318 IF (founderror(assign_string( &
4319 & models(i)%ExportField(j)%nc_vname, &
4320 & s(id)%data_netcdf_vname), &
4321 & noerror, __line__, myfile)) THEN
4322 rc=esmf_rc_copy_fail
4323 RETURN
4324 END IF
4325! DATA NetCDF time variable name
4326 IF (founderror(assign_string( &
4327 & models(i)%ExportField(j)%nc_tname, &
4328 & s(id)%data_netcdf_tname), &
4329 & noerror, __line__, myfile)) THEN
4330 rc=esmf_rc_copy_fail
4331 RETURN
4332 END IF
4333! field reggriding method
4334 IF (founderror(assign_string( &
4335 & models(i)%ExportField(j)%RegridMethod, &
4336 & s(id)%regrid_method), &
4337 & noerror, __line__, myfile)) THEN
4338 rc=esmf_rc_copy_fail
4339 RETURN
4340 END IF
4341! unmapped extrapolation method
4342 IF (founderror(assign_string( &
4343 & models(i)%ExportField(j)%ExtrapMethod, &
4344 & s(id)%extrapolate_method), &
4345 & noerror, __line__, myfile)) THEN
4346 rc=esmf_rc_copy_fail
4347 RETURN
4348 END IF
4349! source model (used for reporting)
4350 IF (founderror(assign_string(smodel, &
4351 & s(id)%connected_to), &
4352 & noerror, __line__, myfile)) THEN
4353 rc=esmf_rc_copy_fail
4354 RETURN
4355 END IF
4356!
4357 val=uppercase(trim(models(i)%ExportField(j)%src_gtype))
4358 SELECT CASE (trim(val))
4359 CASE ('CENTER_CELL', 'CELL_CENTER', 'CENTER')
4360 gtype=icenter
4361 CASE ('CORNER_CELL', 'CELL_CORNER', 'CORNER')
4362 gtype=icorner
4363 CASE ('U','LEFT_RIGHT_EDGE', 'RIGHT_LEFT_EDGE')
4364 gtype=iupoint
4365 CASE ('V','LOWER_UPPER_EDGE', 'UPPER_LOWER_EDGE')
4366 gtype=ivpoint
4367 CASE DEFAULT
4368 gtype=icenter
4369 END SELECT
4370 models(i)%ExportField(j)%gtype=gtype
4371!
4372 val=uppercase(trim(models(i)%ExportField(j)%RegridMethod))
4373 SELECT CASE (trim(val))
4374 CASE ('BILINEAR')
4375 itype=ibilin
4376 CASE ('PATCH')
4377 itype=ipatch
4378 CASE ('CONSERVATIVE1')
4379 itype=iconsv1
4380 CASE ('CONSERVATIVE2')
4381 itype=iconsv2
4382 CASE ('NEAREST')
4383 itype=instod
4384 CASE DEFAULT
4385 itype=ibilin
4386 END SELECT
4387 models(i)%ExportField(j)%itype=itype
4388!
4389 val=uppercase(trim(models(i)%ExportField(j)%ExtrapMethod))
4390 SELECT CASE (trim(val))
4391 CASE ('NONE')
4392 etype=enone
4393 CASE ('NEAREST')
4394 etype=exstod
4395 CASE ('IDAVG')
4396 etype=eidavg
4397 CASE ('CREEP')
4398 etype=ecreep
4399 CASE ('2STEPS')
4400 etype=e2steps
4401 CASE DEFAULT
4402 etype=enone
4403 END SELECT
4404 models(i)%ExportField(j)%etype=etype
4405 ELSE
4406 IF (localpet.eq.0) THEN
4407 WRITE (cplout,30) 'export field short_name: ', &
4408 & trim(shortname), trim(cplname)
4409 END IF
4410 rc=esmf_rc_not_found
4411 IF (esmf_logfounderror(rctocheck=rc, &
4412 & msg=esmf_logerr_passthru, &
4413 & line=__line__, &
4414 & file=myfile)) RETURN
4415 END IF
4416 END DO
4417 END IF
4418 END DO
4419!
4420!-----------------------------------------------------------------------
4421! Add IMPORT fields to NUOPC field dictionary.
4422!-----------------------------------------------------------------------
4423!
4424 DO i=1,nmodels
4425 IF (models(i)%IsActive) THEN
4426 DO j=1,nimport(i)
4427 sname=models(i)%ImportField(j)%standard_name
4428 units=models(i)%ImportField(j)%src_units
4429!
4430! Check if field already exists.
4431!
4432 exist=nuopc_fielddictionaryhasentry(trim(sname), &
4433 & rc=rc)
4434 IF (esmf_logfounderror(rctocheck=rc, &
4435 & msg=esmf_logerr_passthru, &
4436 & line=__line__, &
4437 & file=myfile)) THEN
4438 RETURN
4439 END IF
4440!
4441! Add field to dictionary.
4442!
4443 IF (.not.exist) THEN
4444 CALL nuopc_fielddictionaryaddentry(trim(sname), &
4445 & canonicalunits=trim(units), &
4446 & rc=rc)
4447 IF (esmf_logfounderror(rctocheck=rc, &
4448 & msg=esmf_logerr_passthru, &
4449 & line=__line__, &
4450 & file=myfile)) THEN
4451 RETURN
4452 END IF
4453 END IF
4454 END DO
4455 END IF
4456 END DO
4457!
4458! Report import fields metadata.
4459!
4460 IF ((localpet.eq.0).and.(models(iatmos )%IsActive.or. &
4461 & models(idata )%IsActive.or. &
4462 & models(iseaice)%IsActive.or. &
4463 & models(iwave )%IsActive)) THEN
4464
4465 WRITE (cplout,40) 'ESM IMPORT Fields Metadata Dictionary:'
4466!
4467 DO i=1,nmodels
4468 lreport=.false.
4469 IF (models(i)%IsActive) THEN
4470 lreport=.true.
4471 smodel=trim(models(i)%name)
4472 END IF
4473 IF (lreport) THEN
4474 DO j=1,nimport(i)
4475 WRITE (cplout,50) &
4476 & trim(smodel), &
4477 & trim(models(i)%ImportField(j)%short_name), &
4478 & trim(models(i)%ImportField(j)%standard_name), &
4479 & models(i)%ImportField(j)%gtype, &
4480 & models(i)%ImportField(j)%itype, &
4481 & models(i)%ImportField(j)%etype, &
4482 & models(i)%ImportField(j)%connected, &
4483 & models(i)%ImportField(j)%debug_write, &
4484 & models(i)%ImportField(j)%add_offset, &
4485 & models(i)%ImportField(j)%scale_factor
4486 END DO
4487 END IF
4488 END DO
4489 END IF
4490!
4491!-----------------------------------------------------------------------
4492! Add EXPORT fields to NUOPC field dictionary.
4493!-----------------------------------------------------------------------
4494!
4495 DO i=1,nmodels
4496 IF (models(i)%IsActive) THEN
4497 DO j=1,nexport(i)
4498 sname=models(i)%ExportField(j)%standard_name
4499 units=models(i)%ExportField(j)%src_units
4500!
4501! Check if field already exists.
4502!
4503 exist=nuopc_fielddictionaryhasentry(trim(sname), &
4504 & rc=rc)
4505 IF (esmf_logfounderror(rctocheck=rc, &
4506 & msg=esmf_logerr_passthru, &
4507 & line=__line__, &
4508 & file=myfile)) THEN
4509 RETURN
4510 END IF
4511!
4512! Add field to dictionary.
4513!
4514 IF (.not.exist) THEN
4515 CALL nuopc_fielddictionaryaddentry(trim(sname), &
4516 & canonicalunits=trim(units), &
4517 & rc=rc)
4518 IF (esmf_logfounderror(rctocheck=rc, &
4519 & msg=esmf_logerr_passthru, &
4520 & line=__line__, &
4521 & file=myfile)) THEN
4522 RETURN
4523 END IF
4524 END IF
4525 END DO
4526 END IF
4527 END DO
4528!
4529! Report export fields metadata.
4530!
4531 IF ((localpet.eq.0).and.(models(iatmos )%IsActive.or. &
4532 & models(idata )%IsActive.or. &
4533 & models(iseaice)%IsActive.or. &
4534 & models(iwave )%IsActive)) THEN
4535
4536 WRITE (cplout,40) 'ESM EXPORT Fields Metadata Dictionary:'
4537!
4538 DO i=1,nmodels
4539 lreport=.false.
4540 IF (models(i)%IsActive) THEN
4541 lreport=.true.
4542 smodel=trim(models(i)%name)
4543 END IF
4544 IF (lreport) THEN
4545 DO j=1,nexport(i)
4546 WRITE (cplout,50) &
4547 & trim(smodel), &
4548 & trim(models(i)%ExportField(j)%short_name), &
4549 & trim(models(i)%ExportField(j)%standard_name), &
4550 & models(i)%ExportField(j)%gtype, &
4551 & models(i)%ExportField(j)%itype, &
4552 & models(i)%ExportField(j)%etype, &
4553 & models(i)%ExportField(j)%connected, &
4554 & models(i)%ExportField(j)%debug_write, &
4555 & models(i)%ExportField(j)%add_offset, &
4556 & models(i)%ExportField(j)%scale_factor
4557 END DO
4558 END IF
4559 END DO
4560 END IF
4561!
4562 IF (models(iatmos )%IsActive.or. &
4563 & models(idata )%IsActive.or. &
4564 & models(iseaice)%IsActive.or. &
4565 & models(iwave )%IsActive) THEN
4566 IF (localpet.eq.0) THEN
4567 WRITE (cplout,60)
4568 END IF
4569 END IF
4570!
4571!-----------------------------------------------------------------------
4572! Read in RunSequence input file and report.
4573!-----------------------------------------------------------------------
4574!
4575! Open input coupling variable information file.
4576!
4577 OPEN (inp, file=trim(confname), form='formatted', status='old', &
4578 & iostat=io_err, iomsg=io_errmsg)
4579 IF (io_err.ne.0) THEN
4580 IF (localpet.eq.0) WRITE(cplout,70) trim(confname), &
4581 & trim(io_errmsg)
4582 exit_flag=5
4583 rc=esmf_rc_file_open
4584 RETURN
4585 END IF
4586!
4587! Read in and report RunSequence file. Ignore blank and comments
4588! [char(35)=#] input lines.
4589!
4590 IF (localpet.eq.0) THEN
4591 WRITE (cplout,80) 'ESM Coupling RunSequence:', trim(confname)
4592 END IF
4593!
4594 DO WHILE (.true.)
4595 READ (inp,'(a)',err=10,END=20) line
4596 lvar=len_trim(line)
4597 IF ((lvar.gt.0).and.(line(1:1).ne.char(35))) THEN
4598 IF (localpet.eq.0) WRITE (cplout,'(a)') trim(line)
4599 END IF
4600 END DO
4601 10 IF (localpet.eq.0) WRITE (cplout,90) trim(confname)
4602 rc=esmf_rc_file_read
4603 RETURN
4604 20 CLOSE (inp)
4605 IF (localpet.eq.0) WRITE (cplout,'(a)') char(10) ! new line
4606!
4607! Flush standard output buffer.
4608!
4609 FLUSH (cplout)
4610!
4611! Deallocate.
4612!
4613 IF (allocated(s)) deallocate (s)
4614 IF (allocated(smodel)) deallocate (smodel)
4615!
4616 30 FORMAT (/,' SET_METADATA - cannot find metadata for', &
4617 & 1x,a,'''',a,'''.',/,16x, &
4618 & 'Add entry to metadata file: ',a)
4619 40 FORMAT (/,a,/, 37('='),/,/, 'Model', t11,'Short Name', &
4620 & t25,'Standard Name', t74,'G', t77,'I', t80,'E' t83,'C', &
4621 & t86,'W',t90,'add_offset', t102,'scale_factor',/, 114('-'))
4622 50 FORMAT (a, t11,a, t25,a, t74,i1, t77,i1, t80,i1, t83,l1, t86,l1, &
4623 & t89,1p,e12.5, t103,1p,e12.5)
4624 60 FORMAT (/,' G: Grid cell location, 1=Center,', &
4625 & ' 2=Corner,', &
4626 & ' 3=U-point,', &
4627 & ' 4=V-point', &
4628 & /,' I: Regridding method, 1=bilinear,', &
4629 & ' 2=patch,', &
4630 & ' 3=conservative1', &
4631 & ' 4=conservative2', &
4632 & ' 5=nearest', &
4633 & /,' E: Extrapolation method, 0=none,', &
4634 & ' 1=nearest,', &
4635 & ' 2=inv distance avg,', &
4636 & ' 3=creep fill,', &
4637 & ' 4=two-steps (old way)', &
4638 & /,' C: Connected to coupler, F=derived from other,', &
4639 & ' T=exchanged/regridded', &
4640 & /,' W: Field write to NetCDF, F=false, T=true', &
4641 & ' (used if DebugLevel > 2)'/)
4642 70 FORMAT (/,' SET_METADATA - Unable to open RunSequence ', &
4643 & ' configuration file: ',/,16x,a,/,16x,'ERROR: ',a, &
4644 & /,16x,'Prototypes are located in the ESM directory.')
4645 80 FORMAT (/,a,2x,a,/, 25('='),/)
4646 90 FORMAT (/,' SET_METADATA - error while reading RunSequence', &
4647 & ' configuration file: ',a)
4648!
4649 RETURN
4650 END SUBROUTINE set_metadata
4651!
4652 SUBROUTINE def_fieldatt (vm, rc)
4653!
4654!=======================================================================
4655! !
4656! If concurrent coupling and ESM components importing time snapshots, !
4657! create output NetCDF file containing the field attributes needed to !
4658! perform the time interpolation. !
4659! !
4660!=======================================================================
4661!
4662 USE mod_netcdf
4663!
4664 USE mod_parallel, ONLY : ocn_comm_world
4665 USE mod_iounits, ONLY : sourcefile, ioerror
4666 USE mod_ncparam, ONLY : maxlen
4667 USE mod_scalars, ONLY : noerror, exit_flag
4668!
4669 USE def_dim_mod, ONLY : def_dim
4670 USE def_var_mod, ONLY : def_var
4671 USE distribute_mod, ONLY : mp_bcasti
4672 USE strings_mod, ONLY : founderror
4673!
4674! Imported variable declarations.
4675!
4676 integer, intent(out) :: rc
4677
4678 TYPE (esmf_vm) :: vm
4679!
4680! Local variable declarations.
4681!
4682 integer :: cdimid, ddimid, fdimid, sdimid, sndimid
4683 integer :: mycomm, romscomm, petcount, localpet
4684 integer :: ncomp, nfields, i, j, ncid, status, varid
4685 integer :: ibuffer(3)
4686!
4687 integer, parameter :: natt = 25 ! ROMS framework usage
4688 integer, parameter :: ng = 1 ! ROMS framework usage
4689 integer, parameter :: ikernel = 1 ! ROMS framework usage
4690!
4691 real(r8) :: aval(6)
4692!
4693 character (len= 80) :: text
4694 character (len=MaxLen) :: vinfo(natt)
4695
4696 character (len=*), parameter :: myfile = &
4697 & __FILE__//", def_FieldAtt"
4698!
4699 sourcefile=myfile
4700!
4701!-----------------------------------------------------------------------
4702! Initialize return code flag to success state (no error).
4703!-----------------------------------------------------------------------
4704!
4705 rc=esmf_success
4706!
4707!-----------------------------------------------------------------------
4708! Querry the Virtual Machine (VM) parallel environmemt for the
4709! mpi communicator handle and current node rank.
4710!-----------------------------------------------------------------------
4711!
4712 CALL esmf_vmget (vm, &
4713 & localpet=localpet, &
4714 & petcount=petcount, &
4715 & mpicommunicator=mycomm, &
4716 & rc=rc)
4717 IF (esmf_logfounderror(rctocheck=rc, &
4718 & msg=esmf_logerr_passthru, &
4719 & line=__line__, &
4720 & file=myfile)) THEN
4721 RETURN
4722 END IF
4723!
4724! Temporarily replace ROMS mpi communicator handle with that for DATA
4725! component. Recall that the DATA component uses both ROMS NetCDF- and
4726! mpi-frameworks.
4727!
4728 romscomm=ocn_comm_world
4729 ocn_comm_world=mycomm
4730!
4731!-----------------------------------------------------------------------
4732! Create field time interpolation variable attributes NetCDF file.
4733!-----------------------------------------------------------------------
4734!
4735! Initialize local information variable arrays.
4736!
4737 DO i=1,natt
4738 DO j=1,len(vinfo(1))
4739 vinfo(i)(j:j)=' '
4740 END DO
4741 END DO
4742 DO i=1,6
4743 aval(i)=0.0_r8
4744 END DO
4745 nfields=sum(nexport)
4746!
4747! Create NetCDF file.
4748!
4749 CALL netcdf_create (ng, ikernel, attfilename, ncid)
4750 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4751 IF (localpet.eq.0) WRITE (cplout,10) trim(attfilename)
4752 rc=esmf_rc_file_create
4753 RETURN
4754 END IF
4755!
4756! Define dimensions.
4757!
4758 status=def_dim(ng, ikernel, ncid, attfilename, 'Nmodels', &
4759 & nmodels, cdimid)
4760 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4761 rc=esmf_rc_file_create
4762 exit_flag=3
4763 ioerror=status
4764 RETURN
4765 END IF
4766!
4767 status=def_dim(ng, ikernel, ncid, attfilename, 'field', &
4768 & nfields, fdimid)
4769 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4770 rc=esmf_rc_file_create
4771 exit_flag=3
4772 ioerror=status
4773 RETURN
4774 END IF
4775! length of short-name
4776 status=def_dim(ng, ikernel, ncid, attfilename, 'char20', &
4777 & 20, sndimid)
4778 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4779 rc=esmf_rc_file_create
4780 exit_flag=3
4781 ioerror=status
4782 RETURN
4783 END IF
4784! length snapshot date
4785 status=def_dim(ng, ikernel, ncid, attfilename, 'char22', &
4786 & 22, ddimid)
4787 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4788 rc=esmf_rc_file_create
4789 exit_flag=3
4790 ioerror=status
4791 RETURN
4792 END IF
4793!
4794 status=def_dim(ng, ikernel, ncid, attfilename, 'snapshot', &
4795 & nf90_unlimited, sdimid)
4796 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4797 rc=esmf_rc_file_create
4798 exit_flag=3
4799 ioerror=status
4800 RETURN
4801 END IF
4802!
4803! Define global attributes.
4804!
4805 text='ROMS ESMF/NUOPC coupling, '// &
4806 & 'field metadata for time interpolation between snapshots'
4807 IF (localpet.eq.0) THEN
4808 status=nf90_put_att(ncid, nf90_global, 'type', &
4809 & trim(text))
4810 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4811 WRITE (cplout,20) 'type', trim(attfilename)
4812 rc=esmf_rc_file_create
4813 exit_flag=3
4814 ioerror=status
4815 END IF
4816 END IF
4817 ibuffer(1)=rc
4818 ibuffer(2)=exit_flag
4819 ibuffer(3)=ioerror
4820 CALL mp_bcasti (ng, ikernel, ibuffer)
4821 rc=ibuffer(1)
4822 exit_flag=ibuffer(2)
4823 ioerror=ibuffer(3)
4824 IF (esmf_logfounderror(rctocheck=rc, &
4825 & msg=esmf_logerr_passthru, &
4826 & line=__line__, &
4827 & file=myfile)) RETURN
4828!
4829 IF (localpet.eq.0) THEN
4830 status=nf90_put_att(ncid, nf90_global, 'file', &
4831 & trim(attfilename))
4832 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4833 WRITE (cplout,20) 'file', trim(attfilename)
4834 rc=esmf_rc_file_create
4835 exit_flag=3
4836 ioerror=status
4837 END IF
4838 END IF
4839 ibuffer(1)=rc
4840 ibuffer(2)=exit_flag
4841 ibuffer(3)=ioerror
4842 CALL mp_bcasti (ng, ikernel, ibuffer)
4843 rc=ibuffer(1)
4844 exit_flag=ibuffer(2)
4845 ioerror=ibuffer(3)
4846 IF (esmf_logfounderror(rctocheck=rc, &
4847 & msg=esmf_logerr_passthru, &
4848 & line=__line__, &
4849 & file=myfile)) RETURN
4850!
4851 text='CF-1.4'
4852 IF (localpet.eq.0) THEN
4853 status=nf90_put_att(ncid, nf90_global, 'Conventions', &
4854 & trim(text))
4855 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4856 WRITE (cplout,20) 'Conventions', trim(attfilename)
4857 rc=esmf_rc_file_create
4858 exit_flag=3
4859 ioerror=status
4860 END IF
4861 END IF
4862 ibuffer(1)=rc
4863 ibuffer(2)=exit_flag
4864 ibuffer(3)=ioerror
4865 CALL mp_bcasti (ng, ikernel, ibuffer)
4866 rc=ibuffer(1)
4867 exit_flag=ibuffer(2)
4868 ioerror=ibuffer(3)
4869 IF (esmf_logfounderror(rctocheck=rc, &
4870 & msg=esmf_logerr_passthru, &
4871 & line=__line__, &
4872 & file=myfile)) RETURN
4873!
4874! Define variables.
4875!
4876 vinfo(1)='field'
4877 vinfo(2)='field short name'
4878 status=def_var(ng, ikernel, ncid, varid, nf90_char, &
4879 & 3, (/sndimid,cdimid,fdimid/), aval, vinfo, &
4880 & attfilename, setparaccess = .false.)
4881 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4882 rc=esmf_rc_file_create
4883 exit_flag=3
4884 ioerror=status
4885 RETURN
4886 END IF
4887!
4888 vinfo(1)='Tindex'
4889 vinfo(2)='current time snapshot rolling index'
4890 status=def_var(ng, ikernel, ncid, varid, nf90_int, &
4891 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4892 & attfilename, setparaccess = .false.)
4893 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4894 rc=esmf_rc_file_create
4895 exit_flag=3
4896 ioerror=status
4897 RETURN
4898 END IF
4899!
4900 vinfo(1)='Date'
4901 vinfo(2)='field snapshot date'
4902 status=def_var(ng, ikernel, ncid, varid, nf90_char, &
4903 & 4, (/ddimid,cdimid,fdimid,sdimid/), aval, vinfo, &
4904 & attfilename, setparaccess = .false.)
4905 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4906 rc=esmf_rc_file_create
4907 exit_flag=3
4908 ioerror=status
4909 RETURN
4910 END IF
4911!
4912 vinfo(1)='Tcurrent'
4913 vinfo(2)='current coupling time'
4914 vinfo(3)='days since '// &
4915 & trim(clockinfo(idriver)%Time_ReferenceString)
4916 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4917 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4918 & attfilename, setparaccess = .false.)
4919 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4920 rc=esmf_rc_file_create
4921 exit_flag=3
4922 ioerror=status
4923 RETURN
4924 END IF
4925!
4926 vinfo(1)='Tstr'
4927 vinfo(2)='field lower time snapshot'
4928 vinfo(3)='days since '// &
4929 & trim(clockinfo(idriver)%Time_ReferenceString)
4930 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4931 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4932 & attfilename, setparaccess = .false.)
4933 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4934 rc=esmf_rc_file_create
4935 exit_flag=3
4936 ioerror=status
4937 RETURN
4938 END IF
4939!
4940 vinfo(1)='Tend'
4941 vinfo(2)='field upper time snapshot'
4942 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4943 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4944 & attfilename, setparaccess = .false.)
4945 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4946 rc=esmf_rc_file_create
4947 exit_flag=3
4948 ioerror=status
4949 RETURN
4950 END IF
4951!
4952 vinfo(1)='Tintrp'
4953 vinfo(2)='field monotonic time for interpolation'
4954 vinfo(3)='days since '// &
4955 & trim(clockinfo(idriver)%Time_ReferenceString)
4956 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4957 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4958 & attfilename, setparaccess = .false.)
4959 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4960 rc=esmf_rc_file_create
4961 exit_flag=3
4962 ioerror=status
4963 RETURN
4964 END IF
4965!
4966 vinfo(1)='Vtime'
4967 vinfo(2)='field variable current time snapshots'
4968 vinfo(3)='days since '// &
4969 & trim(clockinfo(idriver)%Time_ReferenceString)
4970 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4971 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4972 & attfilename, setparaccess = .false.)
4973 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4974 rc=esmf_rc_file_create
4975 exit_flag=3
4976 ioerror=status
4977 RETURN
4978 END IF
4979!
4980 vinfo(1)='Tmin'
4981 vinfo(2)='field time minimum in data'
4982 vinfo(3)='days since '// &
4983 & trim(clockinfo(idriver)%Time_ReferenceString)
4984 status=def_var(ng, ikernel, ncid, varid, nf_tout, &
4985 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
4986 & attfilename, setparaccess = .false.)
4987 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4988 rc=esmf_rc_file_create
4989 exit_flag=3
4990 ioerror=status
4991 RETURN
4992 END IF
4993!
4994 vinfo(1)='Tmax'
4995 vinfo(2)='field time maximum in data'
4996 vinfo(3)='days since '// &
4997 & trim(clockinfo(idriver)%Time_ReferenceString)
4998 status=def_var(ng, ikernel, ncid, varid, nf_type, &
4999 & 3, (/cdimid,fdimid,sdimid/), aval, vinfo, &
5000 & attfilename, setparaccess = .false.)
5001 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5002 rc=esmf_rc_file_create
5003 exit_flag=3
5004 ioerror=status
5005 RETURN
5006 END IF
5007!
5008! Leave definition mode.
5009!
5010 CALL netcdf_enddef (ng, ikernel, attfilename, ncid)
5011 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5012 rc=esmf_rc_file_create
5013 RETURN
5014 END IF
5015!
5016! Close file to allow ESM components to manipulate the data across
5017! different VM in concurrent coupling. The file will be opened and
5018! closed by during data input and output processing allowing
5019! synchronization and access to data immidiately after is written.
5020!
5021 CALL netcdf_close (ng, ikernel, ncid, attfilename)
5022 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5023 rc=esmf_rc_file_create
5024 RETURN
5025 END IF
5026!
5027! Restore ROMS mpi communicator handle.
5028!
5029 ocn_comm_world=romscomm
5030!
5031 10 FORMAT (/,' def_FieldAtt - unable to create NetCDF file: ',a)
5032 20 FORMAT (/,' def_FieldAtt - error while creating global', &
5033 & ' attribute: ', a,/,16x,a)
5034!
5035 RETURN
5036 END SUBROUTINE def_fieldatt
5037!
5038 SUBROUTINE get_weights (Icomp, Ix, Iy, vm, rc)
5039!
5040!=======================================================================
5041! !
5042! This routine Sets or reads in melding weights coefficients needed !
5043! by the atmosphere model to merge fields from DATA and other ESM !
5044! components because of incongruent grids. !
5045! !
5046!=======================================================================
5047!
5048 USE mod_netcdf
5049!
5050 USE mod_parallel, ONLY : ocn_comm_world
5051 USE mod_iounits, ONLY : sourcefile
5052 USE mod_scalars, ONLY : noerror, exit_flag
5053!
5054 USE strings_mod, ONLY : founderror
5055!
5056! Imported variable declarations.
5057!
5058 integer, intent(in) :: icomp, ix, iy
5059 integer, intent(out) :: rc
5060!
5061 TYPE (esmf_vm) :: vm
5062!
5063! Local variable declarations.
5064!
5065 integer :: mycomm, romscomm, petcount, localpet
5066 integer :: nx, ny
5067!
5068 integer, parameter :: ng = 1 ! ROMS framework usage
5069 integer, parameter :: ikernel = 1 ! ROMS framework usage
5070!
5071 real(r8) :: vmin, vmax
5072!
5073 character (len=256) :: ncname
5074
5075 character (len=*), parameter :: myfile = &
5076 & __FILE__//", get_weights"
5077!
5078 sourcefile=myfile
5079!
5080!-----------------------------------------------------------------------
5081! Initialize return code flag to success state (no error).
5082!-----------------------------------------------------------------------
5083!
5084 rc=esmf_success
5085!
5086!-----------------------------------------------------------------------
5087! Querry the Virtual Machine (VM) parallel environmemt for the
5088! mpi communicator handle and current node rank.
5089!-----------------------------------------------------------------------
5090!
5091 CALL esmf_vmget (vm, &
5092 & localpet=localpet, &
5093 & petcount=petcount, &
5094 & mpicommunicator=mycomm, &
5095 & rc=rc)
5096 IF (esmf_logfounderror(rctocheck=rc, &
5097 & msg=esmf_logerr_passthru, &
5098 & line=__line__, &
5099 & file=myfile)) THEN
5100 RETURN
5101 END IF
5102!
5103! Temporarily replace ROMS mpi communicator handle with that for DATA
5104! component. Recall that the DATA component uses both ROMS NetCDF- and
5105! mpi-frameworks.
5106!
5107 romscomm=ocn_comm_world
5108 ocn_comm_world=mycomm
5109!
5110!-----------------------------------------------------------------------
5111! Read in melding weighting coefficients.
5112!-----------------------------------------------------------------------
5113!
5114 IF (models(icomp)%IsActive) THEN
5115 ncname=trim(weights(icomp)%ncfile)
5116!
5117! Inquire about the weights variables.
5118!
5119 CALL netcdf_inq_var (ng, ikernel, ncname, &
5120 & myvarname = trim(weights(icomp)%VnameDATA))
5121 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5122 IF (localpet.eq.0) THEN
5123 WRITE (cplout,10) trim(weights(icomp)%VnameDATA), &
5124 & trim(ncname)
5125 END IF
5126 rc=esmf_rc_file_read
5127 RETURN
5128 ELSE
5129 nx=var_dsize(1)
5130 ny=var_dsize(2)
5131 IF (ix.ne.nx) THEN
5132 IF (localpet.eq.0) THEN
5133 WRITE (cplout,20) trim(var_dname(1)), nx, ix, trim(ncname)
5134 END IF
5135 rc=esmf_rc_not_valid
5136 RETURN
5137 END IF
5138 IF (iy.ne.ny) THEN
5139 IF (localpet.eq.0) THEN
5140 WRITE (cplout,20) trim(var_dname(2)), ny, iy, trim(ncname)
5141 END IF
5142 rc=esmf_rc_not_valid
5143 RETURN
5144 END IF
5145 END IF
5146!
5147! Allocate weights arrays.
5148!
5149 IF (.not.allocated(weights(icomp)%Cdat)) THEN
5150 allocate ( weights(icomp)%Cdat(ix,iy) )
5151 weights(icomp)%Cdat = 0.0_r8
5152 END IF
5153 IF (.not.allocated(weights(icomp)%Cesm)) THEN
5154 allocate ( weights(icomp)%Cesm(ix,iy) )
5155 weights(icomp)%Cesm = 0.0_r8
5156 END IF
5157!
5158! Read in weights and broadcast full arrays to all the members of the
5159! communicator.
5160!
5161 CALL netcdf_get_fvar (ng, ikernel, ncname, &
5162 & trim(weights(icomp)%VnameDATA), &
5163 & weights(icomp)%Cdat, &
5164 & start = (/1,1/), &
5165 & total = (/ix,iy/), &
5166 & min_val = vmin, &
5167 & max_val = vmax)
5168 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5169 IF (localpet.eq.0) THEN
5170 WRITE (cplout,30) trim(weights(icomp)%VnameDATA), &
5171 & trim(ncname)
5172 END IF
5173 rc=esmf_rc_file_read
5174 RETURN
5175 ELSE
5176 IF (localpet.eq.0) THEN
5177 WRITE (cplout,40) trim(weights(icomp)%VnameDATA), &
5178 & vmin, vmax
5179 END IF
5180 END IF
5181!
5182 CALL netcdf_get_fvar (ng, ikernel, ncname, &
5183 & trim(weights(icomp)%VnameESM), &
5184 & weights(icomp)%Cesm, &
5185 & start = (/1,1/), &
5186 & total = (/ix,iy/), &
5187 & min_val = vmin, &
5188 & max_val = vmax)
5189 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5190 IF (localpet.eq.0) THEN
5191 WRITE (cplout,30) trim(weights(icomp)%VnameESM), &
5192 & trim(ncname)
5193 END IF
5194 rc=esmf_rc_file_read
5195 RETURN
5196 ELSE
5197 IF (localpet.eq.0) THEN
5198 WRITE (cplout,40) trim(weights(icomp)%VnameESM), &
5199 & vmin, vmax
5200 END IF
5201 END IF
5202 END IF
5203!
5204! Restore ROMS mpi communicator handle.
5205!
5206 ocn_comm_world=romscomm
5207!
5208 10 FORMAT (/,' GET_WEIGHTS - error while inquiring variable: ',a, &
5209 & /,15x,'in file: ''',a,'''')
5210 20 FORMAT (/,' GET_WEIGHTS - incorrect value for dimension: ',a, &
5211 & ' = ',i0,', need ',i0,' instead'/,15x,'in file: ',a)
5212 30 FORMAT (/,' GET_WEIGHTS - error while reading variable: ''',a, &
5213 & '''',/,15x,'in file: ',a)
5214 40 FORMAT (3x,' GET_WEIGHTS - ESMF: reading ''',a,'''',/,19x, &
5215 & '(Wmin= ', 1p,e15.8,0p,' Wmax= ',1p,e15.8,0p,')')
5216!
5217 RETURN
5218 END SUBROUTINE get_weights
5219#endif
5220 END MODULE mod_esmf_esm
def_dim_mod::def_dim
Definition def_dim.F:24
def_var_mod::def_var
Definition def_var.F:88
distribute_mod::mp_bcasti
Definition distribute.F:95
distribute_mod::mp_bcasts
Definition distribute.F:101
mod_netcdf::netcdf_get_fvar
Definition mod_netcdf.F:45
my_getarg
subroutine my_getarg(iarg, carg)
Definition mp_routines.F:28
dateclock_mod
Definition dateclock.F:2
dateclock_mod::time_string
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
dateclock_mod::get_date
subroutine, public get_date(date_str)
Definition dateclock.F:856
dateclock_mod::ref_clock
subroutine, public ref_clock(r_time)
Definition dateclock.F:972
dateclock_mod::datenum
subroutine, public datenum(datenumber, year, month, day, hour, minutes, seconds)
Definition dateclock.F:243
def_dim_mod
Definition def_dim.F:2
def_var_mod
Definition def_var.F:2
distribute_mod
Definition distribute.F:3
get_metadata_mod
Definition get_metadata.F:2
get_metadata_mod::coupling_metadata
subroutine, public coupling_metadata(filename, s)
Definition get_metadata.F:382
get_metadata_mod::metadata_has
integer function, public metadata_has(s, short_name)
Definition get_metadata.F:1039
inp_decode_mod
Definition inp_decode.F:2
mod_esmf_esm
Definition mod_esmf_esm.F:2
mod_esmf_esm::def_fieldatt
subroutine, public def_fieldatt(vm, rc)
Definition mod_esmf_esm.F:4653
mod_esmf_esm::iroms
integer iroms
Definition mod_esmf_esm.F:433
mod_esmf_esm::cinpname
character(len=256) cinpname
Definition mod_esmf_esm.F:639
mod_esmf_esm::nexport
integer, dimension(:), allocatable nexport
Definition mod_esmf_esm.F:451
mod_esmf_esm::tol_r8
real(r8), parameter tol_r8
Definition mod_esmf_esm.F:681
mod_esmf_esm::connectors
type(esm_conn), dimension(:,:), allocatable, target connectors
Definition mod_esmf_esm.F:377
mod_esmf_esm::dataout
integer dataout
Definition mod_esmf_esm.F:657
mod_esmf_esm::dataset
type(esm_dataset), dimension(:), allocatable, target dataset
Definition mod_esmf_esm.F:391
mod_esmf_esm::ngridsi
integer ngridsi
Definition mod_esmf_esm.F:424
mod_esmf_esm::get_atm_ngrids
integer function, public get_atm_ngrids(sname, localpet)
Definition mod_esmf_esm.F:1121
mod_esmf_esm::petlayoutoption
character(len=10) petlayoutoption
Definition mod_esmf_esm.F:475
mod_esmf_esm::couplerlog
character(len=11), parameter couplerlog
Definition mod_esmf_esm.F:660
mod_esmf_esm::extrapnumlevels
integer extrapnumlevels
Definition mod_esmf_esm.F:615
mod_esmf_esm::unmapped_mask
integer(i4b), parameter unmapped_mask
Definition mod_esmf_esm.F:673
mod_esmf_esm::allocate_esmf_esm
subroutine, public allocate_esmf_esm
Definition mod_esmf_esm.F:686
mod_esmf_esm::icenter
integer, parameter icenter
Definition mod_esmf_esm.F:561
mod_esmf_esm::timestep
integer, dimension(6) timestep
Definition mod_esmf_esm.F:501
mod_esmf_esm::instod
integer, parameter instod
Definition mod_esmf_esm.F:580
mod_esmf_esm::ngridsw
integer ngridsw
Definition mod_esmf_esm.F:426
mod_esmf_esm::trac
integer trac
Definition mod_esmf_esm.F:543
mod_esmf_esm::exstod
integer, parameter exstod
Definition mod_esmf_esm.F:595
mod_esmf_esm::ngridsa
integer ngridsa
Definition mod_esmf_esm.F:422
mod_esmf_esm::iseq
integer, parameter iseq
Definition mod_esmf_esm.F:630
mod_esmf_esm::inpname
character(len=256), dimension(:), allocatable inpname
Definition mod_esmf_esm.F:651
mod_esmf_esm::masktype
character(len=3), dimension(3) masktype
Definition mod_esmf_esm.F:623
mod_esmf_esm::jtiled
integer jtiled
Definition mod_esmf_esm.F:518
mod_esmf_esm::load_ifs
subroutine, private load_ifs(s, ifiles, ngrids, nfiles, icomp)
Definition mod_esmf_esm.F:1307
mod_esmf_esm::iupoint
integer, parameter iupoint
Definition mod_esmf_esm.F:563
mod_esmf_esm::itiled
integer itiled
Definition mod_esmf_esm.F:517
mod_esmf_esm::weightdat
real(dp) weightdat
Definition mod_esmf_esm.F:324
mod_esmf_esm::overall
integer, parameter overall
Definition mod_esmf_esm.F:621
mod_esmf_esm::ecreep
integer, parameter ecreep
Definition mod_esmf_esm.F:597
mod_esmf_esm::ibilin
integer, parameter ibilin
Definition mod_esmf_esm.F:576
mod_esmf_esm::ipatch
integer, parameter ipatch
Definition mod_esmf_esm.F:577
mod_esmf_esm::set_metadata
subroutine, public set_metadata(vm, rc)
Definition mod_esmf_esm.F:3994
mod_esmf_esm::runmode
character(len=10), dimension(2) runmode
Definition mod_esmf_esm.F:633
mod_esmf_esm::vmdriver
type(esmf_vm) vmdriver
Definition mod_esmf_esm.F:471
mod_esmf_esm::debuglevel
integer debuglevel
Definition mod_esmf_esm.F:527
mod_esmf_esm::iconsv2
integer, parameter iconsv2
Definition mod_esmf_esm.F:579
mod_esmf_esm::iwave
integer iwave
Definition mod_esmf_esm.F:437
mod_esmf_esm::overland
integer, parameter overland
Definition mod_esmf_esm.F:619
mod_esmf_esm::mapped_mask
integer(i4b), parameter mapped_mask
Definition mod_esmf_esm.F:672
mod_esmf_esm::missing_r8
real(r8), parameter missing_r8
Definition mod_esmf_esm.F:677
mod_esmf_esm::tracelevel
integer tracelevel
Definition mod_esmf_esm.F:537
mod_esmf_esm::indtos
integer, parameter indtos
Definition mod_esmf_esm.F:581
mod_esmf_esm::get_weights
subroutine, public get_weights(icomp, ix, iy, vm, rc)
Definition mod_esmf_esm.F:5039
mod_esmf_esm::couplingtype
integer couplingtype
Definition mod_esmf_esm.F:467
mod_esmf_esm::stopdate
integer, dimension(6) stopdate
Definition mod_esmf_esm.F:500
mod_esmf_esm::eidavg
integer, parameter eidavg
Definition mod_esmf_esm.F:596
mod_esmf_esm::fields
type(esm_field), dimension(maxnumberfields) fields
Definition mod_esmf_esm.F:385
mod_esmf_esm::missing_dp
real(dp), parameter missing_dp
Definition mod_esmf_esm.F:675
mod_esmf_esm::cplout
integer cplout
Definition mod_esmf_esm.F:656
mod_esmf_esm::inone
integer, parameter inone
Definition mod_esmf_esm.F:575
mod_esmf_esm::gridtype
character(len=6), dimension(0:4) gridtype
Definition mod_esmf_esm.F:566
mod_esmf_esm::cplname
character(len=256) cplname
Definition mod_esmf_esm.F:647
mod_esmf_esm::esmnamelog
character(len=8), parameter esmnamelog
Definition mod_esmf_esm.F:659
mod_esmf_esm::maxnumberfields
integer, parameter maxnumberfields
Definition mod_esmf_esm.F:382
mod_esmf_esm::referencedate
integer, dimension(6) referencedate
Definition mod_esmf_esm.F:497
mod_esmf_esm::ngridsr
integer ngridsr
Definition mod_esmf_esm.F:425
mod_esmf_esm::iseaice
integer iseaice
Definition mod_esmf_esm.F:436
mod_esmf_esm::esmcomm
integer, dimension(:), allocatable esmcomm
Definition mod_esmf_esm.F:485
mod_esmf_esm::ngridsd
integer ngridsd
Definition mod_esmf_esm.F:423
mod_esmf_esm::iatmos
integer iatmos
Definition mod_esmf_esm.F:434
mod_esmf_esm::esm_track
logical esm_track
Definition mod_esmf_esm.F:542
mod_esmf_esm::restartdate
integer, dimension(6) restartdate
Definition mod_esmf_esm.F:498
mod_esmf_esm::idriver
integer idriver
Definition mod_esmf_esm.F:432
mod_esmf_esm::get_roms_ngrids
integer function, public get_roms_ngrids(sname, localpet)
Definition mod_esmf_esm.F:1214
mod_esmf_esm::enone
integer, parameter enone
Definition mod_esmf_esm.F:594
mod_esmf_esm::field_index
integer function, public field_index(fnames, fvalue)
Definition mod_esmf_esm.F:1083
mod_esmf_esm::coupled
type(esm_cplset), dimension(:), allocatable, target coupled
Definition mod_esmf_esm.F:151
mod_esmf_esm::intrptype
character(len=4), dimension(0:6) intrptype
Definition mod_esmf_esm.F:583
mod_esmf_esm::extrptype
character(len=4), dimension(0:4) extrptype
Definition mod_esmf_esm.F:600
mod_esmf_esm::idata
integer idata
Definition mod_esmf_esm.F:435
mod_esmf_esm::overocean
integer, parameter overocean
Definition mod_esmf_esm.F:620
mod_esmf_esm::e2steps
integer, parameter e2steps
Definition mod_esmf_esm.F:598
mod_esmf_esm::referencedatenumber
real(dp), dimension(2) referencedatenumber
Definition mod_esmf_esm.F:512
mod_esmf_esm::tol_r4
real(r4), parameter tol_r4
Definition mod_esmf_esm.F:680
mod_esmf_esm::clockinfo
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition mod_esmf_esm.F:396
mod_esmf_esm::nfields
integer nfields
Definition mod_esmf_esm.F:383
mod_esmf_esm::inan
integer, parameter inan
Definition mod_esmf_esm.F:560
mod_esmf_esm::confname
character(len=256) confname
Definition mod_esmf_esm.F:643
mod_esmf_esm::startdate
integer, dimension(6) startdate
Definition mod_esmf_esm.F:499
mod_esmf_esm::nimport
integer, dimension(:), allocatable nimport
Definition mod_esmf_esm.F:450
mod_esmf_esm::weights
type(esm_meld), dimension(:), allocatable, target weights
Definition mod_esmf_esm.F:322
mod_esmf_esm::nmodels
integer nmodels
Definition mod_esmf_esm.F:413
mod_esmf_esm::todaydatestring
character(len=44) todaydatestring
Definition mod_esmf_esm.F:505
mod_esmf_esm::sumpets
integer sumpets
Definition mod_esmf_esm.F:480
mod_esmf_esm::clabel
character(len=3), dimension(:), allocatable clabel
Definition mod_esmf_esm.F:445
mod_esmf_esm::weightesm
real(dp) weightesm
Definition mod_esmf_esm.F:325
mod_esmf_esm::cmodel
character(len=10), dimension(:), allocatable cmodel
Definition mod_esmf_esm.F:446
mod_esmf_esm::read_esmconfig
subroutine, public read_esmconfig(vm, rc)
Definition mod_esmf_esm.F:1386
mod_esmf_esm::ivpoint
integer, parameter ivpoint
Definition mod_esmf_esm.F:564
mod_esmf_esm::tol_dp
real(dp), parameter tol_dp
Definition mod_esmf_esm.F:679
mod_esmf_esm::attfilename
character(len=17), parameter attfilename
Definition mod_esmf_esm.F:666
mod_esmf_esm::petrank
integer petrank
Definition mod_esmf_esm.F:481
mod_esmf_esm::missing_r4
real(r4), parameter missing_r4
Definition mod_esmf_esm.F:676
mod_esmf_esm::ipar
integer, parameter ipar
Definition mod_esmf_esm.F:631
mod_esmf_esm::icorner
integer, parameter icorner
Definition mod_esmf_esm.F:562
mod_esmf_esm::models
type(esm_model), dimension(:), allocatable, target models
Definition mod_esmf_esm.F:360
mod_esmf_esm::clock_report
subroutine, public clock_report(model, icomp, localpet, source, rc)
Definition mod_esmf_esm.F:851
mod_esmf_esm::iconsv1
integer, parameter iconsv1
Definition mod_esmf_esm.F:578
mod_esmf_esm::report_timestamp
subroutine, public report_timestamp(field, currtime, localpet, string, rc)
Definition mod_esmf_esm.F:3869
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::ncfile
character(len=256) ncfile
Definition mod_iounits.F:318
mod_iounits::err
type(t_io), dimension(:), allocatable err
Definition mod_iounits.F:207
mod_iounits::iname
character(len=256) iname
Definition mod_iounits.F:298
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_kinds
Definition mod_kinds.F:2
mod_kinds::r4
integer, parameter r4
Definition mod_kinds.F:26
mod_kinds::r8
integer, parameter r8
Definition mod_kinds.F:28
mod_kinds::dp
integer, parameter dp
Definition mod_kinds.F:25
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::maxlen
integer, parameter maxlen
Definition mod_ncparam.F:576
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_close
subroutine, public netcdf_close(ng, model, ncid, ncname, lupdate)
Definition mod_netcdf.F:8930
mod_netcdf::nf_tout
integer, parameter nf_tout
Definition mod_netcdf.F:207
mod_netcdf::netcdf_enddef
subroutine, public netcdf_enddef(ng, model, ncname, ncid)
Definition mod_netcdf.F:9220
mod_netcdf::nf_type
integer, parameter nf_type
Definition mod_netcdf.F:198
mod_netcdf::var_dsize
integer, dimension(nvard) var_dsize
Definition mod_netcdf.F:177
mod_netcdf::var_dname
character(len=100), dimension(nvard) var_dname
Definition mod_netcdf.F:182
mod_netcdf::netcdf_create
subroutine, public netcdf_create(ng, model, ncname, ncid)
Definition mod_netcdf.F:9089
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371
mod_parallel
Definition mod_parallel.F:2
mod_parallel::initialize_parallel
subroutine, public initialize_parallel
Definition mod_parallel.F:303
mod_parallel::myrank
integer myrank
Definition mod_parallel.F:157
mod_parallel::allocate_parallel
subroutine, public allocate_parallel(ngrids)
Definition mod_parallel.F:206
mod_parallel::ocn_comm_world
integer ocn_comm_world
Definition mod_parallel.F:178
mod_param
Definition mod_param.F:2
mod_param::ngrids
integer ngrids
Definition mod_param.F:113
mod_scalars
Definition mod_scalars.F:2
mod_scalars::time_ref
real(dp) time_ref
Definition mod_scalars.F:100
mod_scalars::rclock
type(t_clock) rclock
Definition mod_scalars.F:120
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_strings
Definition mod_strings.F:2
mod_strings::rdir
character(len=256) rdir
Definition mod_strings.F:281
mod_strings::my_cpu
character(len=80) my_cpu
Definition mod_strings.F:258
mod_strings::my_os
character(len=80) my_os
Definition mod_strings.F:257
mod_strings::my_fort
character(len=80) my_fort
Definition mod_strings.F:259
mod_strings::my_fflags
character(len=512) my_fflags
Definition mod_strings.F:261
mod_strings::my_fc
character(len=80) my_fc
Definition mod_strings.F:260
stdout_mod
Definition stdout_mod.F:2
stdout_mod::stdout_unit
integer function, public stdout_unit(mymaster)
Definition stdout_mod.F:48
stdout_mod::set_stdoutunit
logical, save set_stdoutunit
Definition stdout_mod.F:41
strings_mod
Definition strings.F:2
strings_mod::uppercase
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582
strings_mod::lowercase
character(len(sinp)) function, public lowercase(sinp)
Definition strings.F:531
strings_mod::assign_string
integer function, public assign_string(a, string)
Definition strings.F:368
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
get_metadata_mod::couplingfield
Definition get_metadata.F:44
mod_esmf_esm::esm_clock
Definition mod_esmf_esm.F:95
mod_esmf_esm::esm_conn
Definition mod_esmf_esm.F:365
mod_esmf_esm::esm_cplset
Definition mod_esmf_esm.F:139
mod_esmf_esm::esm_data
Definition mod_esmf_esm.F:155
mod_esmf_esm::esm_dataset
Definition mod_esmf_esm.F:226
mod_esmf_esm::esm_field
Definition mod_esmf_esm.F:241
mod_esmf_esm::esm_meld
Definition mod_esmf_esm.F:311
mod_esmf_esm::esm_mesh
Definition mod_esmf_esm.F:281
mod_esmf_esm::esm_model
Definition mod_esmf_esm.F:334
mod_iounits::t_io
Definition mod_iounits.F:164