145 integer,
intent(out) :: rc
147 TYPE (esmf_gridcomp) :: model
151 character (len=*),
parameter :: myfile = &
152 & __FILE__//
", DATA_SetServices"
159 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetServices', &
169 CALL nuopc_compderive (model, &
170 & nuopc_setservices, &
172 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
184 CALL nuopc_compsetentrypoint (model, &
185 & methodflag=esmf_method_initialize, &
186 & phaselabellist=(/
"IPDv00p1"/), &
189 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
197 CALL nuopc_compsetentrypoint (model, &
198 & methodflag=esmf_method_initialize, &
199 & phaselabellist=(/
"IPDv00p2"/), &
202 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
216 CALL nuopc_compspecialize (model, &
217 & speclabel=nuopc_label_datainitialize, &
220 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
229 CALL nuopc_compspecialize (model, &
230 & speclabel=nuopc_label_setclock, &
233 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
241 CALL nuopc_compspecialize (model, &
242 & speclabel=nuopc_label_advance, &
245 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
255 CALL esmf_gridcompsetentrypoint (model, &
256 & methodflag=esmf_method_finalize, &
259 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
266 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetServices', &
275 & ImportState, ExportState, &
288 integer,
intent(out) :: rc
290 TYPE (esmf_gridcomp) :: model
291 TYPE (esmf_state) :: importstate
292 TYPE (esmf_state) :: exportstate
293 TYPE (esmf_clock) :: clock
297 integer :: id, ifld, localpet, nd, ng
298 integer :: icomp,
nfields, nfiles
300 character (len=100) :: coupledset, statelabel
301 character (len=240) :: standardname, shortname
303 character (len=*),
parameter :: myfile = &
304 & __FILE__//
", DATA_SetInitializeP1"
311 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetInitializeP1', &
321 CALL esmf_gridcompget (model, &
322 & localpet=localpet, &
324 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
337 IF (icomp.ne.
idata)
THEN
339 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
341 DO ng=1,
models(icomp)%Ngrids
344 coupledset=trim(
coupled(icomp)%SetLabel(ng))
346 CALL nuopc_addnestedstate (exportstate, &
347 & cplset=trim(coupledset), &
348 & nestedstatename=trim(statelabel), &
350 & exportstate(nd,icomp), &
352 IF (esmf_logfounderror(rctocheck=rc, &
353 & msg=esmf_logerr_passthru, &
355 & file=__file__))
THEN
362 shortname=
dataset(icomp)%Field(ifld)
369 & exportstate(nd,icomp), &
370 & standardname=trim(standardname), &
371 & name=trim(shortname), &
373 IF (esmf_logfounderror(rctocheck=rc, &
374 & msg=esmf_logerr_passthru, &
380 IF (localpet.eq.0)
THEN
381 WRITE (
dataout,10) trim(shortname)
394 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetInitializeP1', &
399 10
FORMAT (1x,
'DATA_SetInitializeP1 - unable to find field ''',a, &
400 &
''' in ''Models(Idata)%ExportField'' list')
406 & ImportState, ExportState, &
425 integer,
intent(out) :: rc
427 TYPE (esmf_gridcomp) :: model
428 TYPE (esmf_state) :: importstate
429 TYPE (esmf_state) :: exportstate
430 TYPE (esmf_clock) :: clock
434 integer :: is, localpet, lstr, petcount, mycomm
435 integer :: exportcount
437 real(dp) :: timeindays, time_current
439 character (len=20) :: time_currentstring
441 character (len=*),
parameter :: myfile = &
442 & __FILE__//
", DATA_SetInitializeP2"
444 TYPE (esmf_timeinterval) ::
timestep
445 TYPE (esmf_time) :: currenttime
453 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetInitializeP2', &
464 CALL esmf_gridcompget (model, &
467 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
473 CALL esmf_vmget (vm, &
474 & localpet=localpet, &
475 & petcount=petcount, &
476 & mpicommunicator=mycomm, &
478 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
496 IF (.not.
allocated(
proc))
THEN
501 IF (.not.
allocated(
cstr))
THEN
506 IF (.not.
allocated(
cend))
THEN
511 IF (.not.
allocated(
csum))
THEN
529 IF (localpet.eq.0)
THEN
534 WRITE (
dataout,10) trim(esmf_version_string), &
553 & currtime=currenttime, &
555 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
561# ifdef REGRESS_STARTCLOCK
569 CALL esmf_timeget (currenttime+
timestep, &
570 & s_r8=time_current, &
571 & timestring=time_currentstring)
572 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
581 CALL esmf_timeget (currenttime, &
582 & s_r8=time_current, &
583 & timestring=time_currentstring)
584 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
590 timeindays=(time_current- &
592 is=index(time_currentstring,
'T')
593 IF (is.gt.0) time_currentstring(is:is)=
' '
600 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
610 exportcount=ubound(
models(
idata)%ExportField, dim=1)
613 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
630 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
637 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetInitializeP2', &
642 10
FORMAT (80(
'-'),/, &
643 &
' Earth System Models Coupling: ESMF/NUOPC Library,', &
644 &
' Version ',a,/,31x,a,/, &
646 & /,1x,
'Repository Root : ',a, &
647 & /,1x,
'Operating System : ',a, &
648 & /,1x,
'CPU Hardware : ',a, &
649 & /,1x,
'Compiler System : ',a, &
650 & /,1x,
'Compiler Command : ',a, &
651 & /,1x,
'Compiler Flags : ',a, &
652 & /,1x,
'MPI communicator : ',i0,2x,
'PET size = ',i0, &
702 integer,
intent(in) :: localpet
703 integer,
intent(out) :: rc
707 TYPE (esmf_gridcomp) :: model
711 logical :: firstpass, isupdated, lmulti
713 integer :: exportcount, nfieldstotal
714 integer :: icomp,
nfields, nfiles, ifld
715 integer :: ifile, imulti, nmultifiles
718 character (len=20 ) :: fieldname, nc_vname, nc_tname
719 character (len=100) :: vunits
720 character (len=256) :: mfile, ncfile, longname
722 character (len=*),
parameter :: myfile = &
723 & __FILE__//
", DATA_Initialize"
730 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_Initialize', &
743 IF (icomp.ne.
idata)
THEN
745 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
748 IF (esmf_logfounderror(rctocheck=rc, &
749 & msg=esmf_logerr_passthru, &
762 exportcount=ubound(
models(
idata)%ExportField, dim=1)
768 IF (icomp.ne.
idata)
THEN
770 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
772 nfieldstotal=nfieldstotal+
nfields
774 dataset(icomp)%Export(ifld)%Lmulti=.false.
775 fieldname=
dataset(icomp)%Field(ifld)
779 nc_vname=trim(
models(
idata)%ExportField(id)%nc_vname)
780 nc_tname=trim(
models(
idata)%ExportField(id)%nc_tname)
782 longname=trim(
models(
idata)%ExportField(id)%long_name)
783 vunits =trim(
models(
idata)%ExportField(id)%src_units)
784 dataset(icomp)%Export(ifld)%Vdescriptor=trim(longname)
785 dataset(icomp)%Export(ifld)%Vunits=trim(vunits)
789 &
dataset(icomp)%IFS, nfiles, &
790 & lmulti, localpet, rc)
791 IF (esmf_logfounderror(rctocheck=rc, &
792 & msg=esmf_logerr_passthru, &
798 IF (localpet.eq.0)
WRITE (
dataout,10) trim(fieldname)
820 IF (icomp.ne.
idata)
THEN
822 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
825 fieldname=
dataset(icomp)%Field(ifld)
829 IF (esmf_logfounderror(rctocheck=rc, &
830 & msg=esmf_logerr_passthru, &
835 dataset(icomp)%Export(ifld)%Icomp=icomp
852 CALL data_ncread (tcurrent, firstpass, localpet, isupdated, rc)
853 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
867 IF (icomp.ne.
idata)
THEN
869 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
872 ncfile=
dataset(icomp)%Export(ifld)%ncfile
873 dataset(icomp)%Export(ifld)%Lmulti=.false.
874 ifs_loop :
DO ifile=1,nfiles
875 nmultifiles=
dataset(icomp)%IFS(ifile)%Nfiles
876 IF (nmultifiles.gt.1)
THEN
877 DO imulti=1,nmultifiles
878 mfile=
dataset(icomp)%IFS(ifile)%files(imulti)
879 IF (trim(ncfile).eq.trim(mfile))
THEN
880 dataset(icomp)%Export(ifld)%Lmulti=.true.
892 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_Initialize', &
897 10
FORMAT (/,
' DATA_Initialize - cannot find export field: ',a, &
898 & /,19x,
"in structure 'Models(Idata)%ExportField'")
899 20
FORMAT (/,
' DATA Component Processing Log:',/,1x,29(
'='),/)
1024 integer,
intent(out):: rc
1026 TYPE (esmf_gridcomp) :: model
1030 integer :: icomp,
nfields, nfiles, ifld, ig
1031 integer :: localpet, petcount
1033 integer :: mystarttime(6), mystoptime(6)
1035 real(dp) :: tmin, tmax, tstr, tend
1036 real(dp) :: time_stop
1038 character (len=22) :: calendar
1040 character (len=*),
parameter :: myfile = &
1041 & __FILE__//
", DATA_SetClock"
1043 TYPE (esmf_calkind_flag) :: caltype
1044 TYPE (esmf_clock) :: clock
1045 TYPE (esmf_vm) :: vm
1052 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetClock', &
1063 CALL esmf_gridcompget (model, &
1064 & localpet=localpet, &
1065 & petcount=petcount, &
1068 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1070 & file=myfile))
THEN
1082 caltype=esmf_calkind_gregorian
1084 CASE (
'year_360_day',
'360_day')
1085 caltype=esmf_calkind_360day
1090 & name=trim(calendar),&
1102 IF (icomp.ne.
idata)
THEN
1104 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
1107 tmin=min(tmin,
dataset(icomp)%Export(ifld)%Tmin)
1108 tmax=max(tmax,
dataset(icomp)%Export(ifld)%Tmax)
1109 tstr=min(tstr,
dataset(icomp)%Export(ifld)%Tstr)
1110 tend=max(tend,
dataset(icomp)%Export(ifld)%Tend)
1125 & yy_i=mystarttime(1), &
1126 & mm_i=mystarttime(2), &
1127 & dd_i=mystarttime(3), &
1128 & h_i =mystarttime(4), &
1129 & m_i =mystarttime(5), &
1130 & s_i =mystarttime(6))
1135 & yy=mystarttime(1), &
1136 & mm=mystarttime(2), &
1137 & dd=mystarttime(3), &
1138 & h =mystarttime(4), &
1139 & m =mystarttime(5), &
1140 & s =mystarttime(6), &
1143 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1145 & file=myfile))
THEN
1157 & yy_i=mystoptime(1), &
1158 & mm_i=mystoptime(2), &
1159 & dd_i=mystoptime(3), &
1160 & h_i =mystoptime(4), &
1161 & m_i =mystoptime(5), &
1162 & s_i =mystoptime(6))
1168 & yy=mystoptime(1), &
1169 & mm=mystoptime(2), &
1170 & dd=mystoptime(3), &
1171 & h =mystoptime(4), &
1172 & m =mystoptime(5), &
1173 & s =mystoptime(6), &
1176 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1178 & file=myfile))
THEN
1187 timefrac=max(timefrac, &
1189 & mask=
models(:)%IsActive))
1190 IF (timefrac.lt.1)
THEN
1192 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1194 & file=myfile))
THEN
1211 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1213 & file=myfile))
THEN
1223 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1225 & file=myfile))
THEN
1230 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetClock', &
1251 integer,
intent(in) :: exportcount
1252 integer,
intent(out) :: rc
1254 TYPE (esmf_gridcomp),
intent(inout) :: model
1258 integer :: icomp,
nfields, nfiles, ifld
1259 integer :: im, istr, iend, jm, jstr, jend, i, j
1260 integer :: localde, localdecount
1262 integer (i4b),
pointer :: ptrm(:,:) => null()
1264 real (dp),
pointer :: ptrx(:,:) => null()
1265 real (dp),
pointer :: ptry(:,:) => null()
1267 character (len=40) :: gridname
1269 character (len=*),
parameter :: myfile = &
1270 & __FILE__//
", DATA_SetGridArrays"
1272 TYPE (esmf_decomp_flag) :: decompflag(3)
1273 TYPE (esmf_distgrid) :: distgrid
1274 TYPE (esmf_grid) :: grid
1281 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetGridArrays', &
1295 decompflag=(/ esmf_decomp_restlast, &
1296 & esmf_decomp_restlast, &
1297 esmf_decomp_restlast /)
1302 field_loop :
DO icomp=1,
nmodels
1303 IF (icomp.ne.
idata)
THEN
1305 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
1311 im=
dataset(icomp)%Export(ifld)%Vsize(1)
1312 jm=
dataset(icomp)%Export(ifld)%Vsize(2)
1313 distgrid=esmf_distgridcreate(minindex=(/1,1/), &
1314 & maxindex=(/im,jm/), &
1316 & decompflag=decompflag(1:2), &
1318 IF (esmf_logfounderror(rctocheck=rc, &
1319 & msg=esmf_logerr_passthru, &
1321 & file=myfile))
THEN
1328 gridname=trim(
dataset(icomp)%Field(ifld))//
'_'// &
1329 & trim(
models(icomp)%name)
1330 grid=esmf_gridcreate(distgrid=distgrid, &
1331 & indexflag=esmf_index_global, &
1332 & name=trim(gridname), &
1334 IF (esmf_logfounderror(rctocheck=rc, &
1335 & msg=esmf_logerr_passthru, &
1337 & file=myfile))
THEN
1345 CALL esmf_gridget (grid, &
1346 & localdecount=localdecount, &
1348 IF (esmf_logfounderror(rctocheck=rc, &
1349 & msg=esmf_logerr_passthru, &
1351 & file=myfile))
THEN
1358 CALL esmf_gridaddcoord (grid, &
1359 & staggeredgelwidth=(/0,0/), &
1360 & staggeredgeuwidth=(/0,0/), &
1362 IF (esmf_logfounderror(rctocheck=rc, &
1363 & msg=esmf_logerr_passthru, &
1365 & file=myfile))
THEN
1371 CALL esmf_gridadditem (grid, &
1372 & itemflag=esmf_griditem_mask, &
1374 IF (esmf_logfounderror(rctocheck=rc, &
1375 & msg=esmf_logerr_passthru, &
1377 & file=myfile))
THEN
1380 dataset(icomp)%export(ifld)%LandValue=0
1381 dataset(icomp)%export(ifld)%SeaValue=1
1386 de_loop :
DO localde=0,localdecount-1
1387 CALL esmf_gridgetcoord (grid, &
1388 & localde=localde, &
1392 IF (esmf_logfounderror(rctocheck=rc, &
1393 & msg=esmf_logerr_passthru, &
1395 & file=myfile))
THEN
1399 CALL esmf_gridgetcoord (grid, &
1400 & localde=localde, &
1404 IF (esmf_logfounderror(rctocheck=rc, &
1405 & msg=esmf_logerr_passthru, &
1407 & file=myfile))
THEN
1411 CALL esmf_gridgetitem (grid, &
1412 & localde=localde, &
1413 & itemflag=esmf_griditem_mask, &
1416 IF (esmf_logfounderror(rctocheck=rc, &
1417 & msg=esmf_logerr_passthru, &
1419 & file=myfile))
THEN
1432 ptrx(i,j)=
dataset(icomp)%Export(ifld)%lon(i,j)
1433 ptry(i,j)=
dataset(icomp)%Export(ifld)%lat(i,j)
1434 ptrm(i,j)=int(
dataset(icomp)%Export(ifld)%mask(i,j))
1440 dataset(icomp)%export(ifld)%grid=grid
1444 IF (
associated(ptrx) )
nullify (ptrx)
1445 IF (
associated(ptry) )
nullify (ptry)
1446 IF (
associated(ptrm) )
nullify (ptrm)
1467 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetGridArrays', &
1487 integer,
intent(out) :: rc
1489 TYPE (esmf_gridcomp),
intent(inout) :: model
1493 integer :: icomp,
nfields, nfiles, ifld, nd, ng
1494 integer :: localde, localdecount, localpet
1495 integer :: exportcount
1497 real (dp),
dimension(:,:),
pointer :: ptr2d => null()
1499 character (len=10) :: attlist(1)
1500 character (len=20) :: fieldname
1502 character (len=*),
parameter :: myfile = &
1503 & __FILE__//
", DATA_SetStates"
1505 character (ESMF_MAXSTR),
allocatable :: exportnamelist(:)
1507 TYPE (esmf_arrayspec) :: arrayspec
1508 TYPE (esmf_field) :: field
1509 TYPE (esmf_staggerloc) :: staggerloc
1510 TYPE (esmf_vm) :: vm
1517 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_SetStates', &
1527 CALL esmf_gridcompget (model, &
1528 & localpet=localpet, &
1531 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1533 & file=myfile))
THEN
1541 CALL esmf_arrayspecset (arrayspec, &
1542 & typekind=esmf_typekind_r8, &
1545 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1547 & file=myfile))
THEN
1550 staggerloc=esmf_staggerloc_center
1558 field_loop :
DO icomp=1,
nmodels
1559 IF (icomp.ne.
idata)
THEN
1561 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
1563 DO ng=1,
models(icomp)%Ngrids
1571 & exportstate(nd,icomp), &
1572 & itemcount=exportcount, &
1574 IF (esmf_logfounderror(rctocheck=rc, &
1575 & msg=esmf_logerr_passthru, &
1577 & file=myfile))
THEN
1584 IF (.not.
allocated(exportnamelist))
THEN
1585 allocate ( exportnamelist(exportcount) )
1588 & exportstate(nd,icomp), &
1589 & itemnamelist=exportnamelist, &
1591 IF (esmf_logfounderror(rctocheck=rc, &
1592 & msg=esmf_logerr_passthru, &
1594 & file=myfile))
THEN
1601 fieldname=
dataset(icomp)%Field(ifld)
1604 & exportstate(nd,icomp), &
1605 & fieldname=trim(fieldname), &
1610 field=esmf_fieldcreate(
dataset(icomp)% &
1611 & export(ifld)%grid, &
1613 & indexflag=esmf_index_global, &
1614 & staggerloc=staggerloc, &
1615 & name=trim(fieldname), &
1617 IF (esmf_logfounderror(rctocheck=rc, &
1618 & msg=esmf_logerr_passthru, &
1620 & file=myfile))
THEN
1628 CALL esmf_gridget (
dataset(icomp)% &
1629 & export(ifld)%grid, &
1630 & localdecount=localdecount, &
1632 IF (esmf_logfounderror(rctocheck=rc, &
1633 & msg=esmf_logerr_passthru, &
1635 & file=myfile))
THEN
1639# ifdef TIME_INTERP_NOT_WORKING
1644 CALL esmf_attributeadd (field, &
1645 & convention=
'ESMF', &
1646 & purpose=
'General', &
1648 IF (esmf_logfounderror(rctocheck=rc, &
1649 & msg=esmf_logerr_passthru, &
1651 & file=myfile))
THEN
1655 attlist(1)=
'TimeInterp'
1656 CALL esmf_attributeadd (field, &
1657 & convention=
'CustomConvention', &
1658 & purpose=
'General', &
1660 & attrlist=attlist, &
1661 & nestconvention=
'ESMF', &
1662 & nestpurpose=
'General', &
1664 IF (esmf_logfounderror(rctocheck=rc, &
1665 & msg=esmf_logerr_passthru, &
1667 & file=myfile))
THEN
1671 CALL esmf_attributelink (exportstate, field, rc=rc)
1672 IF (esmf_logfounderror(rctocheck=rc, &
1673 & msg=esmf_logerr_passthru, &
1675 & file=myfile))
THEN
1683 DO localde=0,localdecount-1
1684 CALL esmf_fieldget (field, &
1685 & localde=localde, &
1686 & farrayptr=ptr2d, &
1688 IF (esmf_logfounderror(rctocheck=rc, &
1689 & msg=esmf_logerr_passthru, &
1691 & file=myfile))
THEN
1702 IF (
associated(ptr2d) )
nullify (ptr2d)
1708 & exportstate(nd,icomp), &
1711 IF (esmf_logfounderror(rctocheck=rc, &
1712 & msg=esmf_logerr_passthru, &
1714 & file=myfile))
THEN
1727 dataset(icomp)%export(ifld)%field=field
1733 IF (localpet.eq.0)
THEN
1734 WRITE (
dataout,10) trim(fieldname), &
1735 &
'Export State: ', &
1740 & exportstate(nd,icomp),&
1741 & (/ trim(fieldname) /), &
1743 IF (esmf_logfounderror(rctocheck=rc, &
1744 & msg=esmf_logerr_passthru, &
1746 & file=myfile))
THEN
1756 IF (
allocated(exportnamelist) )
THEN
1757 deallocate (exportnamelist)
1764 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_SetStates', &
1769 10
FORMAT (1x,
'DATA_SetStates - Removing field ''',a,
''' from ',a, &
1770 &
'''',a,
'''',/,18x,
'because it is not connected.')
1789 integer,
intent(out) :: rc
1791 TYPE (esmf_gridcomp) :: model
1795 logical :: firstpass, isupdated, lreport
1797 integer :: mytask, petcount, is, localpet, phase
1799 real (dp) :: couplinginterval, runinterval
1800 real (dp) :: tcurrentinseconds, tstopinseconds
1801 real (dp) :: tcurrentindays
1803 character (len=22) :: cinterval
1804 character (len=22) :: currtimestring, stoptimestring
1806 character (len=*),
parameter :: myfile = &
1807 & __FILE__//
", DATA_ModelAdvance"
1809 TYPE (esmf_clock) :: clock
1810 TYPE (esmf_state) :: exportstate, importstate
1811 TYPE (esmf_time) :: referencetime
1812 TYPE (esmf_time) :: starttime, stoptime
1813 TYPE (esmf_timeinterval) :: timefrom, timeto,
timestep
1814 TYPE (esmf_vm) :: vm
1821 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_ModelAdvance', &
1833 CALL esmf_gridcompget (model, &
1834 & importstate=importstate, &
1835 & exportstate=exportstate, &
1837 & localpet=localpet, &
1838 & petcount=petcount, &
1839 & currentphase=phase, &
1842 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1844 & file=myfile))
THEN
1851 CALL esmf_clockget (clock, &
1853 & stoptime=stoptime, &
1854 & reftime=referencetime, &
1857 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1859 & file=myfile))
THEN
1866 & s_r8=tcurrentinseconds, &
1867 & timestringisofrac=currtimestring, &
1869 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1871 & file=myfile))
THEN
1874 is=index(currtimestring,
'T')
1875 IF (is.gt.0) currtimestring(is:is)=
' '
1880 & s_r8=tstopinseconds, &
1881 & timestringisofrac=stoptimestring, &
1883 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1885 & file=myfile))
THEN
1888 is=index(stoptimestring,
'T')
1889 IF (is.gt.0) stoptimestring(is:is)=
' '
1893 CALL esmf_timeintervalget (
timestep, &
1894 & s_r8=couplinginterval, &
1896 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1898 & file=myfile))
THEN
1906 IF (localpet.eq.0)
THEN
1907 WRITE (cinterval,
'(f15.2)') couplinginterval
1908 WRITE (
dataout,10) trim(currtimestring), trim(stoptimestring), &
1909 & phase, trim(adjustl(cinterval))
1916# ifdef REGRESS_STARTCLOCK
1925 tcurrentindays=(tcurrentinseconds+couplinginterval- &
1932 tcurrentindays=(tcurrentinseconds- &
1935 CALL data_ncread (tcurrentindays, firstpass, localpet, isupdated, &
1937 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1939 & file=myfile))
THEN
1955 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1957 & file=myfile))
THEN
1973 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1975 & file=myfile))
THEN
1981 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_ModelAdvance', &
1986 10
FORMAT (3x,
'ModelAdvance - ESMF, Running DATA:',t42,a, &
1987 &
' => ',a,
', Phase: ',i1,
' [',a,
' s]')
2092 logical,
intent(in) :: lreport
2094 integer,
intent(out) :: rc
2096 TYPE (esmf_gridcomp) :: model
2100 logical :: ispresent
2102 integer :: exportcount, localpet, petcount
2103 integer :: localde, localdecount
2107 integer :: icomp,
nfields, nfiles, nvdim, ifld, is, nd, ng
2108 integer :: istr, iend, jstr, jend, kstr, kend, i, j, k
2109 integer :: tindex, id
2110 integer :: currdate(9)
2111 integer :: mydatevec(9)
2114 integer,
save :: record = 0
2116 integer,
parameter :: inlm = 1
2119 real (dp) :: timeindays, time_current
2120 real (dp) :: tintrp, tmin, tmax, tstr, tend, vtime
2121 real (dp) :: fmin(1), fmax(1), myfmin(1), myfmax(1), fval
2122 real (dp) :: myattvalues(14)
2124 real (dp),
pointer :: ptr2d(:,:) => null()
2125 real (dp),
pointer :: ptr3d(:,:,:) => null()
2127 character (len=20) :: shortname
2129 character (len=20) :: myshortname(1,1)
2130 character (len=22) :: mydatestring(1,1,1)
2132 character (len=22) :: mydate, time_currentstring
2133 character (len=40) :: attname
2135 character (len=*),
parameter :: myfile = &
2136 & __FILE__//
", DATA_Export"
2138 character (ESMF_MAXSTR) :: cname, ofile
2140 TYPE (esmf_attpack) :: attpack
2141 TYPE (esmf_clock) :: clock
2142 TYPE (esmf_field) :: field
2143 TYPE (esmf_time) :: currenttime
2144 TYPE (esmf_timeinterval) ::
timestep
2145 TYPE (esmf_vm) :: vm
2152 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_Export', &
2165 CALL esmf_gridcompget (model, &
2167 & localpet=localpet, &
2168 & petcount=petcount, &
2172 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2174 & file=myfile))
THEN
2182 CALL esmf_clockget (clock, &
2184 & currtime=currenttime, &
2186 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2188 & file=myfile))
THEN
2194 CALL esmf_timeget (currenttime, &
2202 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2204 & file=myfile))
THEN
2208 CALL esmf_timeget (currenttime, &
2209 & s_r8=time_current, &
2210 & timestring=time_currentstring, &
2212 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2214 & file=myfile))
THEN
2218# ifdef REGRESS_STARTCLOCK
2225 timeindays=(time_current+ &
2232 timeindays=(time_current- &
2235 is=index(time_currentstring,
'T')
2236 IF (is.gt.0) time_currentstring(is:is)=
' '
2247 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2249 & file=myfile))
THEN
2268 field_loop :
DO icomp=1,
nmodels
2269 IF (icomp.ne.
idata)
THEN
2271 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
2273 DO ng=1,
models(icomp)%Ngrids
2277 nvdim=
dataset(icomp)%Export(ifld)%Nvdim
2278 shortname=
dataset(icomp)%Field(ifld)
2288 & exportstate(nd,icomp), &
2289 & trim(shortname), &
2292 IF (esmf_logfounderror(rctocheck=rc, &
2293 & msg=esmf_logerr_passthru, &
2295 & file=myfile))
THEN
2303 CALL esmf_gridget (
dataset(icomp)%Export(ifld)%grid, &
2304 & localdecount=localdecount, &
2306 IF (esmf_logfounderror(rctocheck=rc, &
2307 & msg=esmf_logerr_passthru, &
2309 & file=myfile))
THEN
2316 de_loop :
DO localde=0,localdecount-1
2317 IF (nvdim.eq.2)
THEN
2318 CALL esmf_fieldget (field, &
2319 & localde=localde, &
2320 & farrayptr=ptr2d, &
2322 IF (esmf_logfounderror(rctocheck=rc, &
2323 & msg=esmf_logerr_passthru, &
2325 & file=myfile))
THEN
2329 ELSE IF (nvdim.eq.3)
THEN
2330 CALL esmf_fieldget (field, &
2331 & localde=localde, &
2332 & farrayptr=ptr3d, &
2334 IF (esmf_logfounderror(rctocheck=rc, &
2335 & msg=esmf_logerr_passthru, &
2337 & file=myfile))
THEN
2348 IF (nvdim.eq.2)
THEN
2349 istr=lbound(ptr2d,1)
2350 iend=ubound(ptr2d,1)
2351 jstr=lbound(ptr2d,2)
2352 jend=ubound(ptr2d,2)
2353 tindex=
dataset(icomp)%Export(ifld)%Tindex
2355 fval=
dataset(icomp)%Export(ifld)% &
2356 & a2dg(istr,jstr,tindex)
2358 fval=
dataset(icomp)%Export(ifld)% &
2366 fval=
dataset(icomp)%Export(ifld)% &
2369 fval=
dataset(icomp)%Export(ifld)% &
2372 myfmin(1)=min(myfmin(1),fval)
2373 myfmax(1)=max(myfmax(1),fval)
2377 IF (
associated(ptr2d))
nullify (ptr2d)
2378 ELSE IF (nvdim.eq.3)
THEN
2379 istr=lbound(ptr3d,1)
2380 iend=ubound(ptr3d,1)
2381 jstr=lbound(ptr3d,2)
2382 jend=ubound(ptr3d,2)
2383 kstr=lbound(ptr3d,3)
2384 kend=ubound(ptr3d,3)
2385 tindex=
dataset(icomp)%Export(ifld)%Tindex
2387 fval=
dataset(icomp)%Export(ifld)% &
2388 & a3dg(istr,jstr,kstr,tindex)
2390 fval=
dataset(icomp)%Export(ifld)% &
2391 & a3d(istr,jstr,kstr)
2399 fval=
dataset(icomp)%Export(ifld)% &
2400 & a3dg(i,j,k,tindex)
2402 fval=
dataset(icomp)%Export(ifld)% &
2405 myfmin(1)=min(myfmin(1),fval)
2406 myfmax(1)=max(myfmax(1),fval)
2411 IF (
associated(ptr3d))
nullify (ptr3d)
2417 CALL esmf_vmallreduce (vm, &
2418 & senddata=myfmin, &
2421 & reduceflag=esmf_reduce_min, &
2423 IF (esmf_logfounderror(rctocheck=rc, &
2424 & msg=esmf_logerr_passthru, &
2426 & file=myfile))
THEN
2430 CALL esmf_vmallreduce (vm, &
2431 & senddata=myfmax, &
2434 & reduceflag=esmf_reduce_max, &
2436 IF (esmf_logfounderror(rctocheck=rc, &
2437 & msg=esmf_logerr_passthru, &
2439 & file=myfile))
THEN
2448 tmin =
dataset(icomp)%Export(ifld)%Tmin
2449 tmax =
dataset(icomp)%Export(ifld)%Tmax
2450 tstr =
dataset(icomp)%Export(ifld)%Tstr
2451 tend =
dataset(icomp)%Export(ifld)%Tend
2452 tintrp=
dataset(icomp)%Export(ifld)%Tintrp(tindex)
2453 vtime =
dataset(icomp)%Export(ifld)%Vtime(tindex)
2454 mydate=
dataset(icomp)%Export(ifld)%DateString(tindex)
2456 models(icomp)%ImportField(id)%Tmin=tmin
2457 models(icomp)%ImportField(id)%Tmax=tmax
2458 models(icomp)%ImportField(id)%Tstr=tstr
2459 models(icomp)%ImportField(id)%Tend=tend
2460 models(icomp)%ImportField(id)%Tindex=tindex
2461 models(icomp)%ImportField(id)%Tintrp(tindex)=tintrp
2462 models(icomp)%ImportField(id)%Vtime(tindex)=vtime
2463 models(icomp)%ImportField(id)%DateString(tindex)=mydate
2472 myshortname(1,1)=trim(shortname)
2480 rc=esmf_rc_file_write
2487 & (/icomp,id,record/), &
2491 rc=esmf_rc_file_write
2495 mydatestring(1,1,1)=mydate
2499 & (/1,icomp,id,record/), &
2503 rc=esmf_rc_file_write
2510 & (/icomp,id,record/), &
2514 rc=esmf_rc_file_write
2521 & (/icomp,id,record/), &
2525 rc=esmf_rc_file_write
2532 & (/icomp,id,record/), &
2536 rc=esmf_rc_file_write
2543 & (/icomp,id,record/), &
2547 rc=esmf_rc_file_write
2554 & (/icomp,id,record/), &
2558 rc=esmf_rc_file_write
2565 & (/icomp,id,record/), &
2569 rc=esmf_rc_file_write
2576 & (/icomp,id,record/), &
2580 rc=esmf_rc_file_write
2592 mydatevec(i)=int(
dataset(icomp)%Export(ifld)% &
2596 CALL esmf_attributeset (field, &
2597 & name=
'TimeStamp', &
2599 & valuelist=mydatevec, &
2601 & valuelist=currdate, &
2603 & convention=
'NUOPC', &
2604 & purpose=
'Instance', &
2606 IF (esmf_logfounderror(rctocheck=rc, &
2607 & msg=esmf_logerr_passthru, &
2609 & file=myfile))
THEN
2613# ifdef TIME_INTERP_NOT_WORKING
2617 myattvalues( 1)=real(mydatevec(1), dp)
2618 myattvalues( 2)=real(mydatevec(2), dp)
2619 myattvalues( 3)=real(mydatevec(3), dp)
2620 myattvalues( 4)=real(mydatevec(4), dp)
2621 myattvalues( 5)=real(mydatevec(5), dp)
2622 myattvalues( 6)=real(mydatevec(6), dp)
2623 myattvalues( 7)=real(tindex, dp)
2624 myattvalues( 8)=tstr
2625 myattvalues( 9)=timeindays
2626 myattvalues(10)=tend
2627 myattvalues(11)=tintrp
2628 myattvalues(12)=vtime
2629 myattvalues(13)=tmin
2630 myattvalues(14)=tmax
2634 CALL esmf_attributegetattpack (field, &
2635 &
'CustomConvention', &
2638 & attpack=attpack, &
2639 & ispresent=ispresent, &
2641 IF (esmf_logfounderror(rctocheck=rc, &
2642 & msg=esmf_logerr_passthru, &
2644 & file=myfile))
THEN
2650 CALL esmf_attributeset (field, &
2651 & name=
'TimeInterp', &
2652 & valuelist=myattvalues, &
2653 & attpack=attpack, &
2655 IF (esmf_logfounderror(rctocheck=rc, &
2656 & msg=esmf_logerr_passthru, &
2658 & file=myfile))
THEN
2663 IF (lreport.and.(localpet.eq.0))
THEN
2664 WRITE (
dataout,20) trim(shortname), &
2666 & ctarget(ifld)), ng, &
2669 & fmin(1), fmax(1), tindex
2671 & trim(time_currentstring), &
2679 CALL esmf_fieldprint(field, &
2681 IF (esmf_logfounderror(rctocheck=rc, &
2682 & msg=esmf_logerr_passthru, &
2684 & file=myfile))
THEN
2692 &
models(
idata)%ExportField(ifld)%debug_write)
THEN
2693 WRITE (ofile,30)
'data_export', trim(shortname), &
2699 CALL esmf_fieldwrite (field, &
2701 & variablename=trim(shortname), &
2702 & overwrite = .true., &
2704 IF (esmf_logfounderror(rctocheck=rc, &
2705 & msg=esmf_logerr_passthru, &
2707 & file=myfile))
THEN
2728 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_Export', &
2733 10
FORMAT (i4.4,
'-',i2.2,
'-',i2.2,1x,i2.2,
':',i2.2,
':',a)
2734 20
FORMAT (3x,
' DATA_Export - ESMF: exporting ''',a,
'''', &
2735 & t50,
'-> ''',a,
''' Grid ',i2.2,
',',t72,a,/ 19x, &
2737 &
'(Dmin= ', 1p,e15.8,0p,
' Dmax = ',1p,e15.8,0p, &
2738 &
' SnapshotIndex = ',i1,
')')
2740 &
'(DMin= ', 1p,e15.8,0p,
' Dmax= ',1p,e15.8,0p,
')')
2742 30
FORMAT (a,
'_',a,
'_',i4.4,2(
'-',i2.2),
'_',i2.2,2(
'.',i2.2),
'.nc')
2776 integer,
intent(in) :: localpet
2777 integer,
intent(out) :: rc
2779 real(dp),
intent(in) :: tcurrent
2783 integer :: icomp,
nfields, nfiles, nvdim, ifld
2784 integer :: tindex, it1, it2
2785 integer :: im, jm, km, i, j, k
2787 real(dp) :: tstr, tend, tmin, tmax
2788 real(dp) :: tintrp(2)
2789 real(dp) :: dayscale, fac, fac1, fac2, w1, w2
2792 character (len=100) :: vname
2794 character (len=*),
parameter :: myfile = &
2795 & __FILE__//
", DATA_TimeInterp"
2802 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_TimeInterp', &
2812 field_loop :
DO icomp=1,
nmodels
2813 IF (icomp.ne.
idata)
THEN
2815 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
2818 nvdim=
dataset(icomp)%Export(ifld)%Nvdim
2822 vname =
dataset(icomp)%Export(ifld)%Vname
2823 tmin =
dataset(icomp)%Export(ifld)%Tmin
2824 tmax =
dataset(icomp)%Export(ifld)%Tmax
2825 tstr =
dataset(icomp)%Export(ifld)%Tstr
2826 tend =
dataset(icomp)%Export(ifld)%Tend
2827 tindex =
dataset(icomp)%Export(ifld)%Tindex
2828 tintrp(1)=
dataset(icomp)%Export(ifld)%Tintrp(1)
2829 tintrp(2)=
dataset(icomp)%Export(ifld)%Tintrp(2)
2835 dayscale=86400.0_dp*1000.0_dp
2838 fac1=anint((tintrp(it2)-tcurrent)*dayscale)
2839 fac2=anint((tcurrent-tintrp(it1))*dayscale)
2843 IF (((fac1*fac2).ge.0.0_dp).and. &
2844 & ((fac1+fac2).gt.0.0_dp))
THEN
2845 fac=1.0_dp/(fac1+fac2)
2848 IF (nvdim.eq.2)
THEN
2849 im=
dataset(icomp)%Export(ifld)%Vsize(1)
2850 jm=
dataset(icomp)%Export(ifld)%Vsize(2)
2851 IF (.not.
allocated(
dataset(icomp)% &
2852 & export(ifld)%A2d))
THEN
2854 & export(ifld)%A2d(im,jm) )
2858 fval=w1*
dataset(icomp)%Export(ifld)% &
2860 & w2*
dataset(icomp)%Export(ifld)% &
2862 dataset(icomp)%Export(ifld)%A2d(i,j)=fval
2865 ELSE IF (nvdim.eq.3)
THEN
2866 im=
dataset(icomp)%Export(ifld)%Vsize(1)
2867 jm=
dataset(icomp)%Export(ifld)%Vsize(2)
2868 km=
dataset(icomp)%Export(ifld)%Vsize(3)
2869 IF (.not.
allocated(
dataset(icomp)% &
2870 & export(ifld)%A3d))
THEN
2872 & export(ifld)%A3d(im,jm,km) )
2877 fval=w1*
dataset(icomp)%Export(ifld)% &
2878 & a3dg(i,j,k,it1)+ &
2879 & w2*
dataset(icomp)%Export(ifld)% &
2881 dataset(icomp)%Export(ifld)%A3d(i,j,k)=fval
2890 IF (localpet.eq.0)
THEN
2891 WRITE (
dataout,10) trim(vname), tcurrent, &
2894 & tintrp(it1), tintrp(it2), &
2900 rc=esmf_rc_val_outofrange
2910 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_TimeInterp', &
2915 10
FORMAT (/,
' DATA_TimeInterp - current coupling time', &
2916 &
' exceeds ending value for variable: ',a, &
2917 & /,14x,
'Tcurrent = ',f15.4, &
2918 & /,14x,
'Data Tmin = ',f15.4,2x,
'Data Tmax = ',f15.4, &
2919 & /,14x,
'Data Tstr = ',f15.4,2x,
'Data Tend = ',f15.4, &
2920 & /,14x,
'TINTRP1 = ',f15.4,2x,
'TINTRP2 = ',f15.4, &
2921 & /,14x,
'FAC1 = ',f15.4,2x,
'FAC2 = ',f15.4)
2967 logical,
intent(in) :: firstpass
2968 logical,
intent(out) :: isupdated
2970 integer,
intent(in) :: localpet
2971 integer,
intent(out) :: rc
2973 real(dp),
intent(in) :: tcurrent
2977 logical :: lcycle, linquire, lmulti, lzl, reclast
2979 integer :: icomp, ndims,
nfields, nfiles, nvdim, zl, ifld
2980 integer :: ncid, tid, vid
2981 integer :: nrec, tindex, trec
2982 integer :: nx, ny, nz, i
2983 integer :: lend, lstr, lvar
2985 integer :: mydatevec(5)
2987 integer,
parameter :: imodel = 1
2988 integer,
parameter :: ng = 1
2990 real(r8) :: vmax, vmin
2992 real(dp) :: clength, tdelta, tmax, tmin, tmono, tscale, tsec, tval
2993 real(dp) :: myseconds
2994 real(dp) :: v_time(2)
2996 character (len=15 ) :: zlabel
2997 character (len=20 ) :: ctarget, nc_vname, nc_tname, shortname
2998 character (len=22 ) :: tcode
2999 character (len=100) :: t_name, v_name, vunits
3000 character (len=256) :: ncname, longname
3002 character (len=*),
parameter :: myfile = &
3003 & __FILE__//
", DATA_ncread"
3010 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_ncread', &
3026 field_loop :
DO icomp=1,
nmodels
3027 IF (icomp.ne.
idata)
THEN
3029 IF (
models(icomp)%IsActive.and.(nfiles.gt.0))
THEN
3041 lcycle =
dataset(icomp)%Export(ifld)%Lcycle
3042 lmulti =
dataset(icomp)%Export(ifld)%Lmulti
3043 reclast=
dataset(icomp)%Export(ifld)%LastRec
3044 tmax =
dataset(icomp)%Export(ifld)%Tmax
3045 tmono =
dataset(icomp)%Export(ifld)%Tmono
3047 linquire=lmulti.and. &
3048 & (reclast.or.(.not.lcycle.and.(tmax.lt.tcurrent)))
3057 &
dataset(icomp)%IFS, nfiles, &
3058 & lmulti, localpet, rc)
3059 IF (esmf_logfounderror(rctocheck=rc, &
3060 & msg=esmf_logerr_passthru, &
3062 & file=myfile))
THEN
3066 dataset(icomp)%Export(ifld)%LastRec=.false.
3074 IF ((tmono.le.tcurrent).or.firstpass)
THEN
3078 ctarget =
dataset(icomp)%Ctarget(ifld)
3079 ncname =
dataset(icomp)%Export(ifld)%ncfile
3080 t_name =
dataset(icomp)%Export(ifld)%Tname
3081 v_name =
dataset(icomp)%Export(ifld)%Vname
3082 shortname=
dataset(icomp)%Field(ifld)
3083 longname =
dataset(icomp)%Export(ifld)%Vdescriptor
3084 vunits =
dataset(icomp)%Export(ifld)%Vunits
3085 ncid =
dataset(icomp)%Export(ifld)%ncid
3086 vid =
dataset(icomp)%Export(ifld)%Vid
3087 tid =
dataset(icomp)%Export(ifld)%Tid
3088 tindex =
dataset(icomp)%Export(ifld)%Tindex
3089 nrec =
dataset(icomp)%Export(ifld)%Nrec
3090 trec =
dataset(icomp)%Export(ifld)%Trec
3091 tscale =
dataset(icomp)%Export(ifld)%Tscale
3092 clength =
dataset(icomp)%Export(ifld)%Clength
3093 tmin =
dataset(icomp)%Export(ifld)%Tmin
3094 v_time(1)=
dataset(icomp)%Export(ifld)%Vtime(1)
3095 v_time(2)=
dataset(icomp)%Export(ifld)%Vtime(2)
3100 trec=mod(trec,nrec)+1
3104 dataset(icomp)%Export(ifld)%Trec=trec
3110 IF (trec.le.nrec)
THEN
3116 dataset(icomp)%Export(ifld)%Tindex=tindex
3125 & start = (/trec/), &
3129 IF (localpet.eq.0)
WRITE (
dataout,10) trim(t_name), &
3132 rc=esmf_rc_file_read
3142 IF ((trec.eq.nrec).and.(tval.le.tcurrent))
THEN
3143 dataset(icomp)%Export(ifld)%LastRec=.true.
3151 nvdim=
dataset(icomp)%Export(ifld)%Nvdim
3152 ndims=
SIZE(
dataset(icomp)%Export(ifld)%Vsize)-1
3154 IF ((nvdim.eq.2).and.(ndims.eq.2))
THEN
3155 nx=
dataset(icomp)%Export(ifld)%Vsize(1)
3156 ny=
dataset(icomp)%Export(ifld)%Vsize(2)
3157 IF (.not.
allocated(
dataset(icomp)% &
3158 & export(ifld)%A2dG))
THEN
3160 & export(ifld)%A2dG(nx,ny,2) )
3166 &
dataset(icomp)%Export(ifld)%A2dG(:,:,tindex), &
3168 & start = (/1,1,trec/), &
3169 & total = (/nx,ny,1/), &
3174 IF (localpet.eq.0) &
3175 &
WRITE (
dataout,10) trim(v_name), trec, &
3177 rc=esmf_rc_file_read
3180 dataset(icomp)%Export(ifld)%Vmin=vmin
3181 dataset(icomp)%Export(ifld)%Vmax=vmax
3182 ELSE IF ((nvdim.eq.2).and.(ndims.eq.3))
THEN
3183 nx=
dataset(icomp)%Export(ifld)%Vsize(1)
3184 ny=
dataset(icomp)%Export(ifld)%Vsize(2)
3185 zl=
dataset(icomp)%Export(ifld)%Zlevel
3186 IF (.not.
allocated(
dataset(icomp)% &
3187 & export(ifld)%A2dG))
THEN
3189 & export(ifld)%A2dG(nx,ny,2) )
3195 &
dataset(icomp)%Export(ifld)%A2dG(:,:,tindex), &
3197 & start = (/1,1,zl,trec/), &
3198 & total = (/nx,ny,1,1/), &
3203 IF (localpet.eq.0) &
3204 WRITE (
dataout,10) trim(v_name), trec, &
3206 rc=esmf_rc_file_read
3209 dataset(icomp)%Export(ifld)%Vmin=vmin
3210 dataset(icomp)%Export(ifld)%Vmax=vmax
3211 WRITE (zlabel,
'(a,i2.2)')
'Level = ', zl
3213 ELSE IF ((nvdim.eq.3).and.(ndims.eq.3))
THEN
3214 nx=
dataset(icomp)%Export(ifld)%Vsize(1)
3215 ny=
dataset(icomp)%Export(ifld)%Vsize(2)
3216 nz=
dataset(icomp)%Export(ifld)%Vsize(3)
3217 IF (.not.
allocated(
dataset(icomp)% &
3218 & export(ifld)%A3dG))
THEN
3220 & export(ifld)%A3dG(nx,ny,nz,2) )
3226 &
dataset(icomp)%Export(ifld)%A3dG(:,:,:,tindex), &
3228 & start = (/1,1,1,trec/), &
3229 & total = (/nx,ny,nz,1/), &
3234 IF (localpet.eq.0) &
3235 &
WRITE (
dataout,10) trim(v_name), trec, &
3237 rc=esmf_rc_file_read
3240 dataset(icomp)%Export(ifld)%Vmin=vmin
3241 dataset(icomp)%Export(ifld)%Vmax=vmax
3244 & yy_i = mydatevec(1), &
3245 & mm_i = mydatevec(2), &
3246 & dd_i = mydatevec(3), &
3247 & h_i = mydatevec(4), &
3248 & m_i = mydatevec(5), &
3251 dataset(icomp)%Export(ifld)%Date(i,tindex)= &
3252 & real(mydatevec(i),dp)
3254 dataset(icomp)%Export(ifld)%Date(6,tindex)=myseconds
3256 lstr=scan(ncname,
'/',back=.true.)+1
3257 lend=len_trim(ncname)
3258 lvar=min(43,len_trim(longname))
3259 tsec=tval*86400.0_dp
3261 dataset(icomp)%Export(ifld)%DateString(tindex)=tcode
3262 IF (localpet.eq.0)
THEN
3264 WRITE (
dataout,20) trim(v_name), tcode, &
3265 & trim(shortname), &
3267 & trim(vunits), trim(ctarget), &
3269 & ncname(lstr:lend), &
3270 & tmin, tmax, tval, vmin, vmax, &
3273 WRITE (
dataout,30) trim(v_name), tcode, &
3274 & trim(shortname), &
3276 & trim(vunits), trim(ctarget), &
3278 & ncname(lstr:lend), &
3279 & tmin, tmax, tval, vmin, vmax
3289 tdelta=v_time(tindex)-v_time(3-tindex)
3290 IF (lcycle.and.(tdelta.lt.0.0_dp))
THEN
3291 tdelta=tdelta+clength
3294 dataset(icomp)%Export(ifld)%Tmono=tmono
3295 dataset(icomp)%Export(ifld)%Tintrp(tindex)=tmono
3296 dataset(icomp)%Export(ifld)%Vtime(tindex)=tval
3304 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_ncread', &
3309 10
FORMAT (/,
' DATA_ncread - error while reading variable: ',a,2x, &
3310 &
' at TIME record = ',i7,/,15x,
'in file: ',a)
3311 20
FORMAT (3x,
' DATA_ncread - ESMF: reading ''',a,
''',',t68,a,/, &
3312 & 7x,17x,
'''',a,
''': ',a,2x,
'(',a,
')',/,2x,17x, &
3313 &
'(Target: ',a,
', Rec=',i7.7,
', SnapshotIndex=',i1, &
3314 &
', File: ',a,
')',/,19x, &
3315 &
'(Tmin= ', f15.4,
' Tmax= ', f15.4,
')', &
3316 & t71,
't = ', f15.4 ,/, 19x, &
3317 &
'(Dmin= ', 1p,e15.8,0p,
' Dmax= ',1p,e15.8,0p,
')', &
3319 30
FORMAT (3x,
' DATA_ncread - ESMF: reading ''',a,
''',',t68,a,/, &
3320 & 7x,17x,
'''',a,
''': ',a,2x,
'(',a,
')',/,2x,17x, &
3321 &
'(Target: ',a,
', Rec=',i7.7,
', SnapshotIndex=',i1, &
3322 &
', File: ',a,
')',/,19x, &
3323 &
'(Tmin= ', f15.4,
' Tmax= ', f15.4,
')', &
3324 & t71,
't = ', f15.4 ,/, 19x, &
3325 &
'(Dmin= ', 1p,e15.8,0p,
' Dmax= ',1p,e15.8,0p,
')')
3364 integer,
intent(in) :: nfiles, localpet
3365 integer,
intent(out) :: rc
3367 real (dp) :: tcurrent
3369 TYPE(
t_io),
intent(inout) :: ifs(nfiles)
3373 logical :: lcheck, foundit
3375 integer :: fcount, mfiles, i, ifile, lstr
3377 real(dp) :: timestrday, timeendday
3378 real(dp) :: timestrsec, timeendsec
3379 real(dp) :: tmax, tmin, tscale
3381 character (len=1),
parameter :: blank =
' '
3382 character (len= 22) ::
f_code,
i_code, tmin_code, tmax_code
3383 character (len=256) :: ncname
3385 character (len=*),
parameter :: myfile = &
3386 & __FILE__//
", DATA_multifile"
3393 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_multifile', &
3407 timestrsec=tcurrent*86400.0_dp
3411 timestrday=timestrsec/86400.0_dp
3412 timeendday=timeendsec/86400.0_dp
3423 mfiles=ifs(i)%Nfiles
3425 ncname=ifs(i)%files(ifile)
3430 rc=esmf_rc_cannot_set
3433 ifs(i)%time_min(ifile)=tmin
3434 ifs(i)%time_max(ifile)=tmax
3443 tmin=tscale*ifs(i)%time_min(ifile)
3444 IF (timestrday.ge.tmin)
THEN
3456 IF (fcount.gt.0)
THEN
3457 ifs(i)%Fcount=fcount
3458 ncname=ifs(i)%files(fcount)
3459 lstr=len_trim(ncname)
3460 ifs(i)%name=trim(ncname)
3461 ifs(i)%base=ncname(1:lstr-3)
3463 IF ((localpet.eq.0).and.lcheck)
THEN
3466 tmin=tscale*ifs(i)%time_min(ifile)
3467 tmax=tscale*ifs(i)%time_max(ifile)
3470 WRITE (
dataout,20) tmin_code, tmax_code, &
3471 & trim(ifs(i)%files(ifile))
3477 rc=esmf_rc_cannot_set
3485 tmax=tscale*ifs(i)%time_max(mfiles)
3486 IF (timeendday.gt.tmax)
THEN
3488 IF (localpet.eq.0)
THEN
3489 WRITE (
dataout,30)
'Data Model', &
3490 & trim(ifs(i)%files(mfiles)), &
3491 &
'last ', tmax_code,
f_code
3496 rc=esmf_rc_cannot_set
3504 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_multifile', &
3509 10
FORMAT (/,
' DATA_MULTIFILE - Error while processing ', a, &
3510 &
' multi-files: ',/,18x,
'data does not include', &
3511 &
' initialization time = ', a,/)
3512 20
FORMAT (3x,a,2x,a,5x,a)
3513 30
FORMAT (/,
' DATA_MULTIFILE - Error while checking input ', a, &
3514 &
' file:',/,18x,a,/,18x, &
3515 & a,
'data time record available is for day: ',a,/,18x, &
3516 &
'but data is needed to finish run until day: ',a)
3783 & Export, Nfields, IFS, Nfiles, &
3784 & Lmulti, localPET, rc)
3824 logical,
intent(in) :: lmulti
3826 integer,
intent(in) :: ifield,
nfields, nfiles
3827 integer,
intent(in) :: localpet
3828 integer,
intent(out) :: rc
3830 real(dp) :: tcurrent
3833 TYPE(
t_io),
intent(inout) :: ifs(nfiles)
3835 character (len=*),
intent(in) :: ncvname, nctname
3839 logical :: closefile, lcycle, linside, lowerbound, upperbound
3840 logical :: foundatt(1), foundit, got_coord, got_var, got_time
3842 integer :: fcount, nrec, tid, tindex, trec, vid, zlevel
3843 integer :: i, ifile, j, lstr
3844 integer :: ncid, ntatt, ntdim, nvatt, nvdim
3845 integer :: clen, iblank, ie, is
3849 integer,
parameter :: imodel = 1
3850 integer,
parameter :: ng = 1
3852 real(dp) :: clength, tday, tend, tmax, tmin, tmono, tscale, tstr
3853 real(dp) :: scale, tstart
3855 real(dp),
allocatable :: timevalue(:)
3857 character (len=1 ),
parameter :: blank =
' '
3858 character (len=3 ) :: label
3859 character (len=20 ) :: coordinates(5)
3860 character (len=40 ) :: attname(1), t_name
3861 character (len=100) :: cstring, tunits
3862 character (len=256) :: fname
3863 character (len=2048) :: attvalue(1)
3865 character (len=*),
parameter :: myfile = &
3866 & __FILE__//
", DATA_inquiry"
3873 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_inquiry', &
3901 IF (localpet.eq.0)
THEN
3902 WRITE (
dataout,5) trim(ncvname)
3910 IF (trim(export(ifield)%ncfile).eq.trim(ifs(ifile)%name))
THEN
3911 fcount=ifs(ifile)%Fcount+1
3912 IF ((1.gt.fcount).and.(fcount.gt.ifs(ifile)%Nfiles))
THEN
3913 IF (localpet.eq.0)
THEN
3914 WRITE (
dataout,10) trim(ncvname), &
3915 & fcount, ifs(ifile)%Nfiles
3918 rc=esmf_rc_not_valid
3922 ifs(ifile)%Fcount=fcount
3923 ifs(ifile)%name=trim(ifs(ifile)%files(fcount))
3924 lstr=len_trim(ifs(ifile)%name)
3925 ifs(ifile)%base=ifs(ifile)%name(1:lstr-3)
3929 rc=esmf_rc_file_close
3934 fcount=ifs(ifile)%Fcount
3938 fcount=ifs(1)%Fcount
3940 IF (fcount.eq.0)
THEN
3941 IF (localpet.eq.0)
THEN
3942 WRITE (
dataout,20) fcount, label, trim(ncvname)
3956 query:
DO ifile=1,nfiles
3957 fname=ifs(ifile)%name
3961 IF (ifs(ifile)%ncid.eq.-1)
THEN
3965 rc=esmf_rc_file_open
3966 IF (localpet.eq.0)
WRITE (
dataout,30) trim(fname)
3971 ncid=ifs(ifile)%ncid
3979 & myvarname = trim(ncvname), &
3980 & searchvar = foundit, &
3982 & nvardim = nvdim, &
3986 rc=esmf_rc_file_read
4000 probe:
IF (foundit)
THEN
4001 IF (localpet.eq.0)
THEN
4002 WRITE (
dataout,35) trim(fname)
4006 ifs(ifile)%ncid=ncid
4007 export(ifield)%ncid=ncid
4008 export(ifield)%Vid=vid
4009 export(ifield)%Vname=trim(ncvname)
4010 export(ifield)%Nvdim=2
4012 IF (.not.
allocated(export(ifield)%Vsize))
THEN
4013 allocate ( export(ifield)%Vsize(nvdim) )
4014 export(ifield)%Vsize(1:nvdim)=0
4016 IF (.not.
allocated(export(ifield)%Dname))
THEN
4017 allocate ( export(ifield)%Dname(nvdim) )
4018 export(ifield)%Dname(1:nvdim)=
' '
4020 IF (.not.
allocated(export(ifield)%Vcoord))
THEN
4021 allocate ( export(ifield)%Vcoord(nvdim) )
4022 export(ifield)%Vcoord(1:nvdim)=
' '
4032 IF ((nvdim.eq.4).and.(
var_dsize(3).eq.1))
THEN
4058 export(ifield)%SpecialAction=
'NONE'
4063 & attname, attvalue, &
4068 rc=esmf_rc_file_read
4071 IF ((index(trim(
uppercase(attvalue(1))), &
4072 &
'HYCOM').ne.0).and. &
4075 export(ifield)%SpecialAction=
'HYCOM TRIPOLAR GRID'
4077 IF ((nvdim.eq.4).and.(
var_dsize(3).gt.1))
THEN
4087 export(ifield)%Zlevel=zlevel
4102 CASE (
'scale_factor')
4104 CASE (
'_FillValue',
'missing_value')
4106 CASE (
'coordinates')
4108 export(ifield)%Vcoord=trim(cstring)
4111 IF (.not.got_time)
THEN
4113 lstr=len_trim(t_name)
4115 IF (trim(
var_dname(j)).eq.t_name(1:lstr))
THEN
4123 export(ifield)%Vlongname=trim(
var_achar(i))
4125 export(ifield)%Vunits=trim(
var_achar(i))
4131 export(ifield)%Lcoord=got_coord
4133 clen=len_trim(cstring)
4136 iblank=index(cstring(is:clen),
' ')
4137 IF (iblank.eq.0)
THEN
4142 coordinates(i)=cstring(is:ie-1)
4143 export(ifield)%Vcoord(i)=trim(coordinates(i))
4153 coordinates(nvdim)=trim(t_name)
4154 export(ifield)%Vcoord(nvdim)=trim(t_name)
4162 IF (.not.got_time)
THEN
4164 IF (index(trim(
lowercase(coordinates(i))),
'time') &
4166 t_name=trim(coordinates(i))
4171 IF (.not.got_time)
THEN
4172 t_name=trim(coordinates(nvdim))
4182 IF (.not.(got_time.or.got_coord))
THEN
4191 IF (.not.got_time.and.(nrec.eq.0))
THEN
4192 IF (localpet.eq.0)
WRITE (
dataout,40) trim(t_name), &
4195 rc=esmf_rc_not_found
4203 IF (got_time.and.(nrec.ge.1))
THEN
4206 & myvarname = trim(t_name), &
4208 & nvardim = ntdim, &
4212 rc=esmf_rc_file_read
4215 export(ifield)%Tname=trim(t_name)
4216 export(ifield)%Tid=tid
4217 export(ifield)%Nrec=nrec
4224 CASE (
'cycle_length')
4231 IF (localpet.eq.0) &
4234 rc=esmf_rc_val_wrong
4239 export(ifield)%Lcycle=lcycle
4240 export(ifield)%Clength=clength
4243 IF (tunits(1:6).eq.
'second')
THEN
4244 tscale=1.0_dp/86400.0_dp
4245 ELSE IF (tunits(1:4).eq.
'hour')
THEN
4246 tscale=1.0_dp/24.0_dp
4250 export(ifield)%Tunits=trim(tunits)
4251 export(ifield)%Tscale=tscale
4257 IF (.not.
allocated(timevalue))
THEN
4258 allocate ( timevalue(nrec) )
4265 & total = (/nrec/), &
4270 rc=esmf_rc_file_read
4278 timevalue(i)=timevalue(i)*tscale
4285 tday=mod(tcurrent,clength)
4293 IF ((tmin.le.tday).and.(tday.le.tmax))
THEN
4295 ELSE IF (tday.ge.tmax)
THEN
4297 ELSE IF (tday.le.tmin)
THEN
4306 IF (timevalue(i).gt.tday)
THEN
4327 IF ((tstart.le.tday).and.(tday.le.timevalue(i)))
THEN
4328 IF ((tday.eq.timevalue(i)).and.(i.ne.nrec))
THEN
4350 tstr=export(ifield)%Tmax
4352 IF (lcycle.and.(trec.eq.nrec))
THEN
4359 IF (
allocated(timevalue))
THEN
4360 deallocate (timevalue)
4362 export(ifield)%Tmin=tmin
4363 export(ifield)%Tmax=tmax
4364 export(ifield)%Tstr=tstr
4365 export(ifield)%Tend=tend
4371 IF (.not.lcycle.and.(nrec.gt.1))
THEN
4373 IF (tcurrent.gt.tmax)
THEN
4374 IF (localpet.eq.0)
WRITE (
dataout,60) trim(t_name), &
4376 rc=esmf_rc_val_wrong
4380 ELSE IF (export(ifield)%LastRec)
THEN
4381 IF (tmin.lt.tcurrent)
THEN
4382 IF (localpet.eq.0)
THEN
4384 &
'Upper snapshot time for multi-file variable:', &
4387 &
'is less than current model time.', &
4388 &
'Tmin = ', tmin, tcurrent
4390 rc=esmf_rc_val_wrong
4397 IF (.not.upperbound.and.(tcurrent.lt.tmin))
THEN
4398 IF (localpet.eq.0)
THEN
4400 &
'starting time for variable:', &
4403 &
'is greater than current model time.', &
4404 &
'Tmin = ', tmin, tcurrent
4406 rc=esmf_rc_val_wrong
4414 export(ifield)%ncfile=trim(fname)
4417 IF (.not.lmulti)
THEN
4430 rc=esmf_rc_file_close
4440 IF (.not.got_var)
THEN
4442 IF (localpet.eq.0)
THEN
4443 WRITE (
dataout,80) trim(ncvname),
'file:'
4447 WRITE (
dataout,
'(15x,a,a)')
'file name is blank, ', &
4448 &
'cannot be determined.'
4451 rc=esmf_rc_not_found
4457 IF (.not.got_time)
THEN
4459 IF (localpet.eq.0)
THEN
4460 WRITE (
dataout,80) trim(t_name),
'file:'
4464 WRITE (
dataout,
'(15x,a,a)')
'file name is blank, ', &
4465 &
'cannot be determined.'
4468 rc=esmf_rc_not_found
4481 IF (ifs(ifile)%ncid.eq.-1)
THEN
4485 rc=esmf_rc_file_open
4489 ifs(ifile)%ncid=ncid
4499 IF (.not.lmulti)
THEN
4501 IF (trec.eq.nrec)
THEN
4502 IF (tcurrent.lt.tmax)
THEN
4505 tmono=tcurrent+(tstr-clength)
4506 IF (tstr.eq.tmax)
THEN
4507 tmono=tmono+(tmin-mod(tcurrent+tmin,clength))
4509 tmono=tmono+(tstr-mod(tcurrent+tstr,clength))
4513 IF (tcurrent.gt.clength)
THEN
4514 tmono=tcurrent-mod(
tdays(ng)-tstr,clength)
4524 export(ifield)%Tindex=tindex
4525 export(ifield)%Trec=trec
4526 export(ifield)%Tmono=tmono
4527 export(ifield)%Vtime(tindex)=tstr
4530 export(ifield)%Tindex=tindex
4531 export(ifield)%Trec=trec
4532 export(ifield)%Vtime(tindex)=tstr
4536 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_inquiry', &
4541 5
FORMAT (
' DATA_inquiry - inquiring NetCDF variable ''',a, &
4542 &
''' in input file(s) ...')
4543 35
FORMAT (20x,
'found in: ',a)
4544 10
FORMAT (/,
' DATA_INQUIRY - out of range multi-files counter ', &
4545 &
'for variable: ',a,/,16x,
'Fcount = ',i2.2, &
4546 &
', Expected range: 1 - ',i2.2)
4547 20
FORMAT (/,
' DATA_INQUIRY - unable to assign file counter, ', &
4548 &
'Fcount = ',i4,/,15x,
'while processing structure: ',a, &
4549 & /,16x,
'and variable; ',a)
4550 30
FORMAT (/,
' DATA_INQUIRY - unable to open input NetCDF file: ',a)
4551 40
FORMAT (/,
' DATA_INQUIRY - unable to find dimension ',a, &
4552 & /,16x,
'for variable: ',a,/,16x,
'in file: ',a, &
4553 & /,16x,
'file is not CF compliant...')
4554 50
FORMAT (/,
' DATA_INQUIRY - unable to get value for attribute: ', &
4555 & a,/,16x,
'in variable: ',a, &
4556 & /,16x,
'This attribute value is expected to be of', &
4557 & /,16x,
'the same external type as the variable.')
4558 60
FORMAT (/,
' DATA_INQUIRY - ending time for multi-file variable: ',&
4559 & a,/,16x,
'is less than current model time. ', &
4560 & /,16x,
'Tmax = ',f15.4,2x,
'Tcurrent = ',f15.4)
4561 70
FORMAT (/,
' DATA_INQUIRY - ',a,1x,a,2x,
'(',a,
')',/,16x,a, &
4562 & /,16x,a,f15.4,2x,
'Tcurrent = ',f15.4)
4563 80
FORMAT (/,
' DATA_INQUIRY - unable to find requested variable: ', &
4570 & Nfields, Export, &
4637 integer,
intent(in) :: ifield,
nfields
4638 integer,
intent(in) :: localpet
4639 integer,
intent(out) :: rc
4643 character (len=*),
intent(in) :: fieldname
4647 logical :: lcoord, got_lon, got_lat, got_mask
4649 integer :: ng, model
4650 integer :: imax, jmax, i, j
4651 integer :: nvdim, ncid, ncvid, nlatatt, nlatdim, nlonatt, nlondim
4652 integer :: nmaskdim, nmaskatt
4655 real(r8) :: lon_min, lon_max, lat_min, lat_max
4657 real(r8),
allocatable :: lonwrk(:)
4658 real(r8),
allocatable :: latwrk(:)
4660 character (len=5 ) :: lstr
4661 character (len=20 ) :: dname(2), lonname, latname, maskname
4662 character (len=100) :: ncvname
4663 character (len=256) :: ncname
4665 character (len=*),
parameter :: myfile = &
4666 & __FILE__//
", DATA_ncvarcoords"
4673 WRITE (
trac,
'(a,a,i0)')
'==> Entering DATA_ncvarcoords', &
4692 IF (localpet.eq.0)
THEN
4693 WRITE (
dataout,10) trim(export(ifield)%Vname), &
4694 & trim(export(ifield)%ncfile)
4699 ncname=trim(export(ifield)%ncfile)
4700 ncvname=trim(export(ifield)%Vname)
4701 dname(1)=trim(export(ifield)%Dname(1))
4702 dname(2)=trim(export(ifield)%Dname(2))
4703 lcoord=export(ifield)%Lcoord
4704 nvdim=export(ifield)%Nvdim
4706 IF (lcoord.and.(nvdim.ge.2))
THEN
4709 lonname=trim(export(ifield)%Vcoord(1))
4710 latname=trim(export(ifield)%Vcoord(2))
4711 imax=export(ifield)%Vsize(1)
4712 jmax=export(ifield)%Vsize(2)
4717 IF (export(ifield)%ncid.eq.-1)
THEN
4721 WRITE (
dataout,20) trim(ncname)
4724 export(ifield)%ncid=ncid
4726 ncid=export(ifield)%ncid
4735 rc=esmf_rc_file_read
4742 IF (.not.lcoord)
THEN
4745 CASE (
'longitude',
'lon',
'lon_rho',
'lon_u',
'lon_v')
4746 IF (.not.got_lon)
THEN
4750 & nvardim = nlondim, &
4751 & nvaratt = nlonatt)
4754 rc=esmf_rc_file_read
4757 IF ((trim(
var_dname(1)).eq.dname(1)).and. &
4758 & (trim(
var_dname(2)).eq.dname(2)))
THEN
4763 CASE (
'latitude',
'lat',
'lat_rho',
'lat_u',
'lat_v')
4764 IF (.not.got_lat)
THEN
4768 & nvardim = nlatdim, &
4769 & nvaratt = nlatatt)
4772 rc=esmf_rc_file_read
4775 IF ((trim(
var_dname(1)).eq.dname(1)).and. &
4776 & (trim(
var_dname(2)).eq.dname(2)))
THEN
4784 IF (.not.(got_lon.or.got_lat))
THEN
4785 rc=esmf_rc_cannot_get
4787 WRITE (lstr,
'(i5)') __line__
4788 IF (localpet.eq.0)
THEN
4789 WRITE (
dataout,10) trim(ncvname), trim(ncname), &
4801 CASE (
'mask',
'mask_rho',
'mask_u',
'mask_v')
4802 IF (.not.got_mask)
THEN
4806 & nvardim = nmaskdim, &
4807 & nvaratt = nmaskatt)
4810 rc=esmf_rc_file_read
4813 IF ((trim(
var_dname(1)).eq.dname(1)).and. &
4814 & (trim(
var_dname(2)).eq.dname(2)))
THEN
4824 IF (.not.
allocated(export(ifield)%lon))
THEN
4825 allocate ( export(ifield)%lon(imax,jmax) )
4830 & myvarname = trim(lonname), &
4832 & nvardim = nlondim, &
4833 & nvaratt = nlonatt)
4836 rc=esmf_rc_file_read
4840 IF (nlondim.eq.1)
THEN
4841 IF (.not.
allocated(lonwrk))
THEN
4842 allocate ( lonwrk(imax) )
4854 export(ifield)%lon(i,j)=lonwrk(i)
4860 & export(ifield)%lon, &
4862 & start = (/1,1/), &
4863 & total = (/imax,jmax/))
4870 IF (.not.
allocated(export(ifield)%lat))
THEN
4871 allocate ( export(ifield)%lat(imax,jmax) )
4876 & myvarname = trim(latname), &
4878 & nvardim = nlatdim, &
4879 & nvaratt = nlatatt)
4882 rc=esmf_rc_file_read
4886 IF (nlatdim.eq.1)
THEN
4887 IF (.not.
allocated(latwrk))
THEN
4888 allocate ( latwrk(jmax) )
4900 export(ifield)%lat(i,j)=latwrk(j)
4906 & export(ifield)%lat, &
4908 & start = (/1,1/), &
4909 & total = (/imax,jmax/))
4922 lon_min=min(lon_min, export(ifield)%lon(i,j))
4923 lon_max=max(lon_max, export(ifield)%lon(i,j))
4924 lat_min=min(lat_min, export(ifield)%lat(i,j))
4925 lat_max=max(lat_max, export(ifield)%lat(i,j))
4928 export(ifield)%LonMin=lon_min
4929 export(ifield)%LonMax=lon_max
4930 export(ifield)%LatMin=lat_min
4931 export(ifield)%LatMax=lat_max
4935 IF (.not.
allocated(export(ifield)%mask))
THEN
4936 allocate ( export(ifield)%mask(imax,jmax) )
4938 export(ifield)%Lmask=got_mask
4942 & export(ifield)%mask, &
4944 & start = (/1,1/), &
4945 & total = (/imax,jmax/))
4951 export(ifield)%mask(i,j)=1.0_r8
4957 WRITE (
trac,
'(a,a,i0)')
'<== Exiting DATA_ncvarcoords', &
4962 10
FORMAT (
' DATA_ncvarcoords - setting spatial coordinates for', &
4963 &
' NetCDF variable ''',a,
'''',/,20x,
'from file: ',a)
4964 20
FORMAT (/,
' DATA_ncvarcoords - Cannot find "coordinates" ', &
4965 &
'attribute for variable:',2x,a,/,20x,
'in file:',2x,a,/, &
4966 & /,20x,
'This attribute is needed to interpolate input data', &
4967 & /,20x,
'to model grid. Following CF compliance, we need:',/, &
4968 & /,20x,
'float my_var(time, lat, lon) ;', &
4969 & /,20x,
' my_var:long_name = "my variable long name" ;', &
4970 & /,20x,
' my_var:units = "my variable units" ;', &
4971 & /,20x,
' my_var:coordinates = "lon lat my_var_time" ;', &
4972 & /,20x,
' my_var:time = "my_var_time" ;',/, &
4973 & /,
' Found Error: ', i2.2, t20,
'Line: ',a, &
4974 & t35,
'Source: ', a)