ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
esmf_data_mod Module Reference

Functions/Subroutines

subroutine, public data_setservices (model, rc)
 
subroutine, private data_setinitializep1 (model, importstate, exportstate, clock, rc)
 
subroutine, private data_setinitializep2 (model, importstate, exportstate, clock, rc)
 
subroutine, private data_initialize (model, tcurrent, localpet, rc)
 
subroutine, private data_datainit (model, rc)
 
subroutine, private data_setclock (model, rc)
 
subroutine, private data_setgridarrays (model, exportcount, rc)
 
subroutine, private data_setstates (model, rc)
 
subroutine, private data_modeladvance (model, rc)
 
subroutine, private data_setfinalize (model, importstate, exportstate, clock, rc)
 
subroutine, private data_export (model, lreport, rc)
 
subroutine, private data_timeinterp (tcurrent, localpet, rc)
 
subroutine, private data_ncread (tcurrent, firstpass, localpet, isupdated, rc)
 
subroutine, private data_multifile (tcurrent, ifs, nfiles, localpet, rc)
 
logical function, private data_checkfile (ncname, tmin, tmax, tscale, localpet, lcheck)
 
subroutine, private data_inquiry (ifield, ncvname, nctname, tcurrent, export, nfields, ifs, nfiles, lmulti, localpet, rc)
 
subroutine, private data_ncvarcoords (ifield, fieldname, nfields, export, localpet, rc)
 

Function/Subroutine Documentation

◆ data_checkfile()

logical function, private esmf_data_mod::data_checkfile ( character (*), intent(in) ncname,
real(dp), intent(out) tmin,
real(dp), intent(out) tmax,
real(dp), intent(out) tscale,
integer, intent(in) localpet,
logical, intent(out) lcheck )
private

Definition at line 3521 of file esmf_data.F.

3523!
3524!=======================================================================
3525! !
3526! This logical function scans the variables of the provided input !
3527! NetCDF for the time record variable and gets its range of values. !
3528! It used elsewhere to determine which input NetCDF multi-file is !
3529! needed for initialization or restart. !
3530! !
3531! On Input: !
3532! !
3533! ncname NetCDF file name to process (string) !
3534! localPET Local Persistent Execution Thread (integer) !
3535! !
3536! On Output: !
3537! !
3538! Tmin Available minimum time variable value !
3539! Tmax Available maximum time variable value !
3540! Tscale Scale to convert time variable units to days !
3541! Lcheck Switch to indicate that the time range needs to be !
3542! checked by the calling routine !
3543! foundit The value of the result is TRUE/FALSE if the !
3544! time variable is found or not !
3545! !
3546! WARNING: !
3547! !
3548! This routine uses ROMS NetCDF processing framework. !
3549! !
3550!=======================================================================
3551!
3552 USE mod_netcdf
3553!
3554 USE mod_iounits, ONLY : sourcefile
3555 USE mod_scalars, ONLY : noerror, exit_flag
3556 USE strings_mod, ONLY : founderror, lowercase
3557!
3558 implicit none
3559!
3560! Imported variable declarations.
3561!
3562 logical, intent(out) :: Lcheck
3563!
3564 integer, intent(in ) :: localPET
3565!
3566 character (*), intent(in) :: ncname
3567!
3568 real(dp), intent(out) :: Tmin, Tmax, Tscale
3569!
3570! Local variable declarations.
3571!
3572 logical :: Lcycle, Lperpetual, foundit
3573!
3574 integer :: Nrec, TvarID, i, j, ncid, ncvid, nvdim, nvatt
3575 integer :: ROMScomm
3576!
3577 integer, parameter :: imodel = 1 ! for compatibility with ROMS
3578 integer, parameter :: ng = 1 ! used routines
3579!
3580 character (len= 40) :: Tunits, TvarName
3581 character (len=100) :: blank, long_name, units
3582
3583 character (len=*), parameter :: MyFile = &
3584 & __FILE__//", DATA_checkfile"
3585!
3586!-----------------------------------------------------------------------
3587! Check if requested time is within the NetCDF file dataset.
3588!-----------------------------------------------------------------------
3589!
3590! Initialize.
3591!
3592 IF (esm_track) THEN
3593 WRITE (trac,'(a,a,i0)') '==> Entering DATA_checkfile', &
3594 & ', PET', petrank
3595 FLUSH (trac)
3596 END IF
3597 sourcefile=myfile
3598!
3599 foundit=.false.
3600 lcheck=.true.
3601 lcycle=.false.
3602 lperpetual=.false.
3603 tscale=1.0_dp ! time in days by default
3604 tmin= missing_dp
3605 tmax=-missing_dp
3606 DO i=1,len(blank)
3607 blank(i:i)=' '
3608 END DO
3609 IF (localpet.eq.0) THEN
3610 WRITE (dataout,10) trim(ncname)
3611 END IF
3612!
3613! Open NetCDF file for reading.
3614!
3615 CALL netcdf_open (ng, imodel, ncname, 0, ncid)
3616 IF (founderror(exit_flag, noerror, __line__, &
3617 & myfile)) THEN
3618 IF (localpet.eq.0) THEN
3619 WRITE (dataout,20) trim(ncname)
3620 END IF
3621 RETURN
3622 END IF
3623!
3624! Inquire about all the variables
3625!
3626 CALL netcdf_inq_var (ng, imodel, ncname, &
3627 & ncid = ncid)
3628 IF (founderror(exit_flag, noerror, __line__, &
3629 & myfile)) RETURN
3630!
3631! Search for the time variable: any 1D array variable with the string
3632! 'time' in the variable name.
3633!
3634 DO i=1,n_var
3635 IF ((index(trim(lowercase(var_name(i))),'time').ne.0).and. &
3636 & (var_ndim(i).eq.1)) THEN
3637 tvarname=trim(var_name(i))
3638 foundit=.true.
3639 EXIT
3640 END IF
3641 END DO
3642!
3643! If not found, scan all the 1D array variables and inquire the
3644! 'long_name' attribute for the string time and the 'units' attribute
3645! for the strin 'day' or 'second'.
3646!
3647 IF (.not.foundit) THEN
3648 DO i=1,n_var
3649 IF (var_ndim(i).eq.1) THEN
3650 CALL netcdf_inq_var (ng, imodel, ncname, &
3651 & ncid = ncid, &
3652 & myvarname = trim(var_name(i)), &
3653 & varid = ncvid, &
3654 & nvardim = nvdim, &
3655 & nvaratt = nvatt)
3656 IF (founderror(exit_flag, noerror, __line__, &
3657 & myfile)) RETURN
3658 long_name=blank
3659 units=blank
3660 DO j=1,nvatt
3661 IF (trim(var_aname(j)).eq.'long_name') THEN
3662 long_name=trim(var_achar(j))
3663 ELSE IF (trim(var_aname(j)).eq.'units') THEN
3664 units=trim(var_achar(j))
3665 END IF
3666 END DO
3667 IF ((index(trim(lowercase(long_name)),'time').ne.0).and. &
3668 & ((index(trim(lowercase(units)),'day').ne.0).or. &
3669 & (index(trim(lowercase(units)),'hour').ne.0).or. &
3670 & (index(trim(lowercase(units)),'second').ne.0))) THEN
3671 tvarname=trim(var_name(i))
3672 foundit=.true.
3673 EXIT
3674 END IF
3675 END IF
3676 END DO
3677 END IF
3678!
3679! Issue and error if time variable not found.
3680!
3681 IF (.not.foundit) THEN
3682 IF (localpet.eq.0) THEN
3683 WRITE (dataout,30) trim(ncname)
3684 END IF
3685 exit_flag=4
3686 IF (founderror(exit_flag, noerror, __line__, &
3687 & myfile)) RETURN
3688 END IF
3689!
3690! Inquire about time variable.
3691!
3692 CALL netcdf_inq_var (ng, imodel, ncname, &
3693 & ncid = ncid, &
3694 & myvarname = trim(tvarname), &
3695 & varid = tvarid, &
3696 & nvardim = nvdim, &
3697 & nvaratt = nvatt)
3698 IF (founderror(exit_flag, noerror, __line__, &
3699 & myfile)) RETURN
3700!
3701! Set number of records available and check the 'units' attribute.
3702! Also, set output logical switch 'Lcheck' for the calling to check
3703! the available data time range. For example, we need to check it
3704! there is enough data to finish the simulation. Notice that for
3705! data with 'cycle_length', Lcheck = FALSE. Also, Lcheck = FALSE
3706! for perpetual time axis: the 'calendar' attribute is 'none' or
3707! the number of records in the time dimension is one (Nrec=1).
3708!
3709! Compute time scale (Tscale) to convert DAY units.
3710!
3711 nrec=var_dsize(1) ! time is a 1D array
3712 DO i=1,nvatt
3713 IF (trim(var_aname(i)).eq.'units') THEN
3714 tunits=trim(var_achar(i))
3715 IF (index(trim(var_achar(i)),'day').ne.0) THEN
3716 tscale=1.0_dp
3717 ELSE IF (index(trim(var_achar(i)),'hour').ne.0) THEN
3718 tscale=1.0_dp/24.0_dp
3719 ELSE IF (index(trim(var_achar(i)),'second').ne.0) THEN
3720 tscale=1.0_dp/86400.0_dp
3721 END IF
3722 ELSE IF (trim(var_aname(i)).eq.'calendar') THEN
3723 IF ((nrec.eq.1).or. &
3724 & (index(trim(var_achar(i)),'none').ne.0)) THEN
3725 lperpetual=.true.
3726 END IF
3727 ELSE IF (trim(var_aname(i)).eq.'cycle_length') THEN
3728 lcycle=.true.
3729 END IF
3730 END DO
3731!
3732! Turn off the checking of time range if cycling, perpectual, or
3733! spectral time axis.
3734!
3735 IF (lcycle.or.lperpetual.or.(nrec.eq.1)) THEN
3736 lcheck=.false.
3737 END IF
3738!
3739! Read in time variable minimum and maximun values (input time units).
3740!
3741 CALL netcdf_get_time (ng, imodel, ncname, tvarname, &
3742 & referencedatenumber, &
3743 & tmin, &
3744 & ncid = ncid, &
3745 & start = (/1/), &
3746 & total = (/1/))
3747 IF (founderror(exit_flag, noerror, __line__, &
3748 & myfile)) RETURN
3749!
3750 CALL netcdf_get_time (ng, imodel, ncname, tvarname, &
3751 & referencedatenumber, &
3752 & tmax, &
3753 & ncid = ncid, &
3754 & start = (/nrec/), &
3755 & total = (/1/))
3756 IF (founderror(exit_flag, noerror, __line__, &
3757 & myfile)) RETURN
3758!
3759! Close NetCDF file.
3760!
3761 CALL netcdf_close (ng, imodel, ncid, ncname, .false.)
3762 IF (founderror(exit_flag, noerror, __line__, &
3763 & myfile)) RETURN
3764!
3765 IF (esm_track) THEN
3766 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_checkfile', &
3767 & ', PET', petrank
3768 FLUSH (trac)
3769 END IF
3770!
3771 10 FORMAT (' DATA_checkfile - inquiring range of time records in', &
3772 & ' input NetCDF file:',/,20x,a)
3773 20 FORMAT (/, ' DATA_CHECKFILE - unable to open grid NetCDF file: ', &
3774 & a)
3775 30 FORMAT (/, ' DATA_CHECKFILE - unable to find time variable in ', &
3776 & ' input NetCDF file:',/,18x,a,/,18x, &
3777 & 'variable name does not contains the "time" string.')
3778
3779 RETURN
mod_netcdf::netcdf_get_time
Definition mod_netcdf.F:77
mod_iounits
Definition mod_iounits.F:2
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
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::var_achar
character(len=1024), dimension(nvara) var_achar
Definition mod_netcdf.F:183
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::var_ndim
integer, dimension(mvars) var_ndim
Definition mod_netcdf.F:164
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::var_dsize
integer, dimension(nvard) var_dsize
Definition mod_netcdf.F:177
mod_netcdf::var_aname
character(len=100), dimension(nvara) var_aname
Definition mod_netcdf.F:181
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_scalars
Definition mod_scalars.F:2
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
strings_mod
Definition strings.F:2
strings_mod::lowercase
character(len(sinp)) function, public lowercase(sinp)
Definition strings.F:531
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52

References mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), strings_mod::lowercase(), mod_esmf_esm::missing_dp, mod_netcdf::n_var, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_esmf_esm::petrank, mod_esmf_esm::referencedatenumber, mod_iounits::sourcefile, mod_esmf_esm::trac, mod_netcdf::var_achar, mod_netcdf::var_aname, mod_netcdf::var_dsize, mod_netcdf::var_name, and mod_netcdf::var_ndim.

Referenced by data_multifile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_datainit()

subroutine, private esmf_data_mod::data_datainit ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 906 of file esmf_data.F.

907!
908!=======================================================================
909! !
910! Exports DATA component fields during initialization or restart. !
911! !
912!=======================================================================
913!
914! Imported variable declarations.
915!
916 integer, intent(out) :: rc
917!
918 TYPE (ESMF_GridComp) :: model
919!
920! Local variable declarations.
921!
922 logical :: FirstPass, IsUpdated, Lreport
923!
924 integer :: is, localPET, PETcount
925!
926 real(dp) :: TimeInDays, Time_Current
927!
928 character (len=20) :: Time_CurrentString
929
930 character (len=*), parameter :: MyFile = &
931 & __FILE__//", DATA_DataInit"
932!
933 TYPE (ESMF_Clock) :: clock
934 TYPE (ESMF_Time) :: CurrentTime
935!
936!-----------------------------------------------------------------------
937! Initialize return code flag to success state (no error).
938!-----------------------------------------------------------------------
939!
940 IF (esm_track) THEN
941 WRITE (trac,'(a,a,i0)') '==> Entering DATA_DataInit', &
942 & ', PET', petrank
943 FLUSH (trac)
944 END IF
945 rc=esmf_success
946!
947!-----------------------------------------------------------------------
948! Get DATA component clock.
949!-----------------------------------------------------------------------
950!
951 CALL esmf_gridcompget (model, &
952 & clock=clock, &
953 & localpet=localpet, &
954 & petcount=petcount, &
955 & rc=rc)
956 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
957 & line=__line__, &
958 & file=myfile)) THEN
959 RETURN
960 END IF
961!
962 CALL esmf_clockget (clock, &
963 & currtime=currenttime, &
964 & rc=rc)
965 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
966 & line=__line__, &
967 & file=myfile)) THEN
968 RETURN
969 END IF
970!
971 CALL esmf_timeget (currenttime, &
972 & s_r8=time_current, &
973 & timestring=time_currentstring)
974 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
975 & line=__line__, &
976 & file=myfile)) THEN
977 RETURN
978 END IF
979 timeindays=(time_current- &
980 & clockinfo(idata)%Time_Reference)/86400.0_dp
981 is=index(time_currentstring, 'T') ! remove 'T' in
982 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
983!
984!-----------------------------------------------------------------------
985! Export LOWER time-snapshot. The target ESM component will time
986! interpolates the needed field using the exported two time-level
987! data snapshots, internally.
988!-----------------------------------------------------------------------
989!
990 lreport=.true.
991 CALL data_export (model, lreport, rc)
992 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
993 & line=__line__, &
994 & file=myfile)) THEN
995 RETURN
996 END IF
997!
998 IF (esm_track) THEN
999 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_DataInit', &
1000 & ', PET', petrank
1001 FLUSH (trac)
1002 END IF
1003!
1004 RETURN

References mod_esmf_esm::clockinfo, data_export(), mod_esmf_esm::esm_track, mod_esmf_esm::idata, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_export()

subroutine, private esmf_data_mod::data_export ( type (esmf_gridcomp) model,
logical, intent(in) lreport,
integer, intent(out) rc )
private

Definition at line 2070 of file esmf_data.F.

2071!
2072!=======================================================================
2073! !
2074! Exports ROMS fields to other coupled gridded components. !
2075! !
2076! Reporting is supressed for the first pass (Lreport=.FALSE) since !
2077! the clocks were regressed by one coupling interval to facilitate !
2078! initilazation phases. !
2079! !
2080!=======================================================================
2081!
2082# ifdef TIME_INTERP
2083 USE mod_iounits, ONLY : sourcefile
2084 USE mod_netcdf, ONLY : netcdf_put_fvar, netcdf_put_ivar
2085 USE mod_netcdf, ONLY : netcdf_put_svar
2086 USE mod_scalars, ONLY : noerror, exit_flag
2087 USE strings_mod, ONLY : founderror
2088# endif
2089!
2090! Imported variable declarations.
2091!
2092 logical, intent(in) :: Lreport
2093!
2094 integer, intent(out) :: rc
2095!
2096 TYPE (ESMF_GridComp) :: model
2097!
2098! Local variable declarations.
2099!
2100 logical :: IsPresent
2101!
2102 integer :: ExportCount, localPET, PETcount
2103 integer :: localDE, localDEcount
2104# ifdef TIME_INTERP
2105 integer :: ROMScomm
2106# endif
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)
2112# ifdef TIME_INTERP
2113!
2114 integer, save :: record = 0
2115!
2116 integer, parameter :: iNLM = 1 ! ROMS framework usage
2117# endif
2118!
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)
2123!
2124 real (dp), pointer :: ptr2d(:,:) => null()
2125 real (dp), pointer :: ptr3d(:,:,:) => null()
2126!
2127 character (len=20) :: ShortName
2128# ifdef TIME_INTERP
2129 character (len=20) :: MyShortName(1,1)
2130 character (len=22) :: MyDateString(1,1,1)
2131# endif
2132 character (len=22) :: MyDate, Time_CurrentString
2133 character (len=40) :: AttName
2134
2135 character (len=*), parameter :: MyFile = &
2136 & __FILE__//", DATA_Export"
2137
2138 character (ESMF_MAXSTR) :: cname, ofile
2139!
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
2146!
2147!-----------------------------------------------------------------------
2148! Initialize return code flag to success state (no error).
2149!-----------------------------------------------------------------------
2150!
2151 IF (esm_track) THEN
2152 WRITE (trac,'(a,a,i0)') '==> Entering DATA_Export', &
2153 & ', PET', petrank
2154 FLUSH (trac)
2155 END IF
2156 rc=esmf_success
2157# ifdef TIME_INTERP
2158 sourcefile=myfile
2159# endif
2160!
2161!-----------------------------------------------------------------------
2162! Get information about the gridded component.
2163!-----------------------------------------------------------------------
2164!
2165 CALL esmf_gridcompget (model, &
2166 & clock=clock, &
2167 & localpet=localpet, &
2168 & petcount=petcount, &
2169 & vm=vm, &
2170 & name=cname, &
2171 & rc=rc)
2172 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2173 & line=__line__, &
2174 & file=myfile)) THEN
2175 RETURN
2176 END IF
2177!
2178!-----------------------------------------------------------------------
2179! Get current time.
2180!-----------------------------------------------------------------------
2181!
2182 CALL esmf_clockget (clock, &
2183 & timestep=timestep, &
2184 & currtime=currenttime, &
2185 & rc=rc)
2186 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2187 & line=__line__, &
2188 & file=myfile)) THEN
2189 RETURN
2190 END IF
2191!
2192 currdate(1:9)=0 ! initialize
2193!
2194 CALL esmf_timeget (currenttime, &
2195 & yy=currdate(1), &
2196 & mm=currdate(2), &
2197 & dd=currdate(3), &
2198 & h =currdate(4), &
2199 & m =currdate(5), &
2200 & s =currdate(6), &
2201 & rc=rc)
2202 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2203 & line=__line__, &
2204 & file=myfile)) THEN
2205 RETURN
2206 END IF
2207!
2208 CALL esmf_timeget (currenttime, &
2209 & s_r8=time_current, &
2210 & timestring=time_currentstring, &
2211 & rc=rc)
2212 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2213 & line=__line__, &
2214 & file=myfile)) THEN
2215 RETURN
2216 END IF
2217
2218# ifdef REGRESS_STARTCLOCK
2219!
2220! Compute current time in days needed for time interpolation. Add one
2221! coupling timestep since it was substracted at configuration. It is
2222! needed to keep the interpolation bounded between LOWER and UPPER
2223! snapshots.
2224!
2225 timeindays=(time_current+ &
2226 & clockinfo(idata)%Time_Step- &
2227 & clockinfo(idata)%Time_Reference)/86400.0_dp
2228# else
2229!
2230! Compute current time in days needed for time interpolation.
2231!
2232 timeindays=(time_current- &
2233 & clockinfo(idata)%Time_Reference)/86400.0_dp
2234# endif
2235 is=index(time_currentstring, 'T') ! remove 'T' in
2236 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2237
2238# ifndef TIME_INTERP
2239!
2240!-----------------------------------------------------------------------
2241! If no exporting the snapshots source data, time interpolate field to
2242! export from snapshots records read from source NetCDF files. The
2243! receiving ESM component will time interpolate the field internally.
2244!-----------------------------------------------------------------------
2245!
2246 CALL data_timeinterp (timeindays, localpet, rc)
2247 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
2248 & line=__line__, &
2249 & file=myfile)) THEN
2250 RETURN
2251 END IF
2252# endif
2253# ifdef TIME_INTERP
2254!
2255!-----------------------------------------------------------------------
2256! Advance unlimited dimension counter.
2257!-----------------------------------------------------------------------
2258!
2259 IF (petlayoutoption.eq.'CONCURRENT') THEN
2260 record=record+1
2261 END IF
2262# endif
2263!
2264!-----------------------------------------------------------------------
2265! Load export fields.
2266!-----------------------------------------------------------------------
2267!
2268 field_loop : DO icomp=1,nmodels
2269 IF (icomp.ne.idata) THEN
2270 nfiles=dataset(icomp)%Nfiles
2271 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
2272 nfields=dataset(icomp)%Nfields
2273 DO ng=1,models(icomp)%Ngrids
2274 IF (coupled(icomp)%LinkedGrid(ng,idata)) THEN
2275 nd=coupled(idata)%DataCoupledSets(ng,icomp)
2276 DO ifld=1,nfields
2277 nvdim=dataset(icomp)%Export(ifld)%Nvdim
2278 shortname=dataset(icomp)%Field(ifld)
2279!
2280! Get target componend import field ID.
2281!
2282 id=field_index(models(icomp)%ImportField, shortname)
2283!
2284! Get field from export state. Use field name from DataSet structure
2285! to follow the order of export data in storage.
2286!
2287 CALL esmf_stateget (coupled(idata)% &
2288 & exportstate(nd,icomp), &
2289 & trim(shortname), &
2290 & field, &
2291 & rc=rc)
2292 IF (esmf_logfounderror(rctocheck=rc, &
2293 & msg=esmf_logerr_passthru, &
2294 & line=__line__, &
2295 & file=myfile)) THEN
2296 RETURN
2297 END IF
2298!
2299! Get number of local decomposition elements (DEs). Usually, a single
2300! DE is associated with each Persistent Execution Thread (PETs). Thus,
2301! localDEcount=1.
2302!
2303 CALL esmf_gridget (dataset(icomp)%Export(ifld)%grid, &
2304 & localdecount=localdecount, &
2305 & rc=rc)
2306 IF (esmf_logfounderror(rctocheck=rc, &
2307 & msg=esmf_logerr_passthru, &
2308 & line=__line__, &
2309 & file=myfile)) THEN
2310 RETURN
2311 END IF
2312!
2313! Get field pointer. Usually, the DO-loop is executed once since
2314! localDEcount=1.
2315!
2316 de_loop : DO localde=0,localdecount-1
2317 IF (nvdim.eq.2) THEN ! 2D field
2318 CALL esmf_fieldget (field, &
2319 & localde=localde, &
2320 & farrayptr=ptr2d, &
2321 & rc=rc)
2322 IF (esmf_logfounderror(rctocheck=rc, &
2323 & msg=esmf_logerr_passthru, &
2324 & line=__line__, &
2325 & file=myfile)) THEN
2326 RETURN
2327 END IF
2328 ptr2d=missing_dp
2329 ELSE IF (nvdim.eq.3) THEN ! 3D field
2330 CALL esmf_fieldget (field, &
2331 & localde=localde, &
2332 & farrayptr=ptr3d, &
2333 & rc=rc)
2334 IF (esmf_logfounderror(rctocheck=rc, &
2335 & msg=esmf_logerr_passthru, &
2336 & line=__line__, &
2337 & file=myfile)) THEN
2338 RETURN
2339 END IF
2340 ptr3d=missing_dp
2341 END IF
2342!
2343! Load field data into export state. Notice that all export fields
2344! are kept as computed by ROMS. The imported component does the
2345! proper scaling, physical units conversion, and other manipulations.
2346! It is done to avoid applying such transformations twice.
2347!
2348 IF (nvdim.eq.2) THEN ! 2D field
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
2354# ifdef TIME_INTERP
2355 fval=dataset(icomp)%Export(ifld)% &
2356 & a2dg(istr,jstr,tindex)
2357# else
2358 fval=dataset(icomp)%Export(ifld)% &
2359 & a2d(istr,jstr)
2360# endif
2361 myfmin(1)=fval
2362 myfmax(1)=fval
2363 DO j=jstr,jend
2364 DO i=istr,iend
2365# ifdef TIME_INTERP
2366 fval=dataset(icomp)%Export(ifld)% &
2367 & a2dg(i,j,tindex)
2368# else
2369 fval=dataset(icomp)%Export(ifld)% &
2370 & a2d(i,j)
2371# endif
2372 myfmin(1)=min(myfmin(1),fval)
2373 myfmax(1)=max(myfmax(1),fval)
2374 ptr2d(i,j)=fval
2375 END DO
2376 END DO
2377 IF (associated(ptr2d)) nullify (ptr2d)
2378 ELSE IF (nvdim.eq.3) THEN ! 3D field
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
2386# ifdef TIME_INTERP
2387 fval=dataset(icomp)%Export(ifld)% &
2388 & a3dg(istr,jstr,kstr,tindex)
2389# else
2390 fval=dataset(icomp)%Export(ifld)% &
2391 & a3d(istr,jstr,kstr)
2392# endif
2393 myfmin(1)=fval
2394 myfmax(1)=fval
2395 DO k=kstr,kend
2396 DO j=jstr,jend
2397 DO i=istr,iend
2398# ifdef TIME_INTERP
2399 fval=dataset(icomp)%Export(ifld)% &
2400 & a3dg(i,j,k,tindex)
2401# else
2402 fval=dataset(icomp)%Export(ifld)% &
2403 & a3d(i,j,k)
2404# endif
2405 myfmin(1)=min(myfmin(1),fval)
2406 myfmax(1)=max(myfmax(1),fval)
2407 ptr3d(i,j,k)=fval
2408 END DO
2409 END DO
2410 END DO
2411 IF (associated(ptr3d)) nullify (ptr3d)
2412 END IF
2413 END DO de_loop
2414!
2415! Get export field minimun and maximum values.
2416!
2417 CALL esmf_vmallreduce (vm, &
2418 & senddata=myfmin, &
2419 & recvdata=fmin, &
2420 & count=1, &
2421 & reduceflag=esmf_reduce_min, &
2422 & rc=rc)
2423 IF (esmf_logfounderror(rctocheck=rc, &
2424 & msg=esmf_logerr_passthru, &
2425 & line=__line__, &
2426 & file=myfile)) THEN
2427 RETURN
2428 END IF
2429!
2430 CALL esmf_vmallreduce (vm, &
2431 & senddata=myfmax, &
2432 & recvdata=fmax, &
2433 & count=1, &
2434 & reduceflag=esmf_reduce_max, &
2435 & rc=rc)
2436 IF (esmf_logfounderror(rctocheck=rc, &
2437 & msg=esmf_logerr_passthru, &
2438 & line=__line__, &
2439 & file=myfile)) THEN
2440 RETURN
2441 END IF
2442
2443# ifdef TIME_INTERP
2444!
2445! Set parameters in the destination component that need for the time
2446! interpolation between snapshots and associated information.
2447!
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)
2455!
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
2464!
2465! If concurrent coupling and exporting time snapshots, write time
2466! interpolation metadata into a NetCDF file. It is very tricky
2467! to perform inter VM communications. It is easier to write them into
2468! a NetCDF file. The importing ESM component needs these vaiables to
2469! perform the time interpolation between snapshots in its kernel.
2470!
2471 IF (petlayoutoption.eq.'CONCURRENT') THEN
2472 myshortname(1,1)=trim(shortname)
2473 CALL netcdf_put_svar (ng, inlm, attfilename, &
2474 & 'field', &
2475 & myshortname, &
2476 & (/1,icomp,id/), &
2477 & (/20,1,1/))
2478 IF (founderror(exit_flag, noerror, __line__, &
2479 & myfile)) THEN
2480 rc=esmf_rc_file_write
2481 RETURN
2482 END IF
2483!
2484 CALL netcdf_put_ivar (ng, inlm, attfilename, &
2485 & 'Tindex', &
2486 & tindex, &
2487 & (/icomp,id,record/), &
2488 & (/1,1,1/))
2489 IF (founderror(exit_flag, noerror, __line__, &
2490 & myfile)) THEN
2491 rc=esmf_rc_file_write
2492 RETURN
2493 END IF
2494!
2495 mydatestring(1,1,1)=mydate
2496 CALL netcdf_put_svar (ng, inlm, attfilename, &
2497 & 'Date', &
2498 & mydatestring, &
2499 & (/1,icomp,id,record/), &
2500 & (/22,1,1,1/))
2501 IF (founderror(exit_flag, noerror, __line__, &
2502 & myfile)) THEN
2503 rc=esmf_rc_file_write
2504 RETURN
2505 END IF
2506!
2507 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2508 & 'Tcurrent', &
2509 & timeindays, &
2510 & (/icomp,id,record/), &
2511 & (/1,1,1/))
2512 IF (founderror(exit_flag, noerror, __line__, &
2513 & myfile)) THEN
2514 rc=esmf_rc_file_write
2515 RETURN
2516 END IF
2517!
2518 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2519 & 'Tstr', &
2520 & tstr, &
2521 & (/icomp,id,record/), &
2522 & (/1,1,1/))
2523 IF (founderror(exit_flag, noerror, __line__, &
2524 & myfile)) THEN
2525 rc=esmf_rc_file_write
2526 RETURN
2527 END IF
2528!
2529 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2530 & 'Tend', &
2531 & tend, &
2532 & (/icomp,id,record/), &
2533 & (/1,1,1/))
2534 IF (founderror(exit_flag, noerror, __line__, &
2535 & myfile)) THEN
2536 rc=esmf_rc_file_write
2537 RETURN
2538 END IF
2539!
2540 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2541 & 'Tintrp', &
2542 & tintrp, &
2543 & (/icomp,id,record/), &
2544 & (/1,1,1/))
2545 IF (founderror(exit_flag, noerror, __line__, &
2546 & myfile)) THEN
2547 rc=esmf_rc_file_write
2548 RETURN
2549 END IF
2550!
2551 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2552 & 'Vtime', &
2553 & vtime, &
2554 & (/icomp,id,record/), &
2555 & (/1,1,1/))
2556 IF (founderror(exit_flag, noerror, __line__, &
2557 & myfile)) THEN
2558 rc=esmf_rc_file_write
2559 RETURN
2560 END IF
2561!
2562 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2563 & 'Tmin', &
2564 & tmin, &
2565 & (/icomp,id,record/), &
2566 & (/1,1,1/))
2567 IF (founderror(exit_flag, noerror, __line__, &
2568 & myfile)) THEN
2569 rc=esmf_rc_file_write
2570 RETURN
2571 END IF
2572!
2573 CALL netcdf_put_fvar (ng, inlm, attfilename, &
2574 & 'Tmax', &
2575 & tmax, &
2576 & (/icomp,id,record/), &
2577 & (/1,1,1/))
2578 IF (founderror(exit_flag, noerror, __line__, &
2579 & myfile)) THEN
2580 rc=esmf_rc_file_write
2581 RETURN
2582 END IF
2583 END IF
2584# endif
2585!
2586! Overwrite the "TimeStamp" attribute with the correct date time
2587! value.
2588!
2589# ifdef TIME_INTERP
2590 mydatevec(1:9)=0
2591 DO i=1,6
2592 mydatevec(i)=int(dataset(icomp)%Export(ifld)% &
2593 & date(i,tindex))
2594 END DO
2595# endif
2596 CALL esmf_attributeset (field, &
2597 & name='TimeStamp', &
2598# ifdef TIME_INTERP
2599 & valuelist=mydatevec, &
2600# else
2601 & valuelist=currdate, &
2602# endif
2603 & convention='NUOPC', &
2604 & purpose='Instance', &
2605 & rc=rc)
2606 IF (esmf_logfounderror(rctocheck=rc, &
2607 & msg=esmf_logerr_passthru, &
2608 & line=__line__, &
2609 & file=myfile)) THEN
2610 RETURN
2611 END IF
2612
2613# ifdef TIME_INTERP_NOT_WORKING
2614!
2615! Set field attributes for time interpolation
2616!
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
2631!
2632! Retrieve custom Attribute Package.
2633!
2634 CALL esmf_attributegetattpack (field, &
2635 & 'CustomConvention', &
2636 & 'General', &
2637!! & 'Instance', &
2638 & attpack=attpack, &
2639 & ispresent=ispresent, &
2640 & rc=rc)
2641 IF (esmf_logfounderror(rctocheck=rc, &
2642 & msg=esmf_logerr_passthru, &
2643 & line=__line__, &
2644 & file=myfile)) THEN
2645 RETURN
2646 END IF
2647!
2648! Set "TimeInterp" attribute for export field.
2649!
2650 CALL esmf_attributeset (field, &
2651 & name='TimeInterp', &
2652 & valuelist=myattvalues, &
2653 & attpack=attpack, &
2654 & rc=rc)
2655 IF (esmf_logfounderror(rctocheck=rc, &
2656 & msg=esmf_logerr_passthru, &
2657 & line=__line__, &
2658 & file=myfile)) THEN
2659 RETURN
2660 END IF
2661# endif
2662!
2663 IF (lreport.and.(localpet.eq.0)) THEN
2664 WRITE (dataout,20) trim(shortname), &
2665 & trim(dataset(icomp)% &
2666 & ctarget(ifld)), ng, &
2667# ifdef TIME_INTERP
2668 & trim(mydate), &
2669 & fmin(1), fmax(1), tindex
2670# else
2671 & trim(time_currentstring), &
2672 & fmin(1), fmax(1)
2673# endif
2674 END IF
2675!
2676! Debugging: write out field information.
2677!
2678 IF (lreport.and.(debuglevel.ge.4)) THEN
2679 CALL esmf_fieldprint(field, &
2680 & rc=rc)
2681 IF (esmf_logfounderror(rctocheck=rc, &
2682 & msg=esmf_logerr_passthru, &
2683 & line=__line__, &
2684 & file=myfile)) THEN
2685 RETURN
2686 END IF
2687 END IF
2688!
2689! Debugging: write out field data into a NetCDF file.
2690!
2691 IF ((debuglevel.ge.3).and. &
2692 & models(idata)%ExportField(ifld)%debug_write) THEN
2693 WRITE (ofile,30) 'data_export', trim(shortname), &
2694# ifdef TIME_INTERP
2695 & mydatevec(1:6)
2696# else
2697 & currdate(1:6)
2698# endif
2699 CALL esmf_fieldwrite (field, &
2700 & trim(ofile), &
2701 & variablename=trim(shortname), &
2702 & overwrite = .true., &
2703 & rc=rc)
2704 IF (esmf_logfounderror(rctocheck=rc, &
2705 & msg=esmf_logerr_passthru, &
2706 & line=__line__, &
2707 & file=myfile)) THEN
2708 RETURN
2709 END IF
2710 END IF
2711 END DO
2712!
2713! Update export sets counter.
2714!
2715 IF (nfields.gt.0) THEN
2716 models(idata)%ExportCalls=models(idata)%ExportCalls+1
2717 END IF
2718 END IF
2719 END DO
2720 END IF
2721 END IF
2722 END DO field_loop
2723!
2724! Flux DATA component standard out unit.
2725!
2726 FLUSH (dataout)
2727 IF (esm_track) THEN
2728 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_Export', &
2729 & ', PET', petrank
2730 FLUSH (trac)
2731 END IF
2732!
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, &
2736# ifdef TIME_INTERP
2737 & '(Dmin= ', 1p,e15.8,0p,' Dmax = ',1p,e15.8,0p, &
2738 & ' SnapshotIndex = ',i1,')')
2739# else
2740 & '(DMin= ', 1p,e15.8,0p,' Dmax= ',1p,e15.8,0p,')')
2741# endif
2742 30 FORMAT (a,'_',a,'_',i4.4,2('-',i2.2),'_',i2.2,2('.',i2.2),'.nc')
2743
2744 RETURN
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_netcdf::netcdf_put_ivar
Definition mod_netcdf.F:96
mod_netcdf::netcdf_put_svar
Definition mod_netcdf.F:108

References mod_esmf_esm::attfilename, mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, data_timeinterp(), mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_scalars::exit_flag, mod_esmf_esm::field_index(), strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_scalars::noerror, mod_esmf_esm::petlayoutoption, mod_esmf_esm::petrank, mod_iounits::sourcefile, mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by data_datainit(), and data_modeladvance().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_initialize()

subroutine, private esmf_data_mod::data_initialize ( type (esmf_gridcomp) model,
real(dp) tcurrent,
integer, intent(in) localpet,
integer, intent(out) rc )
private

Definition at line 658 of file esmf_data.F.

659!
660!=======================================================================
661! !
662! Initializes DATA component upper level structure "DataSet", which !
663! includes complete information about the fields to export. !
664! !
665! The infomation is gathered as follows: !
666! !
667! (1) Initializes the Input Files Structure, IFS(1:Nmodels), so the !
668! associated single or multi file dataset is selected during !
669! initiliazation or restart. !
670! (2) Inquire the contents of NetCDF files associated with each !
671! export field. !
672! (3) Reads source data longitude and latitude for each export !
673! field and, if avalable, read land/sea mask. !
674! (4) Reads LOWER time-snapshot data for each export field such !
675! that: LowerSnapshot < Tcurrent < UpperSnapshot. This is !
676! needed for the time interpolation elsewhere. !
677! !
678! !
679! On Input: !
680! !
681! model DATA component object (TYPE ESMF_GridComp) !
682! Tcurrent Current time in days since reference date (real) !
683! localPET Local Persistent Execution Thread (integer) !
684! !
685! On Output: !
686! !
687! DataSet Updated DATA component structure !
688! rc Return code flag (integer) !
689! !
690! WARNING: !
691! !
692! This routine uses ROMS NetCDF managing framework. !
693! !
694!=======================================================================
695!
696 USE mod_scalars, ONLY : noerror, exit_flag
697!
698 USE strings_mod, ONLY : founderror
699!
700! Imported variable declarations.
701!
702 integer, intent(in) :: localPET
703 integer, intent(out) :: rc
704!
705 real(dp) :: Tcurrent
706!
707 TYPE (ESMF_GridComp) :: model
708!
709! Local variable declarations.
710!
711 logical :: FirstPass, IsUpdated, Lmulti
712!
713 integer :: ExportCount, NfieldsTotal
714 integer :: Icomp, Nfields, Nfiles, ifld
715 integer :: ifile, iMulti, nMultiFiles
716 integer :: id, is
717!
718 character (len=20 ) :: FieldName, nc_vname, nc_tname
719 character (len=100) :: vunits
720 character (len=256) :: mfile, ncfile, longname
721
722 character (len=*), parameter :: MyFile = &
723 & __FILE__//", DATA_Initialize"
724!
725!-----------------------------------------------------------------------
726! Initialize return code flag to success state (no error).
727!-----------------------------------------------------------------------
728!
729 IF (esm_track) THEN
730 WRITE (trac,'(a,a,i0)') '==> Entering DATA_Initialize', &
731 & ', PET', petrank
732 FLUSH (trac)
733 END IF
734 rc=esmf_success
735!
736!-----------------------------------------------------------------------
737! Initialize DATA model input files structures (IFS), so the
738! appropriate single or multi-file is selected during initialization
739! or restart.
740!-----------------------------------------------------------------------
741!
742 DO icomp=1,nmodels
743 IF (icomp.ne.idata) THEN
744 nfiles=dataset(icomp)%Nfiles
745 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
746 CALL data_multifile (tcurrent, dataset(icomp)%IFS, nfiles, &
747 & localpet, rc)
748 IF (esmf_logfounderror(rctocheck=rc, &
749 & msg=esmf_logerr_passthru, &
750 & line=__line__, &
751 & file=myfile)) THEN
752 RETURN
753 END IF
754 END IF
755 END IF
756 END DO
757!
758!-----------------------------------------------------------------------
759! Inquire DATA model NetCDF files associated with each export field.
760!-----------------------------------------------------------------------
761!
762 exportcount=ubound(models(idata)%ExportField, dim=1)
763 nfieldstotal=0 ! total number of fields to export.
764! It should be equal to ExportCount
765 lmulti=.false. ! multi-file switch: needs to be
766! false during initialization
767 DO icomp=1,nmodels
768 IF (icomp.ne.idata) THEN
769 nfiles=dataset(icomp)%Nfiles
770 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
771 nfields=dataset(icomp)%Nfields
772 nfieldstotal=nfieldstotal+nfields
773 DO ifld=1,nfields
774 dataset(icomp)%Export(ifld)%Lmulti=.false. ! initilize
775 fieldname=dataset(icomp)%Field(ifld)
776 id=field_index(models(idata)%ExportField, &
777 & trim(fieldname))
778 IF (id.gt.0) THEN
779 nc_vname=trim(models(idata)%ExportField(id)%nc_vname)
780 nc_tname=trim(models(idata)%ExportField(id)%nc_tname)
781
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)
786 CALL data_inquiry (ifld, nc_vname, nc_tname, &
787 & tcurrent, &
788 & dataset(icomp)%Export, nfields, &
789 & dataset(icomp)%IFS, nfiles, &
790 & lmulti, localpet, rc)
791 IF (esmf_logfounderror(rctocheck=rc, &
792 & msg=esmf_logerr_passthru, &
793 & line=__line__, &
794 & file=myfile)) THEN
795 RETURN
796 END IF
797 ELSE
798 IF (localpet.eq.0) WRITE (dataout,10) trim(fieldname)
799 exit_flag=5
800 IF (founderror(exit_flag, noerror, __line__, &
801 & myfile)) THEN
802 rc=esmf_rc_not_found
803 RETURN
804 END IF
805 END IF
806 END DO
807 END IF
808 END IF
809 END DO
810!
811!-----------------------------------------------------------------------
812! Read in export field longitude and latitude. If available, read
813! land/sea mask or compute it if possible.
814!-----------------------------------------------------------------------
815!
816! Several variables in structure "DataSet(Icomp)%Export(ifld)" will
817! be updated.
818!
819 DO icomp=1,nmodels
820 IF (icomp.ne.idata) THEN
821 nfiles=dataset(icomp)%Nfiles
822 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
823 nfields=dataset(icomp)%Nfields
824 DO ifld=1,nfields
825 fieldname=dataset(icomp)%Field(ifld)
826 CALL data_ncvarcoords (ifld, fieldname, nfields, &
827 & dataset(icomp)%Export, &
828 & localpet, rc)
829 IF (esmf_logfounderror(rctocheck=rc, &
830 & msg=esmf_logerr_passthru, &
831 & line=__line__, &
832 & file=myfile)) THEN
833 RETURN
834 END IF
835 dataset(icomp)%Export(ifld)%Icomp=icomp
836 END DO
837 END IF
838 END IF
839 END DO
840!
841!-----------------------------------------------------------------------
842! Read in DATA component fields from source NetCDF files and load
843! into first record of snapshot arrays. This is the first pass to
844! the processing of data needed for the time interpolation of fields
845! to export.
846!-----------------------------------------------------------------------
847!
848 IF ((localpet.eq.0).and.(petlayoutoption.eq.'CONCURRENT')) THEN
849 WRITE (dataout,20)
850 END IF
851 firstpass=.true.
852 CALL data_ncread (tcurrent, firstpass, localpet, isupdated, rc)
853 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
854 & line=__line__, &
855 & file=myfile)) THEN
856 RETURN
857 END IF
858!
859!-----------------------------------------------------------------------
860! Initilize the multifile switch indicating that the DATA time records
861! are split into several files, like monthly, annual. etc. It needs
862! to be done after the first call to "DATA_ncread". The logic for it
863! is complicated because of the various possibilities.
864!-----------------------------------------------------------------------
865!
866 DO icomp=1,nmodels
867 IF (icomp.ne.idata) THEN
868 nfiles=dataset(icomp)%Nfiles
869 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
870 nfields=dataset(icomp)%Nfields
871 fld_loop : DO ifld=1,nfields
872 ncfile=dataset(icomp)%Export(ifld)%ncfile
873 dataset(icomp)%Export(ifld)%Lmulti=.false. ! initilize
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.
881 EXIT ifs_loop
882 END IF
883 END DO
884 END IF
885 END DO ifs_loop
886 END DO fld_loop
887 END IF
888 END IF
889 END DO
890!
891 IF (esm_track) THEN
892 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_Initialize', &
893 & ', PET', petrank
894 FLUSH (trac)
895 END IF
896!
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('='),/)
900
901 RETURN

References data_inquiry(), data_multifile(), data_ncread(), data_ncvarcoords(), mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_scalars::exit_flag, mod_esmf_esm::field_index(), strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_scalars::noerror, mod_esmf_esm::petlayoutoption, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setinitializep2().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_inquiry()

subroutine, private esmf_data_mod::data_inquiry ( integer, intent(in) ifield,
character (len=*), intent(in) ncvname,
character (len=*), intent(in) nctname,
real(dp) tcurrent,
type(esm_data), dimension(nfields), intent(inout) export,
integer, intent(in) nfields,
type(t_io), dimension(nfiles), intent(inout) ifs,
integer, intent(in) nfiles,
logical, intent(in) lmulti,
integer, intent(in) localpet,
integer, intent(out) rc )
private

Definition at line 3782 of file esmf_data.F.

3785!
3786!=======================================================================
3787! !
3788! This routine inquires DATA model variable to process from input !
3789! NetCDF files. !
3790! !
3791! On Input: !
3792! !
3793! ifield Field index in Export structure to process (integer) !
3794! ncvname DATA model NetCDF field variable to process (string) !
3795! nctname DATA model NetCDF time variable to process (string) !
3796! Tcurrent Current time in days since reference date (real) !
3797! Export DATA component structure, TYPE(ESM_Data) !
3798! Nfields Number of fields in Export structure (interger) !
3799! IFS DATA model Input Files Structure, TYPE(T_IO) !
3800! Nfiles Number of files in IFS structure (integer) !
3801! Lmuti Switch indicating multifiles for field (logical) !
3802! localPET Local Persistent Execution Thread (integer) !
3803! !
3804! On Output: !
3805! !
3806! Export Updated DATA component structure !
3807! rc Return code flag (integer) !
3808! !
3809! WARNING: !
3810! !
3811! This routine uses ROMS NetCDF managing framework. !
3812! !
3813!=======================================================================
3814!
3815 USE mod_param
3816 USE mod_netcdf
3817 USE mod_iounits
3818 USE mod_scalars
3819!
3820 USE strings_mod, ONLY : founderror, lowercase, uppercase
3821!
3822! Imported variable declarations.
3823!
3824 logical, intent(in) :: Lmulti
3825!
3826 integer, intent(in) :: ifield, Nfields, Nfiles
3827 integer, intent(in) :: localPET
3828 integer, intent(out) :: rc
3829!
3830 real(dp) :: Tcurrent
3831!
3832 TYPE(ESM_Data), intent(inout) :: Export(Nfields)
3833 TYPE(T_IO), intent(inout) :: IFS(Nfiles)
3834!
3835 character (len=*), intent(in) :: ncvname, nctname
3836!
3837! Local variable declarations.
3838!
3839 logical :: CloseFile, Lcycle, Linside, LowerBound, Upperbound
3840 logical :: foundAtt(1), foundit, got_coord, got_var, got_time
3841!
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
3846 integer :: ROMScomm
3847 integer :: Vsize(4)
3848!
3849 integer, parameter :: imodel = 1 ! for compatibility with ROMS
3850 integer, parameter :: ng = 1 ! used routines
3851!
3852 real(dp) :: Clength, Tday, Tend, Tmax, Tmin, Tmono, Tscale, Tstr
3853 real(dp) :: scale, tstart
3854!
3855 real(dp), allocatable :: TimeValue(:)
3856!
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)
3864
3865 character (len=*), parameter :: MyFile = &
3866 & __FILE__//", DATA_inquiry"
3867!
3868!-----------------------------------------------------------------------
3869! Initialize return code flag to success state (no error).
3870!-----------------------------------------------------------------------
3871!
3872 IF (esm_track) THEN
3873 WRITE (trac,'(a,a,i0)') '==> Entering DATA_inquiry', &
3874 & ', PET', petrank
3875 FLUSH (trac)
3876 END IF
3877 rc=esmf_success
3878 sourcefile=myfile
3879!
3880!-----------------------------------------------------------------------
3881! Inquire about DATA model variable to process
3882!-----------------------------------------------------------------------
3883!
3884! Initialize local variables.
3885!
3886 lcycle=.false.
3887 linside=.false.
3888 lowerbound=.false.
3889 upperbound=.false.
3890 got_coord=.false.
3891 got_time=.false.
3892 got_var=.false.
3893 fcount=0 ! initialize?
3894 nrec=0
3895 trec=0
3896 zlevel=-1
3897 DO i=1,len(ncfile)
3898 ncfile(i:i)=blank
3899 END DO
3900 clength=missing_dp
3901 IF (localpet.eq.0) THEN
3902 WRITE (dataout,5) trim(ncvname)
3903 END IF
3904!
3905! If multi-files, increase (decrease if backward logic) file counter
3906! and set new file names.
3907!
3908 IF (lmulti) THEN
3909 DO ifile=1,nfiles
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
3916 END IF
3917 exit_flag=4
3918 rc=esmf_rc_not_valid
3919 IF (founderror(exit_flag, noerror, __line__, &
3920 & myfile)) RETURN
3921 END IF
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)
3926 CALL netcdf_close (ng, imodel, ifs(ifile)%ncid)
3927 IF (founderror(exit_flag, noerror, __line__, &
3928 & myfile)) THEN
3929 rc=esmf_rc_file_close
3930 RETURN
3931 END IF
3932 EXIT
3933 ELSE ! IFS(ifile)%name and Fcount
3934 fcount=ifs(ifile)%Fcount ! already updated in first field
3935 END IF ! processed for current new file
3936 END DO
3937 ELSE
3938 fcount=ifs(1)%Fcount
3939 END IF
3940 IF (fcount.eq.0) THEN
3941 IF (localpet.eq.0) THEN
3942 WRITE (dataout,20) fcount, label, trim(ncvname)
3943 END IF
3944 rc=esmf_rc_not_set
3945 exit_flag=4
3946 IF (founderror(exit_flag, noerror, __line__, &
3947 & myfile)) RETURN
3948 END IF
3949!
3950!-----------------------------------------------------------------------
3951! If several input NetCDF files (Nfiles>1), scan files until the
3952! requested variable is found.
3953!-----------------------------------------------------------------------
3954!
3955 foundit=.false.
3956 query: DO ifile=1,nfiles
3957 fname=ifs(ifile)%name
3958!
3959! Open NetCDF file for reading.
3960!
3961 IF (ifs(ifile)%ncid.eq.-1) THEN
3962 CALL netcdf_open (ng, imodel, fname, 0, ncid)
3963 IF (founderror(exit_flag, noerror, __line__, &
3964 & myfile)) THEN
3965 rc=esmf_rc_file_open
3966 IF (localpet.eq.0) WRITE (dataout,30) trim(fname)
3967 RETURN
3968 END IF
3969 closefile=.true.
3970 ELSE
3971 ncid=ifs(ifile)%ncid
3972 closefile=.false.
3973 END IF
3974!
3975! Inquire about requested variable.
3976!
3977 CALL netcdf_inq_var (ng, imodel, fname, &
3978 & ncid = ncid, &
3979 & myvarname = trim(ncvname), &
3980 & searchvar = foundit, &
3981 & varid = vid, &
3982 & nvardim = nvdim, &
3983 & nvaratt = nvatt)!
3984 IF (founderror(exit_flag, noerror, __line__, &
3985 & myfile)) THEN
3986 rc=esmf_rc_file_read
3987 RETURN
3988 END IF
3989!
3990! Set variable information. So far, we are exporting only 2D fields
3991! from the DATA Model, Export(ifield)%Nvdim=2. Only spatial dimensions
3992! are counted. All dataset have an additional time dimension. Notice
3993! that 2D fields can be extracted from the full 3D field at the desired
3994! depth level index.
3995!
3996! HGA: We need logic here when exporting 3D full fields in the future.
3997! I hate hardwired code but this is postponed. Perhaps, it needs
3998! to be specified in input metadata.
3999!
4000 probe: IF (foundit) THEN
4001 IF (localpet.eq.0) THEN
4002 WRITE (dataout,35) trim(fname)
4003 END IF
4004 got_var=.true.
4005 ncfile=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 ! only 2D fields for now
4011
4012 IF (.not.allocated(export(ifield)%Vsize)) THEN
4013 allocate ( export(ifield)%Vsize(nvdim) )
4014 export(ifield)%Vsize(1:nvdim)=0
4015 END IF
4016 IF (.not.allocated(export(ifield)%Dname)) THEN
4017 allocate ( export(ifield)%Dname(nvdim) )
4018 export(ifield)%Dname(1:nvdim)=' '
4019 END IF
4020 IF (.not.allocated(export(ifield)%Vcoord)) THEN
4021 allocate ( export(ifield)%Vcoord(nvdim) )
4022 export(ifield)%Vcoord(1:nvdim)=' '
4023 END IF
4024
4025 DO i=1,nvdim
4026 export(ifield)%Dname(i)=var_dname(i)
4027 export(ifield)%Vsize(i)=var_dsize(i)
4028 END DO
4029!
4030! If singleton depth dimension, set level index to process.
4031!
4032 IF ((nvdim.eq.4).and.(var_dsize(3).eq.1)) THEN
4033 zlevel=1
4034 END IF
4035!
4036! If the NetCDF file is CF compliant, the variable dimensions and the
4037! space and time coordinates have the same names. Therefo, check if
4038! a time varible name with same time dimension name exist.
4039!
4040 DO i=1,n_var
4041 IF (trim(var_name(i)).eq.trim(var_dname(nvdim))) THEN
4042 t_name=trim(var_name(i))
4043 nrec=var_dsize(nvdim)
4044 got_time=.true.
4045 EXIT
4046 END IF
4047 END DO
4048!
4049! Check NetCDF file global attributes to identify data source. If
4050! If HyCOM Tripolar grid, reset horizontal dimensions by removing last
4051! row at j=Jmax. The global HyCOM grid is rectilinear from j=1 to
4052! j=2172, and we can check this by confirming that the MINVAL and
4053! MAXVAL of lat(1:4500,j) are identical there. The grid is curvilinear
4054! (bi-polar patch) from j=2173 to j=3298. Note that the j=3298 row is
4055! a permuted copy of j=3297 (because of the way the tripole grid is
4056! implemented in HYCOM), so we can discard j=3298.
4057!
4058 export(ifield)%SpecialAction='NONE'
4059 DO i=1,n_gatt
4060 attname(1)=trim(att_name(i))
4061 IF (att_kind(i).eq.nf90_char) THEN
4062 CALL netcdf_get_satt (ng, imodel, fname, nf90_global, &
4063 & attname, attvalue, &
4064 & foundatt, &
4065 & ncid = ncid)
4066 IF (founderror(exit_flag, noerror, __line__, &
4067 & myfile)) THEN
4068 rc=esmf_rc_file_read
4069 RETURN
4070 END IF
4071 IF ((index(trim(uppercase(attvalue(1))), &
4072 & 'HYCOM').ne.0).and. &
4073 & ((var_dsize(1).eq.4500).and. &
4074 & (var_dsize(2).eq.3298))) THEN
4075 export(ifield)%SpecialAction='HYCOM TRIPOLAR GRID'
4076 export(ifield)%Vsize(2)=var_dsize(2)-1 ! discard j=3298
4077 IF ((nvdim.eq.4).and.(var_dsize(3).gt.1)) THEN
4078 zlevel=1 ! Depth = 0 m is at level 1
4079 END IF
4080 EXIT
4081 END IF
4082 END IF
4083 END DO
4084!
4085! Load depth level to process, if any.
4086!
4087 export(ifield)%Zlevel=zlevel
4088!
4089! Check variable for several attributes:
4090!
4091! "add_offset" if present, value to add the data
4092! "scale_factor" if present, factor to mutliply the data
4093! "_FillValue" fill value for missing data
4094! "coordinates" variable spatial and temporal coordinates
4095! "time" associated time variable
4096! "units" variable units (overwrite metadata value)
4097!
4098 DO i=1,nvatt
4099 SELECT CASE (trim(var_aname(i)))
4100 CASE ('add_offset')
4101 export(ifield)%add_offset=var_afloat(i)
4102 CASE ('scale_factor')
4103 export(ifield)%scale_factor=var_afloat(i)
4104 CASE ('_FillValue', 'missing_value')
4105 export(ifield)%FillValue=var_afloat(i)
4106 CASE ('coordinates')
4107 cstring=trim(adjustl(var_achar(i)))
4108 export(ifield)%Vcoord=trim(cstring)
4109 got_coord=.true.
4110 CASE ('time')
4111 IF (.not.got_time) THEN
4112 t_name=trim(var_achar(i))
4113 lstr=len_trim(t_name)
4114 DO j=1,n_vdim
4115 IF (trim(var_dname(j)).eq.t_name(1:lstr)) THEN
4116 nrec=var_dsize(j)
4117 EXIT
4118 END IF
4119 END DO
4120 got_time=.true.
4121 END IF
4122 CASE ('long_name')
4123 export(ifield)%Vlongname=trim(var_achar(i))
4124 CASE ('units')
4125 export(ifield)%Vunits=trim(var_achar(i))
4126 END SELECT
4127 END DO
4128!
4129! If the "coordinates" is present, extract variables strings.
4130!
4131 export(ifield)%Lcoord=got_coord
4132 IF (got_coord) THEN
4133 clen=len_trim(cstring)
4134 is=1
4135 DO i=1,nvdim
4136 iblank=index(cstring(is:clen),' ')
4137 IF (iblank.eq.0) THEN
4138 ie=clen+1 ! last value, add 1
4139 ELSE
4140 ie=iblank+is-1 ! includes blank index
4141 END IF
4142 coordinates(i)=cstring(is:ie-1)
4143 export(ifield)%Vcoord(i)=trim(coordinates(i))
4144 is=ie+1
4145 END DO
4146!
4147! If found associated time variable, overwrite time coordinate to
4148! insure that we have the correct variable. For example, HyCOM data
4149! use 'Date' in the coordinate attribute instead of the actul time
4150! variable.
4151!
4152 IF (got_time) THEN
4153 coordinates(nvdim)=trim(t_name)
4154 export(ifield)%Vcoord(nvdim)=trim(t_name)
4155 END IF
4156!
4157! If not found time variable, inquire the coordinates for a variable
4158! that contains the "time" string. If unsucessful, use the last
4159! string in the coordinates attribute which is usually the time
4160! variable.
4161!
4162 IF (.not.got_time) THEN
4163 DO i=1,nvdim
4164 IF (index(trim(lowercase(coordinates(i))),'time') &
4165 & .ne.0) THEN
4166 t_name=trim(coordinates(i))
4167 nrec=var_dsize(i)
4168 got_time=.true.
4169 END IF
4170 END DO
4171 IF (.not.got_time) THEN
4172 t_name=trim(coordinates(nvdim))
4173 nrec=var_dsize(nvdim)
4174 got_time=.true.
4175 END IF
4176 END IF
4177 END IF
4178!
4179! If Nrec=0, input file is not CF compliant, check variable dimension
4180! to see if the dimension contains the "time" string.
4181!
4182 IF (.not.(got_time.or.got_coord)) THEN
4183 DO i=1,nvdim
4184 IF (index(trim(lowercase(var_dname(i))),'time').ne.0) THEN
4185 t_name=trim(var_dname(i))
4186 nrec=var_dsize(i)
4187 got_time=.true.
4188 END IF
4189 END DO
4190 END IF
4191 IF (.not.got_time.and.(nrec.eq.0)) THEN
4192 IF (localpet.eq.0) WRITE (dataout,40) trim(t_name), &
4193 & trim(ncvname), &
4194 & trim(fname)
4195 rc=esmf_rc_not_found
4196 exit_flag=4
4197 IF (founderror(exit_flag, noerror, __line__, &
4198 & myfile)) RETURN
4199 END IF
4200!
4201! Inquire about associated time variable.
4202!
4203 IF (got_time.and.(nrec.ge.1)) THEN
4204 CALL netcdf_inq_var (ng, imodel, fname, &
4205 & ncid = ncid, &
4206 & myvarname = trim(t_name), &
4207 & varid = tid, &
4208 & nvardim = ntdim, &
4209 & nvaratt = ntatt)
4210 IF (founderror(exit_flag, noerror, __line__, &
4211 & myfile)) THEN
4212 rc=esmf_rc_file_read
4213 RETURN
4214 END IF
4215 export(ifield)%Tname=trim(t_name)
4216 export(ifield)%Tid=tid
4217 export(ifield)%Nrec=nrec
4218!
4219! Check associated time variable attributes. The internal processing of
4220! all fields requires time in day units
4221!
4222 DO i=1,ntatt
4223 SELECT CASE (trim(var_aname(i)))
4224 CASE ('cycle_length')
4225 lcycle=.true. ! time cycling data
4226 IF (var_afloat(i).gt.0.0_r8) THEN
4227 clength=var_afloat(i)
4228 ELSE IF (var_aint(i).gt.0) THEN ! no CF compliance
4229 clength=real(var_aint(i),r8) ! attribute is an
4230 ELSE ! integer
4231 IF (localpet.eq.0) &
4232 WRITE (dataout,50) trim(var_aname(i)), &
4233 & trim(t_name)
4234 rc=esmf_rc_val_wrong
4235 exit_flag=2
4236 IF (founderror(exit_flag, noerror, __line__, &
4237 & myfile)) RETURN
4238 END IF
4239 export(ifield)%Lcycle=lcycle
4240 export(ifield)%Clength=clength
4241 CASE ('units')
4242 tunits=trim(var_achar(i))
4243 IF (tunits(1:6).eq.'second') THEN
4244 tscale=1.0_dp/86400.0_dp ! seconds to days
4245 ELSE IF (tunits(1:4).eq.'hour') THEN
4246 tscale=1.0_dp/24.0_dp ! hours to days
4247 ELSE
4248 tscale=1.0_dp ! default day units
4249 END IF
4250 export(ifield)%Tunits=trim(tunits)
4251 export(ifield)%Tscale=tscale
4252 END SELECT
4253 END DO
4254!
4255! Read associated time variable.
4256!
4257 IF (.not.allocated(timevalue)) THEN
4258 allocate ( timevalue(nrec) )
4259 END IF
4260 CALL netcdf_get_time (ng, imodel, fname, t_name, &
4261 & referencedatenumber, &
4262 & timevalue, &
4263 & ncid = ncid, &
4264 & start = (/1/), &
4265 & total = (/nrec/), &
4266 & min_val = tmin, &
4267 & max_val = tmax)
4268 IF (founderror(exit_flag, noerror, __line__, &
4269 & myfile)) THEN
4270 rc=esmf_rc_file_read
4271 RETURN
4272 END IF
4273!
4274! Scale time variable to days. Determine the minimum and maximum time
4275! values available.
4276!
4277 DO i=1,nrec
4278 timevalue(i)=timevalue(i)*tscale
4279 END DO
4280 tmin=tmin*tscale
4281 tmax=tmax*tscale
4282 tstr=tmin ! initialize for the case of
4283 tend=tmax ! Nrec=1
4284 IF (lcycle) THEN
4285 tday=mod(tcurrent,clength)
4286 ELSE
4287 tday=tcurrent
4288 END IF
4289!
4290! Is the model time inside the data time range? If not, check if the
4291! data just has the LOWER- or the UPPER-snapshot interpolant.
4292!
4293 IF ((tmin.le.tday).and.(tday.le.tmax)) THEN
4294 linside=.true.
4295 ELSE IF (tday.ge.tmax) THEN
4296 lowerbound=.true.
4297 ELSE IF (tday.le.tmin) THEN
4298 upperbound=.true.
4299 END IF
4300!
4301! If processing field split in several files, find UPPER time-snapshot
4302! and its associated time record (Trec).
4303!
4304 IF (lmulti) THEN
4305 DO i=1,nrec
4306 IF (timevalue(i).gt.tday) THEN
4307 trec=i-1 ! one is added when processing
4308 tend=timevalue(i)
4309 EXIT
4310 END IF
4311 END DO
4312!
4313! If not processing a multi-file field or initialization, find LOWER
4314! time-snapshot and its associated time record (Trec). Notice that the
4315! conditional below uses (Tstr .le. Tday .le. Tend) when bracketing the
4316! LOWER time-snapshot instead the usual (Tstr .le. Tday .lt. Tend). It
4317! is to transition smoothly from the end of a multifile to the next
4318! during initialization when Lmulti is still false. The logic is
4319! tricky. We need to check if Tday is equal to the time of the last
4320! record in the file to compute Trec correctly if "TIME_INTERP" is
4321! activated.
4322!
4323 ELSE
4324 IF (linside) THEN
4325 tstart=tmin
4326 DO i=2,nrec
4327 IF ((tstart.le.tday).and.(tday.le.timevalue(i))) THEN
4328 IF ((tday.eq.timevalue(i)).and.(i.ne.nrec)) THEN
4329 tstr=timevalue(i)
4330 trec=i ! one is added when processing
4331 ELSE
4332 tstr=tstart
4333 trec=i-1 ! one is added when processing
4334 END IF
4335 EXIT
4336 END IF
4337 tstart=timevalue(i)
4338 END DO
4339 ELSE
4340 tstr=tmax ! LowerBound for next multifile or
4341 trec=nrec ! time cycling
4342 END IF
4343 END IF
4344!
4345! If processing a multi-file field, set LOWER time-snapshot. It
4346! is the last value from previous file. Otherwise, set UPPER
4347! time-snapshot.
4348!
4349 IF (lmulti) THEN
4350 tstr=export(ifield)%Tmax ! Tmax from previous file
4351 ELSE
4352 IF (lcycle.and.(trec.eq.nrec)) THEN
4353 tend=tmin
4354 ELSE
4355 i=min(nrec,trec+1)
4356 tend=timevalue(i)
4357 END IF
4358 END IF
4359 IF (allocated(timevalue)) THEN
4360 deallocate (timevalue)
4361 END IF
4362 export(ifield)%Tmin=tmin
4363 export(ifield)%Tmax=tmax
4364 export(ifield)%Tstr=tstr
4365 export(ifield)%Tend=tend
4366!
4367! If not cycling, stop execution if there is not field data
4368! available for current model time. Avoid check on tidal data
4369! since time is in terms of frequencies.
4370!
4371 IF (.not.lcycle.and.(nrec.gt.1)) THEN
4372 IF (lmulti) THEN
4373 IF (tcurrent.gt.tmax) THEN
4374 IF (localpet.eq.0) WRITE (dataout,60) trim(t_name), &
4375 & tmax, tcurrent
4376 rc=esmf_rc_val_wrong
4377 exit_flag=2
4378 IF (founderror(exit_flag, noerror, __line__, &
4379 & myfile)) RETURN
4380 ELSE IF (export(ifield)%LastRec) THEN
4381 IF (tmin.lt.tcurrent) THEN
4382 IF (localpet.eq.0) THEN
4383 WRITE (dataout,70) &
4384 & 'Upper snapshot time for multi-file variable:', &
4385 & trim(t_name), &
4386 & trim(ncvname), &
4387 & 'is less than current model time.', &
4388 & 'Tmin = ', tmin, tcurrent
4389 END IF
4390 rc=esmf_rc_val_wrong
4391 exit_flag=2
4392 IF (founderror(exit_flag, noerror, __line__, &
4393 & myfile)) RETURN
4394 END IF
4395 END IF
4396 ELSE
4397 IF (.not.upperbound.and.(tcurrent.lt.tmin)) THEN
4398 IF (localpet.eq.0) THEN
4399 WRITE (dataout,70) &
4400 & 'starting time for variable:', &
4401 & trim(t_name), &
4402 & trim(ncvname), &
4403 & 'is greater than current model time.', &
4404 & 'Tmin = ', tmin, tcurrent
4405 END IF
4406 rc=esmf_rc_val_wrong
4407 exit_flag=2
4408 IF (founderror(exit_flag, noerror, __line__, &
4409 & myfile)) RETURN
4410 END IF
4411 END IF
4412 END IF
4413 END IF
4414 export(ifield)%ncfile=trim(fname) ! sucess query, need to
4415 EXIT query ! exit and keep last
4416 ELSE ! value for "ifile"
4417 IF (.not.lmulti) THEN
4418 ncfile=fname ! need for error report
4419 END IF
4420 END IF probe
4421!
4422! Close input NetCDF file if opened during the query. Files opened
4423! outside the query loop remain open. This is done to avoid opening
4424! too many files.
4425!
4426 IF (closefile) THEN
4427 CALL netcdf_close (ng, imodel, ncid, fname)
4428 IF (founderror(exit_flag, noerror, __line__, &
4429 & myfile)) THEN
4430 rc=esmf_rc_file_close
4431 RETURN
4432 END IF
4433 END IF
4434 END DO query
4435!
4436!-----------------------------------------------------------------------
4437! Terminate execution requested variables are not found.
4438!-----------------------------------------------------------------------
4439!
4440 IF (.not.got_var) THEN
4441 lstr=len_trim(ncfile)
4442 IF (localpet.eq.0) THEN
4443 WRITE (dataout,80) trim(ncvname), 'file:'
4444 IF (lstr.gt.0) THEN
4445 WRITE (dataout,'(15x,a)') trim(ncfile)
4446 ELSE
4447 WRITE (dataout,'(15x,a,a)') 'file name is blank, ', &
4448 & 'cannot be determined.'
4449 END IF
4450 END IF
4451 rc=esmf_rc_not_found
4452 exit_flag=2
4453 IF (founderror(exit_flag, noerror, __line__, &
4454 & myfile)) RETURN
4455 END IF
4456!
4457 IF (.not.got_time) THEN
4458 lstr=len_trim(ncfile)
4459 IF (localpet.eq.0) THEN
4460 WRITE (dataout,80) trim(t_name), 'file:'
4461 IF (lstr.gt.0) THEN
4462 WRITE (dataout,'(15x,a)') trim(ncfile)
4463 ELSE
4464 WRITE (dataout,'(15x,a,a)') 'file name is blank, ', &
4465 & 'cannot be determined.'
4466 END IF
4467 END IF
4468 rc=esmf_rc_not_found
4469 exit_flag=2
4470 IF (founderror(exit_flag, noerror, __line__, &
4471 & myfile)) RETURN
4472 END IF
4473!
4474!-----------------------------------------------------------------------
4475! If appropriate, open input NetCDF file for reading. Notice that the
4476! "ifile" is correct here because of EXIT QUERY command.
4477! HGA: Why is there a need to open the appropiate file? It is still
4478! open when the variable is found and processed.
4479!-----------------------------------------------------------------------
4480!
4481 IF (ifs(ifile)%ncid.eq.-1) THEN
4482 CALL netcdf_open (ng, imodel, ncfile, 0, ncid)
4483 IF (founderror(exit_flag, noerror, __line__, &
4484 & myfile)) THEN
4485 rc=esmf_rc_file_open
4486 IF (localpet.eq.0) WRITE (dataout,60) trim(ncfile)
4487 RETURN
4488 END IF
4489 ifs(ifile)%ncid=ncid
4490 END IF
4491!
4492!-----------------------------------------------------------------------
4493! The strategy here is to create a local, monotonically increasing
4494! time variable so the interpolation between snapshots is trivial
4495! when time cycling data. Notice that a one is substracted to time
4496! record counter "Trec" to avoid doing special case at initialization.
4497!-----------------------------------------------------------------------
4498!
4499 IF (.not.lmulti) THEN
4500 IF (lcycle) THEN ! time cycling of data, like
4501 IF (trec.eq.nrec) THEN ! for perpectual annual forcing
4502 IF (tcurrent.lt.tmax) THEN
4503 tmono=tstr-clength
4504 ELSE
4505 tmono=tcurrent+(tstr-clength)
4506 IF (tstr.eq.tmax) THEN
4507 tmono=tmono+(tmin-mod(tcurrent+tmin,clength))
4508 ELSE
4509 tmono=tmono+(tstr-mod(tcurrent+tstr,clength))
4510 END IF
4511 END IF
4512 ELSE
4513 IF (tcurrent.gt.clength) THEN
4514 tmono=tcurrent-mod(tdays(ng)-tstr,clength)
4515 ELSE
4516 tmono=tstr
4517 END IF
4518 END IF
4519 ELSE
4520 tmono=tstr
4521 END IF
4522 tindex=2
4523 trec=trec-1
4524 export(ifield)%Tindex=tindex
4525 export(ifield)%Trec=trec
4526 export(ifield)%Tmono=tmono
4527 export(ifield)%Vtime(tindex)=tstr
4528 ELSE
4529 tindex=2
4530 export(ifield)%Tindex=tindex
4531 export(ifield)%Trec=trec
4532 export(ifield)%Vtime(tindex)=tstr
4533 END IF
4534!
4535 IF (esm_track) THEN
4536 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_inquiry', &
4537 & ', PET', petrank
4538 FLUSH (trac)
4539 END IF
4540!
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: ', &
4564 & a,/,16x,'in ',a)
4565
4566 RETURN
mod_iounits::ncfile
character(len=256) ncfile
Definition mod_iounits.F:318
mod_netcdf::var_aint
integer, dimension(nvara) var_aint
Definition mod_netcdf.F:178
mod_netcdf::netcdf_get_satt
subroutine, public netcdf_get_satt(ng, model, ncname, varid, attname, attvalue, foundit, ncid)
Definition mod_netcdf.F:2339
mod_netcdf::n_vdim
integer n_vdim
Definition mod_netcdf.F:173
mod_netcdf::att_name
character(len=100), dimension(matts) att_name
Definition mod_netcdf.F:167
mod_netcdf::att_kind
integer, dimension(matts) att_kind
Definition mod_netcdf.F:157
mod_netcdf::var_afloat
real(r8), dimension(nvara) var_afloat
Definition mod_netcdf.F:179
mod_netcdf::var_dname
character(len=100), dimension(nvard) var_dname
Definition mod_netcdf.F:182
mod_netcdf::n_gatt
integer n_gatt
Definition mod_netcdf.F:153
mod_param
Definition mod_param.F:2
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
strings_mod::uppercase
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582

References mod_netcdf::att_kind, mod_netcdf::att_name, mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), strings_mod::lowercase(), mod_esmf_esm::missing_dp, mod_netcdf::n_gatt, mod_netcdf::n_var, mod_netcdf::n_vdim, mod_iounits::ncfile, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_get_satt(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_esmf_esm::petrank, mod_esmf_esm::referencedatenumber, mod_iounits::sourcefile, mod_scalars::tdays, mod_esmf_esm::trac, strings_mod::uppercase(), mod_netcdf::var_achar, mod_netcdf::var_afloat, mod_netcdf::var_aint, mod_netcdf::var_aname, mod_netcdf::var_dname, mod_netcdf::var_dsize, and mod_netcdf::var_name.

Referenced by data_initialize(), and data_ncread().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_modeladvance()

subroutine, private esmf_data_mod::data_modeladvance ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1775 of file esmf_data.F.

1776!
1777!=======================================================================
1778! !
1779! Advance DATA component for a coupling interval (seconds) using !
1780! "DATA_run". It also calls "DATA_Export" to export coupling fields. !
1781! !
1782!=======================================================================
1783!
1784 USE mod_param
1785 USE mod_scalars
1786!
1787! Imported variable declarations.
1788!
1789 integer, intent(out) :: rc
1790
1791 TYPE (ESMF_GridComp) :: model
1792!
1793! Local variable declarations.
1794!
1795 logical :: FirstPass, IsUpdated, Lreport
1796!
1797 integer :: MyTask, PETcount, is, localPET, phase
1798!
1799 real (dp) :: CouplingInterval, RunInterval
1800 real (dp) :: TcurrentInSeconds, TstopInSeconds
1801 real (dp) :: TcurrentInDays
1802!
1803 character (len=22) :: Cinterval
1804 character (len=22) :: CurrTimeString, StopTimeString
1805
1806 character (len=*), parameter :: MyFile = &
1807 & __FILE__//", DATA_ModelAdvance"
1808!
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
1815!
1816!-----------------------------------------------------------------------
1817! Initialize return code flag to success state (no error).
1818!-----------------------------------------------------------------------
1819!
1820 IF (esm_track) THEN
1821 WRITE (trac,'(a,a,i0)') '==> Entering DATA_ModelAdvance', &
1822 & ', PET', petrank
1823 FLUSH (trac)
1824 END IF
1825 rc=esmf_success
1826!
1827!-----------------------------------------------------------------------
1828! Get information about the gridded component.
1829!-----------------------------------------------------------------------
1830!
1831! Inquire about DATA component.
1832!
1833 CALL esmf_gridcompget (model, &
1834 & importstate=importstate, &
1835 & exportstate=exportstate, &
1836 & clock=clock, &
1837 & localpet=localpet, &
1838 & petcount=petcount, &
1839 & currentphase=phase, &
1840 & vm=vm, &
1841 & rc=rc)
1842 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1843 & line=__line__, &
1844 & file=myfile)) THEN
1845 RETURN
1846 END IF
1847!
1848! Get time step interval, stopping time, reference time, and current
1849! time.
1850!
1851 CALL esmf_clockget (clock, &
1852 & timestep=timestep, &
1853 & stoptime=stoptime, &
1854 & reftime=referencetime, &
1855 & currtime=clockinfo(idata)%CurrentTime, &
1856 & rc=rc)
1857 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1858 & line=__line__, &
1859 & file=myfile)) THEN
1860 RETURN
1861 END IF
1862!
1863! Current DATA component time (seconds).
1864!
1865 CALL esmf_timeget (clockinfo(idata)%CurrentTime, &
1866 & s_r8=tcurrentinseconds, &
1867 & timestringisofrac=currtimestring, &
1868 & rc=rc)
1869 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1870 & line=__line__, &
1871 & file=myfile)) THEN
1872 RETURN
1873 END IF
1874 is=index(currtimestring, 'T') ! remove 'T' in
1875 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
1876!
1877! DATA component stop time (seconds) for this coupling window.
1878!
1879 CALL esmf_timeget (clockinfo(idata)%CurrentTime+timestep, &
1880 & s_r8=tstopinseconds, &
1881 & timestringisofrac=stoptimestring, &
1882 & rc=rc)
1883 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1884 & line=__line__, &
1885 & file=myfile)) THEN
1886 RETURN
1887 END IF
1888 is=index(stoptimestring, 'T') ! remove 'T' in
1889 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
1890!
1891! Get coupling interval (seconds, double precision).
1892!
1893 CALL esmf_timeintervalget (timestep, &
1894 & s_r8=couplinginterval, &
1895 & rc=rc)
1896 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1897 & line=__line__, &
1898 & file=myfile)) THEN
1899 RETURN
1900 END IF
1901!
1902!-----------------------------------------------------------------------
1903! Report time information strings (YYYY-MM-DD hh:mm:ss).
1904!-----------------------------------------------------------------------
1905!
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))
1910 END IF
1911!
1912!-----------------------------------------------------------------------
1913! Run DATA component.
1914!-----------------------------------------------------------------------
1915
1916# ifdef REGRESS_STARTCLOCK
1917!
1918! If applicable, read in the next data time-snapshot. Recall that the
1919! current time was adjusted during configuration to allow the exporting
1920! of both time snapshots. We need to add here the coupling interval to
1921! have the correct values for the internal monotonic time coordinate
1922! (Tmono) in "DATA_ncread" with day units since reference date.
1923!
1924 firstpass=.false.
1925 tcurrentindays=(tcurrentinseconds+couplinginterval- &
1926 & clockinfo(idata)%Time_Reference)/86400.0_dp
1927# else
1928!
1929! If applicable, read in the next data time-snapshot.
1930!
1931 firstpass=.false.
1932 tcurrentindays=(tcurrentinseconds- &
1933 & clockinfo(idata)%Time_Reference)/86400.0_dp
1934# endif
1935 CALL data_ncread (tcurrentindays, firstpass, localpet, isupdated, &
1936 & rc)
1937 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1938 & line=__line__, &
1939 & file=myfile)) THEN
1940 RETURN
1941 END IF
1942!
1943!-----------------------------------------------------------------------
1944! Send export fields to destination ESM component.
1945!-----------------------------------------------------------------------
1946# ifdef TIME_INTERP
1947!
1948! Since the DATA component is exporting data-snaphots of the fields
1949! for time interpolation in the destination ESM component, it needs
1950! to export when reading new data (IsUpdate=.TRUE.).
1951!
1952 IF (isupdated) THEN
1953 lreport=.true.
1954 CALL data_export (model, lreport, rc)
1955 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1956 & line=__line__, &
1957 & file=myfile)) THEN
1958 RETURN
1959 END IF
1960 END IF
1961# else
1962!
1963! The Data component always export fields at every coupling timestep
1964! since "DATA_Export" time interpolates the fields from available
1965! LOWER and UPPER snapshots.
1966!
1967 IF (tcurrentinseconds.eq.clockinfo(idriver)%Time_Start) THEN
1968 lreport=.false. ! export state pointers will give
1969 ELSE ! MISSING_r8 values, avoid report
1970 lreport=.true.
1971 END IF
1972 CALL data_export (model, lreport, rc)
1973 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1974 & line=__line__, &
1975 & file=myfile)) THEN
1976 RETURN
1977 END IF
1978# endif
1979!
1980 IF (esm_track) THEN
1981 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_ModelAdvance', &
1982 & ', PET', petrank
1983 FLUSH (trac)
1984 END IF
1985!
1986 10 FORMAT (3x,'ModelAdvance - ESMF, Running DATA:',t42,a, &
1987 & ' => ',a,', Phase: ',i1,' [',a,' s]')
1988
1989 RETURN

References mod_esmf_esm::clockinfo, data_export(), data_ncread(), mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_esmf_esm::idata, mod_esmf_esm::idriver, mod_esmf_esm::petrank, mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_multifile()

subroutine, private esmf_data_mod::data_multifile ( real (dp) tcurrent,
type(t_io), dimension(nfiles), intent(inout) ifs,
integer, intent(in) nfiles,
integer, intent(in) localpet,
integer, intent(out) rc )
private

Definition at line 3331 of file esmf_data.F.

3332!
3333!=======================================================================
3334! !
3335! This routine checks DATA model input NetCDF multi-files and !
3336! sets several parameters in the file information structure so !
3337! the appropriate file is selected during initialization or restart !
3338! !
3339! Here, multi-file implies that the time records for a particular !
3340! field can be split into several NetCDF files. !
3341! !
3342! On Input: !
3343! !
3344! Tcurrent Current time in days since reference date (real) !
3345! IFS Input Files Structure, TYPE(T_IO) !
3346! Nfiles Number of files in structure (vector) !
3347! localPET Local Persistent Execution Thread (integer) !
3348! !
3349! On Output: !
3350! !
3351! IFS Updated Input Files Structure, TYPE(T_IO) !
3352! rc Return code flag (integer) !
3353! !
3354!=======================================================================
3355!
3356 USE mod_iounits, ONLY : sourcefile
3357 USE mod_scalars, ONLY : noerror, exit_flag, spval
3358!
3359 USE dateclock_mod, ONLY : time_string
3360 USE strings_mod, ONLY : founderror
3361!
3362! Imported variable declarations.
3363!
3364 integer, intent(in) :: Nfiles, localPET
3365 integer, intent(out) :: rc
3366!
3367 real (dp) :: Tcurrent
3368!
3369 TYPE(T_IO), intent(inout) :: IFS(Nfiles)
3370!
3371! Local variable declarations.
3372!
3373 logical :: Lcheck, foundit
3374!
3375 integer :: Fcount, Mfiles, i, ifile, lstr
3376!
3377 real(dp) :: TimeStrDay, TimeEndDay
3378 real(dp) :: TimeStrSec, TimeEndSec
3379 real(dp) :: Tmax, Tmin, Tscale
3380!
3381 character (len=1), parameter :: blank = ' '
3382 character (len= 22) :: F_code, I_code, Tmin_code, Tmax_code
3383 character (len=256) :: ncname
3384
3385 character (len=*), parameter :: MyFile = &
3386 & __FILE__//", DATA_multifile"
3387!
3388!-----------------------------------------------------------------------
3389! Initialize return code flag to success state (no error).
3390!-----------------------------------------------------------------------
3391!
3392 IF (esm_track) THEN
3393 WRITE (trac,'(a,a,i0)') '==> Entering DATA_multifile', &
3394 & ', PET', petrank
3395 FLUSH (trac)
3396 END IF
3397 rc=esmf_success
3398 sourcefile=myfile
3399!
3400!-----------------------------------------------------------------------
3401! Process DATA model file structure.
3402!-----------------------------------------------------------------------
3403!
3404! Get simulation starting and ending times: seconds since reference
3405! time. Then, compute days since reference time.
3406!
3407 timestrsec=tcurrent*86400.0_dp
3408 timeendsec=clockinfo(idata)%Time_Stop- &
3409 & clockinfo(idata)%Time_Reference
3410!
3411 timestrday=timestrsec/86400.0_dp
3412 timeendday=timeendsec/86400.0_dp
3413!
3414! Get simulation start and ending time string.
3415!
3416 CALL time_string (timestrsec, i_code)
3417 CALL time_string (timeendsec, f_code)
3418!
3419! Set available minimum and maximum time coordinates. The input time
3420! is scaled to DAY units.
3421!
3422 DO i=1,nfiles
3423 mfiles=ifs(i)%Nfiles ! number of multi-files within source file
3424 DO ifile=1,mfiles
3425 ncname=ifs(i)%files(ifile)
3426 foundit=data_checkfile(ncname, tmin, tmax, tscale, localpet, &
3427 & lcheck)
3428 IF (founderror(exit_flag, noerror, __line__, &
3429 & myfile)) THEN
3430 rc=esmf_rc_cannot_set
3431 RETURN
3432 END IF
3433 ifs(i)%time_min(ifile)=tmin
3434 ifs(i)%time_max(ifile)=tmax
3435 END DO
3436!
3437! Set the appropriate file counter to use during initialization or
3438! restart.
3439!
3440 fcount=0
3441 IF (lcheck) THEN
3442 DO ifile=1,mfiles
3443 tmin=tscale*ifs(i)%time_min(ifile)
3444 IF (timestrday.ge.tmin) THEN
3445 fcount=ifile
3446 END IF
3447 END DO
3448 ELSE
3449 fcount=1
3450 END IF
3451!
3452! Initialize other structure parameters or issue an error if data does
3453! not include initalization time. Notice that the time argument to
3454! routine 'time_string' is in seconds.
3455!
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)
3462 ELSE
3463 IF ((localpet.eq.0).and.lcheck) THEN
3464 WRITE (dataout,10) 'Data Model', i_code
3465 DO ifile=1,mfiles
3466 tmin=tscale*ifs(i)%time_min(ifile)
3467 tmax=tscale*ifs(i)%time_max(ifile)
3468 CALL time_string (tmin*86400.0_dp, tmin_code)
3469 CALL time_string (tmax*86400.0_dp, tmax_code)
3470 WRITE (dataout,20) tmin_code, tmax_code, &
3471 & trim(ifs(i)%files(ifile))
3472 END DO
3473 END IF
3474 exit_flag=4
3475 IF (founderror(exit_flag, noerror, __line__, &
3476 & myfile)) THEN
3477 rc=esmf_rc_cannot_set
3478 RETURN
3479 END IF
3480 END IF
3481!
3482! Check if there is forcing data up to the end of the simulation.
3483!
3484 IF (lcheck) THEN
3485 tmax=tscale*ifs(i)%time_max(mfiles)
3486 IF (timeendday.gt.tmax) THEN
3487 CALL time_string (tmax*86400.0_dp, tmax_code)
3488 IF (localpet.eq.0) THEN
3489 WRITE (dataout,30) 'Data Model', &
3490 & trim(ifs(i)%files(mfiles)), &
3491 & 'last ', tmax_code, f_code
3492 END IF
3493 exit_flag=4
3494 IF (founderror(exit_flag, noerror, __line__, &
3495 & myfile)) THEN
3496 rc=esmf_rc_cannot_set
3497 RETURN
3498 END IF
3499 END IF
3500 END IF
3501 END DO
3502!
3503 IF (esm_track) THEN
3504 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_multifile', &
3505 & ', PET', petrank
3506 FLUSH (trac)
3507 END IF
3508!
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)
3517
3518 RETURN
dateclock_mod
Definition dateclock.F:2
dateclock_mod::time_string
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
mod_scalars::spval
real(dp), parameter spval
Definition mod_scalars.F:821
mod_scalars::i_code
character(len=22) i_code
Definition mod_scalars.F:290
mod_scalars::f_code
character(len=22) f_code
Definition mod_scalars.F:290

References mod_esmf_esm::clockinfo, data_checkfile(), mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_scalars::exit_flag, mod_scalars::f_code, strings_mod::founderror(), mod_scalars::i_code, mod_esmf_esm::idata, mod_scalars::noerror, mod_esmf_esm::petrank, mod_iounits::sourcefile, mod_scalars::spval, dateclock_mod::time_string(), and mod_esmf_esm::trac.

Referenced by data_initialize().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_ncread()

subroutine, private esmf_data_mod::data_ncread ( real(dp), intent(in) tcurrent,
logical, intent(in) firstpass,
integer, intent(in) localpet,
logical, intent(out) isupdated,
integer, intent(out) rc )
private

Definition at line 2926 of file esmf_data.F.

2928!
2929!=======================================================================
2930! !
2931! This routine read DATA component field to export from NetCDF source !
2932! file at the appropriate time. The data is loaded to the snapshots !
2933! arrays for time interpolation elsewhere: !
2934! !
2935! DataSet(Icomp)%Export(ifld)%A2dG(:,:,Tindex) 2D field !
2936! DataSet(Icomp)%Export(ifld)%A3dG(:,:,:,Tindex) 3D field !
2937! !
2938! On Input: !
2939! !
2940! Tcurrent Current time in days since reference date (real) !
2941! FirstPass Switch indicating initialization or restart phase !
2942! (logical) !
2943! localPET Local Persistent Execution Thread (integer) !
2944! !
2945! On Output: !
2946! !
2947! DataSet Updated DATA component structure !
2948! IsUpdated Set to TRUE if new fields have been read (logical) !
2949! rc Return code flag (integer) !
2950! !
2951! WARNING: !
2952! !
2953! This routine uses ROMS NetCDF processing framework. !
2954! !
2955!=======================================================================
2956!
2957 USE mod_netcdf
2958!
2959 USE mod_iounits, ONLY : sourcefile
2960 USE mod_scalars, ONLY : noerror, exit_flag
2961!
2962 USE dateclock_mod, ONLY : caldate, time_string
2963 USE strings_mod, ONLY : founderror
2964!
2965! Imported variable declarations.
2966!
2967 logical, intent(in) :: FirstPass
2968 logical, intent(out) :: IsUpdated
2969!
2970 integer, intent(in) :: localPET
2971 integer, intent(out) :: rc
2972!
2973 real(dp), intent(in) :: Tcurrent
2974!
2975! Local variable declarations.
2976!
2977 logical :: Lcycle, Linquire, Lmulti, LZL, RecLast
2978!
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
2984 integer :: ROMScomm
2985 integer :: MyDateVec(5)
2986
2987 integer, parameter :: imodel = 1 ! for compatibility with ROMS
2988 integer, parameter :: ng = 1 ! used routines
2989!
2990 real(r8) :: Vmax, Vmin
2991
2992 real(dp) :: Clength, Tdelta, Tmax, Tmin, Tmono, Tscale, Tsec, Tval
2993 real(dp) :: MySeconds
2994 real(dp) :: V_time(2)
2995!
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
3001
3002 character (len=*), parameter :: MyFile = &
3003 & __FILE__//", DATA_ncread"
3004!
3005!-----------------------------------------------------------------------
3006! Initialize return code flag to success state (no error).
3007!-----------------------------------------------------------------------
3008!
3009 IF (esm_track) THEN
3010 WRITE (trac,'(a,a,i0)') '==> Entering DATA_ncread', &
3011 & ', PET', petrank
3012 FLUSH (trac)
3013 END IF
3014 rc=esmf_success
3015 sourcefile=myfile
3016!
3017!=======================================================================
3018! If appropriate, read in new data.
3019!=======================================================================
3020!
3021! Read in DATA component fields from source NetCDF files. The DATA
3022! model can be connected to any of the activated ESM components.
3023!
3024 isupdated=.false.
3025!
3026 field_loop : DO icomp=1,nmodels
3027 IF (icomp.ne.idata) THEN
3028 nfiles=dataset(icomp)%Nfiles
3029 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
3030 nfields=dataset(icomp)%Nfields
3031 DO ifld=1,nfields
3032!
3033! If appropriate, inquire about the contents of input NetCDF file and
3034! fill Information File Structure (IFS).
3035!
3036! If the switch "RecLast" is true, we need to inquire information about
3037! the next multifile for the UPPER time snapshot data. It implies that
3038! the last record in the file was processed for LOWER time snapshot,
3039! previously. Notice that sfter the inquiry, "LastRec" is deactivated.
3040!
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
3046!
3047 linquire=lmulti.and. &
3048 & (reclast.or.(.not.lcycle.and.(tmax.lt.tcurrent)))
3049!
3050
3051 IF (linquire) THEN
3052 nc_vname=models(idata)%ExportField(ifld)%nc_vname
3053 nc_tname=models(idata)%ExportField(ifld)%nc_tname
3054 CALL data_inquiry (ifld, nc_vname, nc_tname, &
3055 & tcurrent, &
3056 & dataset(icomp)%Export, nfields, &
3057 & dataset(icomp)%IFS, nfiles, &
3058 & lmulti, localpet, rc)
3059 IF (esmf_logfounderror(rctocheck=rc, &
3060 & msg=esmf_logerr_passthru, &
3061 & line=__line__, &
3062 & file=myfile)) THEN
3063 RETURN
3064 END IF
3065 IF (reclast) THEN
3066 dataset(icomp)%Export(ifld)%LastRec=.false.
3067 END IF
3068 END IF
3069!
3070!-----------------------------------------------------------------------
3071! If needed, read in the field data time-snapshot.
3072!-----------------------------------------------------------------------
3073!
3074 IF ((tmono.le.tcurrent).or.firstpass) THEN
3075!
3076! Load properties of export field to read from source NetCDF file.
3077!
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)
3096!
3097! Advance time record to process.
3098!
3099 IF (lcycle) THEN
3100 trec=mod(trec,nrec)+1
3101 ELSE
3102 trec=trec+1
3103 END IF
3104 dataset(icomp)%Export(ifld)%Trec=trec
3105 lzl=.false.
3106 tval=0.0_dp
3107!
3108! Process if time record is available in NetCDF file.
3109!
3110 IF (trec.le.nrec) THEN
3111!
3112! Set rolling index for two-time record storage of input data for the
3113! time interpolation elsewhere.
3114!
3115 tindex=3-tindex
3116 dataset(icomp)%Export(ifld)%Tindex=tindex
3117!
3118! Read in time coordinate and scale it to DAY UNITS.
3119!
3120 CALL netcdf_get_time (ng, imodel, ncname, &
3121 & trim(t_name), &
3122 & referencedatenumber, &
3123 & tval, &
3124 & ncid = ncid, &
3125 & start = (/trec/), &
3126 & total = (/1/))
3127 IF (founderror(exit_flag, noerror, __line__, &
3128 & myfile)) THEN
3129 IF (localpet.eq.0) WRITE (dataout,10) trim(t_name), &
3130 & trec, &
3131 & trim(ncname)
3132 rc=esmf_rc_file_read
3133 RETURN
3134 END IF
3135 tval=tval*tscale ! scaled to day units
3136 v_time(tindex)=tval
3137!
3138! Activate "LastRec" switch if processing the LAST record of the file
3139! for the LOWER time snapshot. We need to get the UPPER time snapshot
3140! from NEXT multifile.
3141!
3142 IF ((trec.eq.nrec).and.(tval.le.tcurrent)) THEN
3143 dataset(icomp)%Export(ifld)%LastRec=.true.
3144 END IF
3145!
3146! Read in field. Allocate snapshot array, if necessary. Notice that it
3147! is possible to read a particular depth level (ZL) from a 3D field.
3148! For example, reading sea surface temperature for a 3D temperature
3149! variable where ZL is the depth level index for the surface.
3150!
3151 nvdim=dataset(icomp)%Export(ifld)%Nvdim
3152 ndims=SIZE(dataset(icomp)%Export(ifld)%Vsize)-1
3153!
3154 IF ((nvdim.eq.2).and.(ndims.eq.2)) THEN ! 2D var
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
3159 allocate ( dataset(icomp)% &
3160 & export(ifld)%A2dG(nx,ny,2) )
3161 END IF
3162 vmin=0.0_r8
3163 vmax=0.0_r8
3164 CALL netcdf_get_fvar (ng, imodel, ncname, &
3165 & trim(v_name), &
3166 & dataset(icomp)%Export(ifld)%A2dG(:,:,tindex), &
3167 & ncid = ncid, &
3168 & start = (/1,1,trec/), &
3169 & total = (/nx,ny,1/), &
3170 & min_val = vmin, &
3171 & max_val = vmax)
3172 IF (founderror(exit_flag, noerror, __line__, &
3173 & myfile)) THEN
3174 IF (localpet.eq.0) &
3175 & WRITE (dataout,10) trim(v_name), trec, &
3176 & trim(ncname)
3177 rc=esmf_rc_file_read
3178 RETURN
3179 END IF
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 ! 2D var
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
3188 allocate ( dataset(icomp)% &
3189 & export(ifld)%A2dG(nx,ny,2) )
3190 END IF
3191 vmin=0.0_r8
3192 vmax=0.0_r8
3193 CALL netcdf_get_fvar (ng, imodel, ncname, &
3194 & trim(v_name), &
3195 & dataset(icomp)%Export(ifld)%A2dG(:,:,tindex), &
3196 & ncid = ncid, &
3197 & start = (/1,1,zl,trec/), &
3198 & total = (/nx,ny,1,1/), &
3199 & min_val = vmin, &
3200 & max_val = vmax)
3201 IF (founderror(exit_flag, noerror, __line__, &
3202 & myfile)) THEN
3203 IF (localpet.eq.0) &
3204 WRITE (dataout,10) trim(v_name), trec, &
3205 & trim(ncname)
3206 rc=esmf_rc_file_read
3207 RETURN
3208 END IF
3209 dataset(icomp)%Export(ifld)%Vmin=vmin
3210 dataset(icomp)%Export(ifld)%Vmax=vmax
3211 WRITE (zlabel,'(a,i2.2)') 'Level = ', zl
3212 lzl=.true.
3213 ELSE IF ((nvdim.eq.3).and.(ndims.eq.3)) THEN ! 3D var
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
3219 allocate ( dataset(icomp)% &
3220 & export(ifld)%A3dG(nx,ny,nz,2) )
3221 END IF
3222 vmin=0.0_r8
3223 vmax=0.0_r8
3224 CALL netcdf_get_fvar (ng, imodel, ncname, &
3225 & trim(v_name), &
3226 & dataset(icomp)%Export(ifld)%A3dG(:,:,:,tindex), &
3227 & ncid = ncid, &
3228 & start = (/1,1,1,trec/), &
3229 & total = (/nx,ny,nz,1/), &
3230 & min_val = vmin, &
3231 & max_val = vmax)
3232 IF (founderror(exit_flag, noerror, __line__, &
3233 & myfile)) THEN
3234 IF (localpet.eq.0) &
3235 & WRITE (dataout,10) trim(v_name), trec, &
3236 & trim(ncname)
3237 rc=esmf_rc_file_read
3238 RETURN
3239 END IF
3240 dataset(icomp)%Export(ifld)%Vmin=vmin
3241 dataset(icomp)%Export(ifld)%Vmax=vmax
3242 END IF
3243 CALL caldate (tval, &
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), &
3249 & s_dp = myseconds)
3250 DO i=1,5
3251 dataset(icomp)%Export(ifld)%Date(i,tindex)= &
3252 & real(mydatevec(i),dp)
3253 END DO
3254 dataset(icomp)%Export(ifld)%Date(6,tindex)=myseconds
3255 isupdated=.true.
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 ! scaled to seconds
3260 CALL time_string (tsec, tcode)
3261 dataset(icomp)%Export(ifld)%DateString(tindex)=tcode
3262 IF (localpet.eq.0) THEN
3263 IF (lzl) THEN
3264 WRITE (dataout,20) trim(v_name), tcode, &
3265 & trim(shortname), &
3266 & trim(longname), &
3267 & trim(vunits), trim(ctarget), &
3268 & trec, tindex, &
3269 & ncname(lstr:lend), &
3270 & tmin, tmax, tval, vmin, vmax, &
3271 & trim(zlabel)
3272 ELSE
3273 WRITE (dataout,30) trim(v_name), tcode, &
3274 & trim(shortname), &
3275 & trim(longname), &
3276 & trim(vunits), trim(ctarget), &
3277 & trec, tindex, &
3278 & ncname(lstr:lend), &
3279 & tmin, tmax, tval, vmin, vmax
3280 END IF
3281 END IF
3282 END IF
3283!
3284! Increment the local time variable "Tmono" by the interval between
3285! snapshots. If the interval is negative, indicating cycling, add in
3286! a cycle length. Load time value (sec) into "Tintrp" which used
3287! during interpolation between snapshots.
3288!
3289 tdelta=v_time(tindex)-v_time(3-tindex)
3290 IF (lcycle.and.(tdelta.lt.0.0_dp)) THEN
3291 tdelta=tdelta+clength
3292 END IF
3293 tmono=tmono+tdelta
3294 dataset(icomp)%Export(ifld)%Tmono=tmono
3295 dataset(icomp)%Export(ifld)%Tintrp(tindex)=tmono
3296 dataset(icomp)%Export(ifld)%Vtime(tindex)=tval
3297 END IF
3298 END DO
3299 END IF
3300 END IF
3301 END DO field_loop
3302!
3303 IF (esm_track) THEN
3304 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_ncread', &
3305 & ', PET', petrank
3306 FLUSH (trac)
3307 END IF
3308!
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,')', &
3318 & t71,a)
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,')')
3326
3327 RETURN
3328
mod_netcdf::netcdf_get_fvar
Definition mod_netcdf.F:45
dateclock_mod::caldate
subroutine, public caldate(currenttime, yy_i, yd_i, mm_i, dd_i, h_i, m_i, s_i, yd_dp, dd_dp, h_dp, m_dp, s_dp)
Definition dateclock.F:76

References dateclock_mod::caldate(), data_inquiry(), mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_scalars::noerror, mod_esmf_esm::petrank, mod_esmf_esm::referencedatenumber, mod_iounits::sourcefile, dateclock_mod::time_string(), and mod_esmf_esm::trac.

Referenced by data_initialize(), and data_modeladvance().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_ncvarcoords()

subroutine, private esmf_data_mod::data_ncvarcoords ( integer, intent(in) ifield,
character (len=*), intent(in) fieldname,
integer, intent(in) nfields,
type(esm_data), dimension(nfields), intent(inout) export,
integer, intent(in) localpet,
integer, intent(out) rc )
private

Definition at line 4569 of file esmf_data.F.

4572!
4573!=======================================================================
4574! !
4575! This routine reads the spatial locations of DATA model export !
4576! variable from associated input NetCDF file. If available, it !
4577! also reads the land/se mask. !
4578! !
4579! It assumes that the NetCDF variable has the attribute "coordinates",!
4580! as specified by CF compatability standard. !
4581! !
4582! For example, in CDL syntax: !
4583! !
4584! float my_var(time, lat, lon) ; !
4585! my_var:long_name = "my variable long name" ; !
4586! my_var:units = "my variable units" ; !
4587! my_var:coordinates = "lon lat time" ; !
4588! my_var:time = "time" ; !
4589! !
4590! The following "coordinates" attribute is also allowed: !
4591! !
4592! my_var:coordinates = "lon lat" ; !
4593! !
4594! That is, the time variable "time" is missing in the "coordinates" !
4595! attribute. !
4596! !
4597! Notice that the associated coordinate names "lon" and "lat" are !
4598! separated by a single blank space. Both "lon" and "lat" can be !
4599! 1D or 2D arrays. If 1D array, the positions are rectangular and !
4600! and full 2D arrays are filled with the same values. !
4601! !
4602! On Input: !
4603! !
4604! ifield Field index in Export structure to process (integer) !
4605! FieldName DATA model field short name to process (string) !
4606! Export DATA model export structure, TYPE(ESM_Data) !
4607! Nfields Number of fields in Export structure (interger) !
4608! localPET Local Persistent Execution Thread (integer) !
4609! !
4610! On Output: !
4611! !
4612! Export DATA model export structure: !
4613! Export(ifield)%lon longitude 2D locations !
4614! Export(ifield)%lat latitude 2D locations !
4615! Export(ifield)%mask land/sea mask !
4616! Export(ifield)%LonMin minimum longitude !
4617! Export(ifield)%LonMax maximum longitude !
4618! Export(ifield)%LatMin minimum latitude !
4619! Export(ifield)%LatMax maximum latitude !
4620! rc Return code flag (integer) !
4621! !
4622! WARNING: !
4623! !
4624! This routine uses ROMS NetCDF managing framework. !
4625! !
4626!=======================================================================
4627!
4628 USE mod_netcdf
4629!
4630 USE mod_iounits, ONLY : sourcefile
4631 USE mod_scalars, ONLY : noerror, exit_flag, spval
4632!
4633 USE strings_mod, ONLY : founderror, lowercase
4634!
4635! Imported variable declarations.
4636!
4637 integer, intent(in) :: ifield, Nfields
4638 integer, intent(in) :: localPET
4639 integer, intent(out) :: rc
4640!
4641 TYPE(ESM_Data), intent(inout) :: Export(Nfields)
4642!
4643 character (len=*), intent(in) :: FieldName
4644!
4645! Local variable declarations
4646!
4647 logical :: Lcoord, got_lon, got_lat, got_mask
4648!
4649 integer :: ng, model
4650 integer :: Imax, Jmax, i, j
4651 integer :: Nvdim, ncid, ncvid, nlatatt, nlatdim, nlonatt, nlondim
4652 integer :: nmaskdim, nmaskatt
4653 integer :: ROMScomm
4654!
4655 real(r8) :: Lon_Min, Lon_Max, Lat_Min, Lat_Max
4656!
4657 real(r8), allocatable :: LonWrk(:)
4658 real(r8), allocatable :: LatWrk(:)
4659!
4660 character (len=5 ) :: lstr
4661 character (len=20 ) :: Dname(2), LonName, LatName, MaskName
4662 character (len=100) :: ncvname
4663 character (len=256) :: ncname
4664
4665 character (len=*), parameter :: MyFile = &
4666 & __FILE__//", DATA_ncvarcoords"
4667!
4668!-----------------------------------------------------------------------
4669! Initialize return code flag to success state (no error).
4670!-----------------------------------------------------------------------
4671!
4672 IF (esm_track) THEN
4673 WRITE (trac,'(a,a,i0)') '==> Entering DATA_ncvarcoords', &
4674 & ', PET', petrank
4675 FLUSH (trac)
4676 END IF
4677 rc=esmf_success
4678 sourcefile=myfile
4679!
4680!-----------------------------------------------------------------------
4681! Read in variable spatial coordinates.
4682!-----------------------------------------------------------------------
4683!
4684! Initialize.
4685!
4686 ng=1 ! Needed for ROMS interface
4687 model=1 ! Needed for ROMS interface
4688 got_lon=.false.
4689 got_lat=.false.
4690 got_mask=.false.
4691!
4692 IF (localpet.eq.0) THEN
4693 WRITE (dataout,10) trim(export(ifield)%Vname), &
4694 & trim(export(ifield)%ncfile)
4695 END IF
4696!
4697! Load information variables that were set when calling "DATA_inquiry".
4698!
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
4705
4706 IF (lcoord.and.(nvdim.ge.2)) THEN
4707 got_lon=.true.
4708 got_lat=.true.
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)
4713 END IF
4714!
4715! If applicable, open input NetCDF for reading.
4716!
4717 IF (export(ifield)%ncid.eq.-1) THEN
4718 CALL netcdf_open (ng, model, ncname, 0, ncid)
4719 IF (founderror(exit_flag, noerror, __line__, &
4720 & myfile)) THEN
4721 WRITE (dataout,20) trim(ncname)
4722 RETURN
4723 END IF
4724 export(ifield)%ncid=ncid
4725 ELSE
4726 ncid=export(ifield)%ncid ! already open
4727 END IF
4728!
4729! Inquire NetCDF file variables.
4730!
4731 CALL netcdf_inq_var (ng, model, ncname, &
4732 & ncid = ncid)
4733 IF (founderror(exit_flag, noerror, __line__, &
4734 & myfile)) THEN
4735 rc=esmf_rc_file_read
4736 RETURN
4737 END IF
4738!
4739! Check NetCDF variable and look for longitude and latitude variables
4740! guess names.
4741!
4742 IF (.not.lcoord) THEN
4743 DO i=1,n_var
4744 SELECT CASE (trim(lowercase(var_name(i))))
4745 CASE ('longitude', 'lon', 'lon_rho', 'lon_u', 'lon_v')
4746 IF (.not.got_lon) THEN
4747 CALL netcdf_inq_var (ng, model, ncname, &
4748 & ncid = ncid, &
4749 & myvarname = trim(var_name(i)), &
4750 & nvardim = nlondim, &
4751 & nvaratt = nlonatt)
4752 IF (founderror(exit_flag, noerror, __line__, &
4753 & myfile)) THEN
4754 rc=esmf_rc_file_read
4755 RETURN
4756 END IF
4757 IF ((trim(var_dname(1)).eq.dname(1)).and. &
4758 & (trim(var_dname(2)).eq.dname(2))) THEN
4759 lonname=trim(var_name(i))
4760 got_lon=.true.
4761 END IF
4762 END IF
4763 CASE ('latitude', 'lat', 'lat_rho', 'lat_u', 'lat_v')
4764 IF (.not.got_lat) THEN
4765 CALL netcdf_inq_var (ng, model, ncname, &
4766 & ncid = ncid, &
4767 & myvarname = trim(var_name(i)), &
4768 & nvardim = nlatdim, &
4769 & nvaratt = nlatatt)
4770 IF (founderror(exit_flag, noerror, __line__, &
4771 & myfile)) THEN
4772 rc=esmf_rc_file_read
4773 RETURN
4774 END IF
4775 IF ((trim(var_dname(1)).eq.dname(1)).and. &
4776 & (trim(var_dname(2)).eq.dname(2))) THEN
4777 latname=trim(var_name(i))
4778 got_lat=.true.
4779 END IF
4780 END IF
4781 END SELECT
4782 END DO
4783!
4784 IF (.not.(got_lon.or.got_lat)) THEN
4785 rc=esmf_rc_cannot_get
4786 exit_flag=2
4787 WRITE (lstr,'(i5)') __line__
4788 IF (localpet.eq.0) THEN
4789 WRITE (dataout,10) trim(ncvname), trim(ncname), &
4790 & exit_flag, adjustl(trim(lstr)), &
4791 & myfile
4792 END IF
4793 RETURN
4794 END IF
4795 END IF
4796!
4797! Check for land/sea mask using various guess names.
4798!
4799 DO i=1,n_var
4800 SELECT CASE (trim(lowercase(var_name(i))))
4801 CASE ('mask', 'mask_rho', 'mask_u', 'mask_v')
4802 IF (.not.got_mask) THEN
4803 CALL netcdf_inq_var (ng, model, ncname, &
4804 & ncid = ncid, &
4805 & myvarname = trim(var_name(i)), &
4806 & nvardim = nmaskdim, &
4807 & nvaratt = nmaskatt)
4808 IF (founderror(exit_flag, noerror, __line__, &
4809 & myfile)) THEN
4810 rc=esmf_rc_file_read
4811 RETURN
4812 END IF
4813 IF ((trim(var_dname(1)).eq.dname(1)).and. &
4814 & (trim(var_dname(2)).eq.dname(2))) THEN
4815 maskname=trim(var_name(i))
4816 got_mask=.true.
4817 END IF
4818 END IF
4819 END SELECT
4820 END DO
4821!
4822! Read in longitude coordinate.
4823!
4824 IF (.not.allocated(export(ifield)%lon)) THEN
4825 allocate ( export(ifield)%lon(imax,jmax) )
4826 END IF
4827!
4828 CALL netcdf_inq_var (ng, model, ncname, &
4829 & ncid = ncid, &
4830 & myvarname = trim(lonname), &
4831 & varid = ncvid, &
4832 & nvardim = nlondim, &
4833 & nvaratt = nlonatt)
4834 IF (founderror(exit_flag, noerror, __line__, &
4835 & myfile)) THEN
4836 rc=esmf_rc_file_read
4837 RETURN
4838 END IF
4839!
4840 IF (nlondim.eq.1) THEN
4841 IF (.not.allocated(lonwrk)) THEN
4842 allocate ( lonwrk(imax) )
4843 END IF
4844 CALL netcdf_get_fvar (ng, model, ncname, lonname, &
4845 & lonwrk, &
4846 & ncid = ncid, &
4847 & start = (/1/), &
4848 & total = (/imax/))
4849 IF (founderror(exit_flag, noerror, __line__, &
4850 & myfile)) RETURN
4851
4852 DO j=1,jmax
4853 DO i=1,imax
4854 export(ifield)%lon(i,j)=lonwrk(i)
4855 END DO
4856 END DO
4857 deallocate (lonwrk)
4858 ELSE
4859 CALL netcdf_get_fvar (ng, model, ncname, lonname, &
4860 & export(ifield)%lon, &
4861 & ncid = ncid, &
4862 & start = (/1,1/), &
4863 & total = (/imax,jmax/))
4864 IF (founderror(exit_flag, noerror, __line__, &
4865 & myfile)) RETURN
4866 END IF
4867!
4868! Read in latitute coordinate.
4869!
4870 IF (.not.allocated(export(ifield)%lat)) THEN
4871 allocate ( export(ifield)%lat(imax,jmax) )
4872 END IF
4873!
4874 CALL netcdf_inq_var (ng, model, ncname, &
4875 & ncid = ncid, &
4876 & myvarname = trim(latname), &
4877 & varid = ncvid, &
4878 & nvardim = nlatdim, &
4879 & nvaratt = nlatatt)
4880 IF (founderror(exit_flag, noerror, __line__, &
4881 & myfile)) THEN
4882 rc=esmf_rc_file_read
4883 RETURN
4884 END IF
4885!
4886 IF (nlatdim.eq.1) THEN
4887 IF (.not.allocated(latwrk)) THEN
4888 allocate ( latwrk(jmax) )
4889 END IF
4890 CALL netcdf_get_fvar (ng, model, ncname, latname, &
4891 & latwrk, &
4892 & ncid = ncid, &
4893 & start = (/1/), &
4894 & total = (/jmax/))
4895 IF (founderror(exit_flag, noerror, __line__, &
4896 & myfile)) RETURN
4897
4898 DO j=1,jmax
4899 DO i=1,imax
4900 export(ifield)%lat(i,j)=latwrk(j)
4901 END DO
4902 END DO
4903 deallocate (latwrk)
4904 ELSE
4905 CALL netcdf_get_fvar (ng, model, ncname, latname, &
4906 & export(ifield)%lat, &
4907 & ncid = ncid, &
4908 & start = (/1,1/), &
4909 & total = (/imax,jmax/))
4910 IF (founderror(exit_flag, noerror, __line__, &
4911 & myfile)) RETURN
4912 END IF
4913!
4914! Determine data minimum and maximum longitude/latitude.
4915!
4916 lon_min= spval
4917 lon_max=-spval
4918 lat_min= spval
4919 lat_max=-spval
4920 DO j=1,jmax
4921 DO i=1,imax
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))
4926 END DO
4927 END DO
4928 export(ifield)%LonMin=lon_min
4929 export(ifield)%LonMax=lon_max
4930 export(ifield)%LatMin=lat_min
4931 export(ifield)%LatMax=lat_max
4932!
4933! Read or set land/sea mask.
4934!
4935 IF (.not.allocated(export(ifield)%mask)) THEN
4936 allocate ( export(ifield)%mask(imax,jmax) )
4937 END IF
4938 export(ifield)%Lmask=got_mask
4939!
4940 IF (got_mask) THEN
4941 CALL netcdf_get_fvar (ng, model, ncname, maskname, &
4942 & export(ifield)%mask, &
4943 & ncid = ncid, &
4944 & start = (/1,1/), &
4945 & total = (/imax,jmax/))
4946 IF (founderror(exit_flag, noerror, __line__, &
4947 & myfile)) RETURN
4948 ELSE
4949 DO j=1,jmax
4950 DO i=1,imax
4951 export(ifield)%mask(i,j)=1.0_r8
4952 END DO
4953 END DO
4954 END IF
4955!
4956 IF (esm_track) THEN
4957 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_ncvarcoords', &
4958 & ', PET', petrank
4959 FLUSH (trac)
4960 END IF
4961!
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)
4975
4976 RETURN

References mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), strings_mod::lowercase(), mod_netcdf::n_var, mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_esmf_esm::petrank, mod_iounits::sourcefile, mod_scalars::spval, mod_esmf_esm::trac, mod_netcdf::var_dname, and mod_netcdf::var_name.

Referenced by data_initialize().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setclock()

subroutine, private esmf_data_mod::data_setclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1008 of file esmf_data.F.

1009!
1010!=======================================================================
1011! !
1012! Sets DATA component date calendar, start and stop time, and !
1013! coupling interval. At initilization, the variable "tdays" is !
1014! the initial time meassured in fractional days since the reference !
1015! time. !
1016! !
1017!=======================================================================
1018!
1019 USE dateclock_mod, ONLY : caldate, time_string
1020 USE strings_mod, ONLY : lowercase
1021!
1022! Imported variable declarations.
1023!
1024 integer, intent(out):: rc
1025!
1026 TYPE (ESMF_GridComp) :: model
1027!
1028! Local variable declarations.
1029!
1030 integer :: Icomp, Nfields, Nfiles, ifld, ig
1031 integer :: localPET, PETcount
1032 integer :: TimeFrac
1033 integer :: MyStartTime(6), MyStopTime(6)
1034!
1035 real(dp) :: Tmin, Tmax, Tstr, Tend
1036 real(dp) :: Time_Stop
1037!
1038 character (len=22) :: Calendar
1039
1040 character (len=*), parameter :: MyFile = &
1041 & __FILE__//", DATA_SetClock"
1042!
1043 TYPE (ESMF_CalKind_Flag) :: CalType
1044 TYPE (ESMF_Clock) :: clock
1045 TYPE (ESMF_VM) :: vm
1046!
1047!-----------------------------------------------------------------------
1048! Initialize return code flag to success state (no error).
1049!-----------------------------------------------------------------------
1050!
1051 IF (esm_track) THEN
1052 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetClock', &
1053 & ', PET', petrank
1054 FLUSH (trac)
1055 END IF
1056 rc=esmf_success
1057!
1058!-----------------------------------------------------------------------
1059! Querry the Virtual Machine (VM) parallel environmemt for the
1060! mpi communicator handle and current node rank.
1061!-----------------------------------------------------------------------
1062!
1063 CALL esmf_gridcompget (model, &
1064 & localpet=localpet, &
1065 & petcount=petcount, &
1066 & vm=vm, &
1067 & rc=rc)
1068 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1069 & line=__line__, &
1070 & file=myfile)) THEN
1071 RETURN
1072 END IF
1073!
1074!-----------------------------------------------------------------------
1075! Create DATA component clock.
1076!-----------------------------------------------------------------------
1077!
1078! Create model calendar.
1079!
1080 SELECT CASE (trim(lowercase(clockinfo(idata)%CalendarString)))
1081 CASE ('gregorian')
1082 caltype=esmf_calkind_gregorian
1083 calendar=clockinfo(idata)%CalendarString
1084 CASE ('year_360_day', '360_day')
1085 caltype=esmf_calkind_360day
1086 calendar=clockinfo(idata)%CalendarString
1087 END SELECT
1088!
1089 clockinfo(idata)%Calendar=esmf_calendarcreate(caltype, &
1090 & name=trim(calendar),&
1091 & rc=rc)
1092!
1093! Inquire DATA component high-level structure for the minimum and
1094! maximum value of available times. It assumes that the reference
1095! is the same as Time_Reference set during configuration.
1096!
1097 tmin= missing_dp
1098 tmax=-missing_dp
1099 tstr= missing_dp
1100 tend=-missing_dp
1101 DO icomp=1,nmodels
1102 IF (icomp.ne.idata) THEN
1103 nfiles=dataset(icomp)%Nfiles
1104 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
1105 nfields=dataset(icomp)%Nfields
1106 DO ifld=1,nfields
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)
1111 END DO
1112 END IF
1113 END IF
1114 END DO
1115!
1116! Set DATA component starting time. Notice that is value can be less
1117! than driver Time_Start since at initialization it represent the LOWER
1118! time-snapshot used for time interpolation. ROMS routine "caldate"
1119! adds the reference time internally.
1120!
1121 IF ((tstr+clockinfo(idata)%Time_Reference/86400.0_dp).le. &
1122 & (clockinfo(idriver)%Time_Start/86400.0_dp)) THEN
1123 clockinfo(idata)%Time_Start=tstr*86400.0_dp
1124 CALL caldate (tstr, &
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))
1131 CALL time_string (clockinfo(idata)%Time_Start, &
1132 & clockinfo(idata)%Time_StartString)
1133!
1134 CALL esmf_timeset (clockinfo(idata)%StartTime, &
1135 & yy=mystarttime(1), &
1136 & mm=mystarttime(2), &
1137 & dd=mystarttime(3), &
1138 & h =mystarttime(4), &
1139 & m =mystarttime(5), &
1140 & s =mystarttime(6), &
1141 & calendar=clockinfo(idata)%Calendar, &
1142 & rc=rc)
1143 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1144 & line=__line__, &
1145 & file=myfile)) THEN
1146 RETURN
1147 END IF
1148 END IF
1149!
1150! Set DATA component stopping time. Use coupling simulation stopping
1151! time. ROMS routine "caldate" adds the reference time internally.
1152!
1153 clockinfo(idata)%Time_Stop=clockinfo(idriver)%Time_Stop
1154 time_stop=(clockinfo(idata)%Time_Stop- &
1155 & clockinfo(idata)%Time_Reference)/86400.0_dp
1156 CALL caldate (time_stop, &
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))
1163 CALL time_string (clockinfo(idata)%Time_Stop- &
1164 & clockinfo(idata)%Time_Reference, &
1165 & clockinfo(idata)%Time_StopString)
1166!
1167 CALL esmf_timeset (clockinfo(idata)%StopTime, &
1168 & yy=mystoptime(1), &
1169 & mm=mystoptime(2), &
1170 & dd=mystoptime(3), &
1171 & h =mystoptime(4), &
1172 & m =mystoptime(5), &
1173 & s =mystoptime(6), &
1174 & calendar=clockinfo(idata)%Calendar, &
1175 & rc=rc)
1176 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1177 & line=__line__, &
1178 & file=myfile)) THEN
1179 RETURN
1180 END IF
1181!
1182!-----------------------------------------------------------------------
1183! Modify component clock time step.
1184!-----------------------------------------------------------------------
1185!
1186 timefrac=0
1187 timefrac=max(timefrac, &
1188 & maxval(models(idata)%TimeFrac(1,:), &
1189 & mask=models(:)%IsActive))
1190 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
1191 rc=esmf_rc_not_set ! cannot be 0
1192 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1193 & line=__line__, &
1194 & file=myfile)) THEN
1195 RETURN
1196 END IF
1197 END IF
1198 clockinfo(idata)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
1199!
1200!-----------------------------------------------------------------------
1201! Create ROMS component clock.
1202!-----------------------------------------------------------------------
1203!
1204 clockinfo(idata)%Name='DATA_clock'
1205 clock=esmf_clockcreate(clockinfo(idata)%TimeStep, &
1206 & clockinfo(idata)%StartTime, &
1207 & stoptime =clockinfo(idata)%StopTime, &
1208 & reftime =clockinfo(idata)%ReferenceTime, &
1209 & name =trim(clockinfo(idata)%Name), &
1210 & rc=rc)
1211 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1212 & line=__line__, &
1213 & file=myfile)) THEN
1214 RETURN
1215 END IF
1216 clockinfo(idata)%Clock=clock
1217!
1218! Get current time.
1219!
1220 CALL esmf_clockget (clockinfo(idata)%Clock, &
1221 & currtime=clockinfo(idata)%CurrentTime, &
1222 & rc=rc)
1223 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1224 & line=__line__, &
1225 & file=myfile)) THEN
1226 RETURN
1227 END IF
1228!
1229 IF (esm_track) THEN
1230 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetClock', &
1231 & ', PET', petrank
1232 FLUSH (trac)
1233 END IF
1234!
1235 RETURN

References dateclock_mod::caldate(), mod_esmf_esm::clockinfo, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_esmf_esm::idata, mod_esmf_esm::idriver, strings_mod::lowercase(), mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_esmf_esm::petrank, dateclock_mod::time_string(), and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setfinalize()

subroutine, private esmf_data_mod::data_setfinalize ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 1992 of file esmf_data.F.

1995!
1996!=======================================================================
1997! !
1998! Finalize DATA component execution. It calls DATA_finalize. !
1999! !
2000!=======================================================================
2001!
2002 USE mod_scalars, ONLY : noerror, exit_flag
2003!
2004 USE mod_netcdf, ONLY : netcdf_close
2005 USE strings_mod, ONLY : founderror
2006!
2007! Imported variable declarations.
2008!
2009 integer, intent(out) :: rc
2010!
2011 TYPE (ESMF_Clock) :: clock
2012 TYPE (ESMF_GridComp) :: model
2013 TYPE (ESMF_State) :: ExportState
2014 TYPE (ESMF_State) :: ImportState
2015!
2016! Local variable declarations.
2017!
2018 integer :: Icomp, Nfiles, ifile, ncid
2019 integer :: ROMScomm
2020!
2021 integer, parameter :: imodel = 1 ! for compatibility with ROMS
2022 integer, parameter :: ng = 1 ! used routines
2023!
2024 character (len=*), parameter :: MyFile = &
2025 & __FILE__//", DATA_SetFinalize"
2026!
2027!-----------------------------------------------------------------------
2028! Initialize return code flag to success state (no error).
2029!-----------------------------------------------------------------------
2030!
2031 IF (esm_track) THEN
2032 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetFinalize', &
2033 & ', PET', petrank
2034 FLUSH (trac)
2035 END IF
2036 rc=esmf_success
2037!
2038!-----------------------------------------------------------------------
2039! Finalize DATA component. Close all input NetCDF files.
2040!-----------------------------------------------------------------------
2041!
2042 DO icomp=1,nmodels
2043 IF (icomp.ne.idata) THEN
2044 nfiles=dataset(icomp)%Nfiles
2045 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
2046 DO ifile=1,nfiles
2047 ncid=dataset(icomp)%IFS(ifile)%ncid
2048 IF (ncid.ne.-1) THEN
2049 CALL netcdf_close (ng, imodel, ncid)
2050 IF (founderror(exit_flag, noerror, __line__, &
2051 & myfile)) THEN
2052 rc=esmf_rc_file_close
2053 RETURN
2054 END IF
2055 END IF
2056 END DO
2057 END IF
2058 END IF
2059 END DO
2060!
2061 IF (esm_track) THEN
2062 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetFinalize', &
2063 & ', PET', petrank
2064 FLUSH (trac)
2065 END IF
2066!
2067 RETURN

References mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::models, mod_netcdf::netcdf_close(), mod_esmf_esm::nmodels, mod_scalars::noerror, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setgridarrays()

subroutine, private esmf_data_mod::data_setgridarrays ( type (esmf_gridcomp), intent(inout) model,
integer, intent(in) exportcount,
integer, intent(out) rc )
private

Definition at line 1238 of file esmf_data.F.

1239!
1240!=======================================================================
1241! !
1242! Sets DATA component horizontal grids arrays for each export fields !
1243! and land/sea mask, if any. !
1244! !
1245!=======================================================================
1246!
1247 implicit none
1248!
1249! Imported variable declarations.
1250!
1251 integer, intent(in) :: ExportCount
1252 integer, intent(out) :: rc
1253!
1254 TYPE (ESMF_GridComp), intent(inout) :: model
1255!
1256! Local variable declarations.
1257!
1258 integer :: Icomp, Nfields, Nfiles, ifld
1259 integer :: Im, Istr, Iend, Jm, Jstr, Jend, i, j
1260 integer :: localDE, localDEcount
1261!
1262 integer (i4b), pointer :: ptrM(:,:) => null() ! land/sea mask
1263!
1264 real (dp), pointer :: ptrX(:,:) => null() ! longitude
1265 real (dp), pointer :: ptrY(:,:) => null() ! latitude
1266!
1267 character (len=40) :: GridName
1268
1269 character (len=*), parameter :: MyFile = &
1270 & __FILE__//", DATA_SetGridArrays"
1271!
1272 TYPE (ESMF_Decomp_Flag) :: decompflag(3)
1273 TYPE (ESMF_DistGrid) :: distGrid
1274 TYPE (ESMF_Grid) :: grid
1275!
1276!-----------------------------------------------------------------------
1277! Initialize return code flag to success state (no error).
1278!-----------------------------------------------------------------------
1279!
1280 IF (esm_track) THEN
1281 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetGridArrays', &
1282 & ', PET', petrank
1283 FLUSH (trac)
1284 END IF
1285 rc=esmf_success
1286!
1287!-----------------------------------------------------------------------
1288! Create ESMF DistGrid object for each DATA component export field.
1289! Recall that source data may come from different grids.
1290!-----------------------------------------------------------------------
1291!
1292! Set decomposition flag: divide the elements of DEs and assign the
1293! rest of the division to the last DE.
1294!
1295 decompflag=(/ esmf_decomp_restlast, &
1296 & esmf_decomp_restlast, &
1297 esmf_decomp_restlast /)
1298!
1299! Create grid object for each export field. Currently, all grids have
1300! two spatial dimensions (lon,lat).
1301!
1302 field_loop : DO icomp=1,nmodels
1303 IF (icomp.ne.idata) THEN
1304 nfiles=dataset(icomp)%Nfiles
1305 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
1306 nfields=dataset(icomp)%Nfields
1307!
1308! Create grid decomposition object.
1309!
1310 DO ifld=1,nfields
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/), &
1315 & regdecomp=(/itiled,jtiled/), &
1316 & decompflag=decompflag(1:2), &
1317 & rc=rc)
1318 IF (esmf_logfounderror(rctocheck=rc, &
1319 & msg=esmf_logerr_passthru, &
1320 & line=__line__, &
1321 & file=myfile)) THEN
1322 RETURN
1323 END IF
1324!
1325! Create export field associated grid object. The array indices are
1326! global.
1327!
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), &
1333 & rc=rc)
1334 IF (esmf_logfounderror(rctocheck=rc, &
1335 & msg=esmf_logerr_passthru, &
1336 & line=__line__, &
1337 & file=myfile)) THEN
1338 RETURN
1339 END IF
1340!
1341! Get number of local decomposition elements (DEs). Usually, a single
1342! DE is associated with each Persistent Execution Thread (PETs). Thus,
1343! localDEcount=1.
1344!
1345 CALL esmf_gridget (grid, &
1346 & localdecount=localdecount, &
1347 & rc=rc)
1348 IF (esmf_logfounderror(rctocheck=rc, &
1349 & msg=esmf_logerr_passthru, &
1350 & line=__line__, &
1351 & file=myfile)) THEN
1352 RETURN
1353 END IF
1354!
1355! Allocate coordinate storage associated with staggered grid type.
1356! No coordinate values are set yet.
1357!
1358 CALL esmf_gridaddcoord (grid, &
1359 & staggeredgelwidth=(/0,0/), &
1360 & staggeredgeuwidth=(/0,0/), &
1361 & rc=rc)
1362 IF (esmf_logfounderror(rctocheck=rc, &
1363 & msg=esmf_logerr_passthru, &
1364 & line=__line__, &
1365 & file=myfile)) THEN
1366 RETURN
1367 END IF
1368!
1369! Allocate storage for land/sea masking.
1370!
1371 CALL esmf_gridadditem (grid, &
1372 & itemflag=esmf_griditem_mask, &
1373 & rc=rc)
1374 IF (esmf_logfounderror(rctocheck=rc, &
1375 & msg=esmf_logerr_passthru, &
1376 & line=__line__, &
1377 & file=myfile)) THEN
1378 RETURN
1379 END IF
1380 dataset(icomp)%export(ifld)%LandValue=0
1381 dataset(icomp)%export(ifld)%SeaValue=1
1382!
1383! Get pointers and set coordinates for the grid. Usually, the DO-loop
1384! is executed once since localDEcount=1.
1385!
1386 de_loop : DO localde=0,localdecount-1
1387 CALL esmf_gridgetcoord (grid, &
1388 & localde=localde, &
1389 & coorddim=1, &
1390 & farrayptr=ptrx, &
1391 & rc=rc)
1392 IF (esmf_logfounderror(rctocheck=rc, &
1393 & msg=esmf_logerr_passthru, &
1394 & line=__line__, &
1395 & file=myfile)) THEN
1396 RETURN
1397 END IF
1398!
1399 CALL esmf_gridgetcoord (grid, &
1400 & localde=localde, &
1401 & coorddim=2, &
1402 & farrayptr=ptry, &
1403 & rc=rc)
1404 IF (esmf_logfounderror(rctocheck=rc, &
1405 & msg=esmf_logerr_passthru, &
1406 & line=__line__, &
1407 & file=myfile)) THEN
1408 RETURN
1409 END IF
1410!
1411 CALL esmf_gridgetitem (grid, &
1412 & localde=localde, &
1413 & itemflag=esmf_griditem_mask, &
1414 & farrayptr=ptrm, &
1415 & rc=rc)
1416 IF (esmf_logfounderror(rctocheck=rc, &
1417 & msg=esmf_logerr_passthru, &
1418 & line=__line__, &
1419 & file=myfile)) THEN
1420 RETURN
1421 END IF
1422!
1423! Fill grid pointers. In the DATA model the longitude, latitude, and
1424! mask are all of the same size with identical parallel decomposition.
1425!
1426 istr=lbound(ptrx,1)
1427 iend=ubound(ptrx,1)
1428 jstr=lbound(ptrx,2)
1429 jend=ubound(ptrx,2)
1430 DO j=jstr,jend
1431 DO i=istr,iend
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))
1435 END DO
1436 END DO
1437!
1438! Save grid object in data strcuture.
1439!
1440 dataset(icomp)%export(ifld)%grid=grid
1441!
1442! Nullify pointers.
1443!
1444 IF ( associated(ptrx) ) nullify (ptrx)
1445 IF ( associated(ptry) ) nullify (ptry)
1446 IF ( associated(ptrm) ) nullify (ptrm)
1447 END DO de_loop
1448!!
1449!! Assign grid to gridded component.
1450!! (HGA: how this is done for this particular case)
1451!!
1452!! CALL ESMF_GridCompSet (model, &
1453!! & grid=grid, &
1454!! & rc=rc)
1455!! IF (ESMF_LogFoundError(rcToCheck=rc, &
1456!! & msg=ESMF_LOGERR_PASSTHRU, &
1457!! & line=__LINE__, &
1458!! & file=MyFile)) THEN
1459!! RETURN
1460!! END IF
1461 END DO
1462 END IF
1463 END IF
1464 END DO field_loop
1465!
1466 IF (esm_track) THEN
1467 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetGridArrays', &
1468 & ', PET', petrank
1469 FLUSH (trac)
1470 END IF
1471!
1472 RETURN

References mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_esmf_esm::idata, mod_esmf_esm::itiled, mod_esmf_esm::jtiled, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setinitializep2().

Here is the caller graph for this function:

◆ data_setinitializep1()

subroutine, private esmf_data_mod::data_setinitializep1 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 274 of file esmf_data.F.

277!
278!=======================================================================
279! !
280! DATA component Phase 1 initialization: sets export fields long and !
281! short names into its respective state. Currently, the DATA model !
282! does not need to import fields. !
283! !
284!=======================================================================
285!
286! Imported variable declarations.
287!
288 integer, intent(out) :: rc
289
290 TYPE (ESMF_GridComp) :: model
291 TYPE (ESMF_State) :: ImportState
292 TYPE (ESMF_State) :: ExportState
293 TYPE (ESMF_Clock) :: clock
294!
295! Local variable declarations.
296!
297 integer :: id, ifld, localPET, nd, ng
298 integer :: Icomp, Nfields, Nfiles
299!
300 character (len=100) :: CoupledSet, StateLabel
301 character (len=240) :: StandardName, ShortName
302
303 character (len=*), parameter :: MyFile = &
304 & __FILE__//", DATA_SetInitializeP1"
305!
306!-----------------------------------------------------------------------
307! Initialize return code flag to success state (no error).
308!-----------------------------------------------------------------------
309!
310 IF (esm_track) THEN
311 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetInitializeP1', &
312 & ', PET', petrank
313 FLUSH (trac)
314 END IF
315 rc=esmf_success
316!
317!-----------------------------------------------------------------------
318! Querry about current node rank.
319!-----------------------------------------------------------------------
320!
321 CALL esmf_gridcompget (model, &
322 & localpet=localpet, &
323 & rc=rc)
324 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
325 & line=__line__, &
326 & file=myfile)) THEN
327 RETURN
328 END IF
329!
330!-----------------------------------------------------------------------
331! Set DATA export state and fields.
332!-----------------------------------------------------------------------
333!
334! Add DATA export state for connected components.
335!
336 DO icomp=1,nmodels
337 IF (icomp.ne.idata) THEN
338 nfiles=dataset(icomp)%Nfiles
339 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
340 nfields=dataset(icomp)%Nfields
341 DO ng=1,models(icomp)%Ngrids
342 IF (coupled(icomp)%LinkedGrid(ng,idata)) THEN
343 nd=coupled(idata)%DataCoupledSets(ng,icomp)
344 coupledset=trim(coupled(icomp)%SetLabel(ng))
345 statelabel=trim(coupled(idata)%ExpLabel(nd))
346 CALL nuopc_addnestedstate (exportstate, &
347 & cplset=trim(coupledset), &
348 & nestedstatename=trim(statelabel), &
349 & nestedstate=coupled(idata)% &
350 & exportstate(nd,icomp), &
351 & rc=rc)
352 IF (esmf_logfounderror(rctocheck=rc, &
353 & msg=esmf_logerr_passthru, &
354 & line=__line__, &
355 & file=__file__)) THEN
356 RETURN
357 END IF
358!
359! Add fields to export state.
360!
361 DO ifld=1,nfields
362 shortname=dataset(icomp)%Field(ifld)
363 id=field_index(models(idata)%ExportField, &
364 & trim(shortname))
365 IF (id.gt.0) THEN
366 standardname=models(idata)%ExportField(id)% &
367 & standard_name
368 CALL nuopc_advertise (coupled(idata)% &
369 & exportstate(nd,icomp), &
370 & standardname=trim(standardname), &
371 & name=trim(shortname), &
372 & rc=rc)
373 IF (esmf_logfounderror(rctocheck=rc, &
374 & msg=esmf_logerr_passthru, &
375 & line=__line__, &
376 & file=myfile)) THEN
377 RETURN
378 END IF
379 ELSE
380 IF (localpet.eq.0) THEN
381 WRITE (dataout,10) trim(shortname)
382 END IF
383 rc=esmf_rc_not_found
384 RETURN
385 END IF
386 END DO
387 END IF
388 END DO
389 END IF
390 END IF
391 END DO
392!
393 IF (esm_track) THEN
394 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetInitializeP1', &
395 & ', PET', petrank
396 FLUSH (trac)
397 END IF
398!
399 10 FORMAT (1x,'DATA_SetInitializeP1 - unable to find field ''',a, &
400 & ''' in ''Models(Idata)%ExportField'' list')
401!
402 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_esmf_esm::field_index(), mod_esmf_esm::idata, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setinitializep2()

subroutine, private esmf_data_mod::data_setinitializep2 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 405 of file esmf_data.F.

408!
409!=======================================================================
410! !
411! DATA component Phase 2 initialization: Initializes DATA structure, !
412! sets export fields grid, and adds fields to export states. !
413! !
414!=======================================================================
415!
416 USE mod_parallel
417 USE mod_scalars, ONLY : noerror, exit_flag
418 USE mod_strings, ONLY : nregion, my_cpu, my_fc, my_fflags, &
419 & my_fort, my_os, rdir
420!
421 USE strings_mod, ONLY : founderror
422!
423! Imported variable declarations.
424!
425 integer, intent(out) :: rc
426!
427 TYPE (ESMF_GridComp) :: model
428 TYPE (ESMF_State) :: ImportState
429 TYPE (ESMF_State) :: ExportState
430 TYPE (ESMF_Clock) :: clock
431!
432! Local variable declarations.
433!
434 integer :: is, localPET, lstr, PETcount, MyComm
435 integer :: ExportCount
436!
437 real(dp) :: TimeInDays, Time_Current
438!
439 character (len=20) :: Time_CurrentString
440
441 character (len=*), parameter :: MyFile = &
442 & __FILE__//", DATA_SetInitializeP2"
443!
444 TYPE (ESMF_TimeInterval) :: TimeStep
445 TYPE (ESMF_Time) :: CurrentTime
446 TYPE (ESMF_VM) :: vm
447!
448!-----------------------------------------------------------------------
449! Initialize return code flag to success state (no error).
450!-----------------------------------------------------------------------
451!
452 IF (esm_track) THEN
453 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetInitializeP2', &
454 & ', PET', petrank
455 FLUSH (trac)
456 END IF
457 rc=esmf_success
458!
459!-----------------------------------------------------------------------
460! Querry the Virtual Machine (VM) parallel environmemt for the
461! mpi communicator handle and current node rank.
462!-----------------------------------------------------------------------
463!
464 CALL esmf_gridcompget (model, &
465 & vm=vm, &
466 & rc=rc)
467 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
468 & line=__line__, &
469 & file=myfile)) THEN
470 RETURN
471 END IF
472!
473 CALL esmf_vmget (vm, &
474 & localpet=localpet, &
475 & petcount=petcount, &
476 & mpicommunicator=mycomm, &
477 & rc=rc)
478 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
479 & line=__line__, &
480 & file=myfile)) THEN
481 RETURN
482 END IF
483 esmcomm(idata)=mycomm
484!
485!-----------------------------------------------------------------------
486! If concurrent PET layout, call ROMS 'allocate parallel' routine over
487! all DATA component PETs. It is needed because the DATA component
488! uses ROMS NetCDF- and mpi-framework. We need to allocate all the
489! ROMS profiling arrays in such PETs. Set Master, InpThread, and
490! OutThread switches for this communicator needed for processing
491! NetCDF files. Notice that OCN_COMM_WORLD is set to the DATA
492! component communicator.
493!-----------------------------------------------------------------------
494!
495 IF (petlayoutoption.eq.'CONCURRENT') THEN
496 IF (.not.allocated(proc)) THEN
497 allocate ( proc(0:1,4,ngridsr) )
498 END IF
499 proc(0:1,1:4,1:ngridsr)=0
500!
501 IF (.not.allocated(cstr)) THEN
502 allocate ( cstr(0:nregion,4,ngridsr) )
503 END IF
504 cstr(0:nregion,1:4,1:ngridsr)=0.0_r8
505!
506 IF (.not.allocated(cend)) THEN
507 allocate ( cend(0:nregion,4,ngridsr) )
508 END IF
509 cend(0:nregion,1:4,1:ngridsr)=0.0_r8
510!
511 IF (.not.allocated(csum)) THEN
512 allocate ( csum(0:nregion,4,ngridsr) )
513 END IF
514 csum(0:nregion,1:4,1:ngridsr)=0.0_r8
515!
516 ocn_comm_world=mycomm
517 myrank=localpet
518 ctotal=0.0_r8
519 total_cpu=0.0_r8
520 total_model=0.0_r8
521 lwclock=.true.
522 CALL initialize_parallel
523!
524! The standard output is redirected to an specific file for clarity.
525! it unit is redifined.
526!
527!! dataout=101 ! overwite Fortran default unit 6
528!
529 IF (localpet.eq.0) THEN
530!! OPEN (dataout, FILE='log.data', FORM='formatted', &
531!! & STATUS='replace')
532 lstr=index(my_fflags, 'free')-2
533 IF (lstr.le.0) lstr=len_trim(my_fflags)
534 WRITE (dataout,10) trim(esmf_version_string), &
535 & trim(todaydatestring), &
536 & trim(rdir), &
537 & trim(my_os), &
538 & trim(my_cpu), &
539 & trim(my_fort), &
540 & trim(my_fc), &
541 & my_fflags(1:lstr), &
542 & mycomm, petcount
543 END IF
544 END IF
545!
546!-----------------------------------------------------------------------
547! Get driver current time. Notice that the DATA component clock has
548! not been created before this initialization phase.
549!-----------------------------------------------------------------------
550!
551 CALL esmf_clockget (clockinfo(idriver)%Clock, &
552 & timestep=timestep, &
553 & currtime=currenttime, &
554 & rc=rc)
555 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
556 & line=__line__, &
557 & file=myfile)) THEN
558 RETURN
559 END IF
560
561# ifdef REGRESS_STARTCLOCK
562!
563! The starting time was regressed during configuration to allow the
564! proper initialization of import and export states. We need to add
565! the coupling interval here to have the correct values for the
566! internal monotonic time coordinate (Tmono) in "DATA_inquiry" and
567! "DATA_ncread".
568!
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, &
573 & line=__line__, &
574 & file=myfile)) THEN
575 RETURN
576 END IF
577# else
578!
579! Get current time in seconds.
580!
581 CALL esmf_timeget (currenttime, &
582 & s_r8=time_current, &
583 & timestring=time_currentstring)
584 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
585 & line=__line__, &
586 & file=myfile)) THEN
587 RETURN
588 END IF
589# endif
590 timeindays=(time_current- &
591 & clockinfo(idata)%Time_Reference)/86400.0_dp
592 is=index(time_currentstring, 'T') ! remove 'T' in
593 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
594!
595!-----------------------------------------------------------------------
596! Initilize DATA component.
597!-----------------------------------------------------------------------
598!
599 CALL data_initialize (model, timeindays, localpet, rc)
600 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
601 & line=__line__, &
602 & file=myfile)) THEN
603 RETURN
604 END IF
605!
606!-----------------------------------------------------------------------
607! Set-up grid and load coordinate data.
608!-----------------------------------------------------------------------
609!
610 exportcount=ubound(models(idata)%ExportField, dim=1)
611!
612 CALL data_setgridarrays (model, exportcount, rc)
613 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
614 & line=__line__, &
615 & file=myfile)) THEN
616 RETURN
617 END IF
618!
619! Set DATA component land/sea mask as follows: 0: land
620! 1: ocean
621!
622 models(idata)%LandValue=0
623 models(idata)%SeaValue=1
624!
625!-----------------------------------------------------------------------
626! Set-up fields and register export state.
627!-----------------------------------------------------------------------
628!
629 CALL data_setstates (model, rc)
630 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
631 & line=__line__, &
632 & file=myfile)) THEN
633 RETURN
634 END IF
635!
636 IF (esm_track) THEN
637 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetInitializeP2', &
638 & ', PET', petrank
639 FLUSH (trac)
640 END IF
641!
642 10 FORMAT (80('-'),/, &
643 & ' Earth System Models Coupling: ESMF/NUOPC Library,', &
644 & ' Version ',a,/,31x,a,/, &
645 & 80('-'), &
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, &
653 & /,80('-'),/)
654!
655 RETURN
mod_parallel
Definition mod_parallel.F:2
mod_parallel::initialize_parallel
subroutine, public initialize_parallel
Definition mod_parallel.F:303
mod_parallel::cend
real(r8), dimension(:,:,:), allocatable cend
Definition mod_parallel.F:107
mod_parallel::cstr
real(r8), dimension(:,:,:), allocatable cstr
Definition mod_parallel.F:106
mod_parallel::total_model
real(r8), dimension(4) total_model
Definition mod_parallel.F:104
mod_parallel::total_cpu
real(r8) total_cpu
Definition mod_parallel.F:104
mod_parallel::ctotal
real(r8) ctotal
Definition mod_parallel.F:104
mod_parallel::proc
integer, dimension(:,:,:), allocatable proc
Definition mod_parallel.F:102
mod_parallel::myrank
integer myrank
Definition mod_parallel.F:157
mod_parallel::ocn_comm_world
integer ocn_comm_world
Definition mod_parallel.F:178
mod_parallel::csum
real(r8), dimension(:,:,:), allocatable csum
Definition mod_parallel.F:108
mod_parallel::lwclock
logical lwclock
Definition mod_parallel.F:119
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::nregion
integer, parameter nregion
Definition mod_strings.F:140
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

References mod_parallel::cend, mod_esmf_esm::clockinfo, mod_parallel::cstr, mod_parallel::csum, mod_parallel::ctotal, data_initialize(), data_setgridarrays(), data_setstates(), mod_esmf_esm::dataout, mod_esmf_esm::esm_track, mod_esmf_esm::esmcomm, mod_scalars::exit_flag, strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::idriver, mod_parallel::initialize_parallel(), mod_parallel::lwclock, mod_esmf_esm::models, mod_strings::my_cpu, mod_strings::my_fc, mod_strings::my_fflags, mod_strings::my_fort, mod_strings::my_os, mod_parallel::myrank, mod_esmf_esm::ngridsr, mod_scalars::noerror, mod_strings::nregion, mod_parallel::ocn_comm_world, mod_esmf_esm::petlayoutoption, mod_esmf_esm::petrank, mod_parallel::proc, mod_strings::rdir, mod_esmf_esm::timestep, mod_esmf_esm::todaydatestring, mod_parallel::total_cpu, mod_parallel::total_model, and mod_esmf_esm::trac.

Referenced by data_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setservices()

subroutine, public esmf_data_mod::data_setservices ( type (esmf_gridcomp) model,
integer, intent(out) rc )

Definition at line 132 of file esmf_data.F.

133!
134!=======================================================================
135! !
136! Sets DATA component shared-object entry points for "initialize", !
137! "run", and "finalize" by using NUOPC generic methods. !
138! !
139!=======================================================================
140!
141 implicit none
142!
143! Imported variable declarations.
144!
145 integer, intent(out) :: rc
146!
147 TYPE (ESMF_GridComp) :: model
148!
149! Local variable declarations.
150!
151 character (len=*), parameter :: MyFile = &
152 & __FILE__//", DATA_SetServices"
153!
154!-----------------------------------------------------------------------
155! Initialize return code flag to success state (no error).
156!-----------------------------------------------------------------------
157!
158 IF (esm_track) THEN
159 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetServices', &
160 & ', PET', petrank
161 FLUSH (trac)
162 END IF
163 rc=esmf_success
164!
165!-----------------------------------------------------------------------
166! Register NUOPC generic routines.
167!-----------------------------------------------------------------------
168!
169 CALL nuopc_compderive (model, &
170 & nuopc_setservices, &
171 & rc=rc)
172 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
173 & line=__line__, &
174 & file=myfile)) THEN
175 RETURN
176 END IF
177!
178!-----------------------------------------------------------------------
179! Register initialize routines.
180!-----------------------------------------------------------------------
181!
182! Set routine for Phase 1 initialization (advertise export fields).
183!
184 CALL nuopc_compsetentrypoint (model, &
185 & methodflag=esmf_method_initialize, &
186 & phaselabellist=(/"IPDv00p1"/), &
187 & userroutine=data_setinitializep1, &
188 & rc=rc)
189 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
190 & line=__line__, &
191 & file=myfile)) THEN
192 RETURN
193 END IF
194!
195! Set routine for Phase 2 initialization (exchange arrays).
196!
197 CALL nuopc_compsetentrypoint (model, &
198 & methodflag=esmf_method_initialize, &
199 & phaselabellist=(/"IPDv00p2"/), &
200 & userroutine=data_setinitializep2, &
201 & rc=rc)
202 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
203 & line=__line__, &
204 & file=myfile)) THEN
205 RETURN
206 END IF
207!
208!-----------------------------------------------------------------------
209! Attach DATA component phase independent specializing methods.
210!-----------------------------------------------------------------------
211
212# ifdef TIME_INTERP
213!
214! Set routine for export initial/restart fields.
215!
216 CALL nuopc_compspecialize (model, &
217 & speclabel=nuopc_label_datainitialize, &
218 & specroutine=data_datainit, &
219 & rc=rc)
220 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
221 & line=__line__, &
222 & file=myfile)) THEN
223 RETURN
224 END IF
225# endif
226!
227! Set routine for setting DATA component clock.
228!
229 CALL nuopc_compspecialize (model, &
230 & speclabel=nuopc_label_setclock, &
231 & specroutine=data_setclock, &
232 & rc=rc)
233 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
234 & line=__line__, &
235 & file=myfile)) THEN
236 RETURN
237 END IF
238!
239! Set routine for advancing DATA component.
240!
241 CALL nuopc_compspecialize (model, &
242 & speclabel=nuopc_label_advance, &
243 & specroutine=data_modeladvance, &
244 & rc=rc)
245 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
246 & line=__line__, &
247 & file=myfile)) THEN
248 RETURN
249 END IF
250!
251!-----------------------------------------------------------------------
252! Register DATA component finalize routine.
253!-----------------------------------------------------------------------
254!
255 CALL esmf_gridcompsetentrypoint (model, &
256 & methodflag=esmf_method_finalize, &
257 & userroutine=data_setfinalize, &
258 & rc=rc)
259 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
260 & line=__line__, &
261 & file=myfile)) THEN
262 RETURN
263 END IF
264!
265 IF (esm_track) THEN
266 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetServices', &
267 & ', PET', petrank
268 FLUSH (trac)
269 END IF
270!
271 RETURN

References data_datainit(), data_modeladvance(), data_setclock(), data_setfinalize(), data_setinitializep1(), data_setinitializep2(), mod_esmf_esm::esm_track, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by esmf_esm_mod::esm_setmodelservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ data_setstates()

subroutine, private esmf_data_mod::data_setstates ( type (esmf_gridcomp), intent(inout) model,
integer, intent(out) rc )
private

Definition at line 1475 of file esmf_data.F.

1476!
1477!=======================================================================
1478! !
1479! Adds DATA component fields into export state. !
1480! !
1481!=======================================================================
1482!
1483 implicit none
1484!
1485! Imported variable declarations.
1486!
1487 integer, intent(out) :: rc
1488!
1489 TYPE (ESMF_GridComp), intent(inout) :: model
1490!
1491! Local variable declarations.
1492!
1493 integer :: Icomp, Nfields, Nfiles, ifld, nd, ng
1494 integer :: localDE, localDEcount, localPET
1495 integer :: ExportCount
1496!
1497 real (dp), dimension(:,:), pointer :: ptr2d => null()
1498!
1499 character (len=10) :: AttList(1)
1500 character (len=20) :: FieldName
1501
1502 character (len=*), parameter :: MyFile = &
1503 & __FILE__//", DATA_SetStates"
1504!
1505 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
1506!
1507 TYPE (ESMF_ArraySpec) :: arraySpec
1508 TYPE (ESMF_Field) :: field
1509 TYPE (ESMF_StaggerLoc) :: staggerLoc
1510 TYPE (ESMF_VM) :: vm
1511!
1512!-----------------------------------------------------------------------
1513! Initialize return code flag to success state (no error).
1514!-----------------------------------------------------------------------
1515!
1516 IF (esm_track) THEN
1517 WRITE (trac,'(a,a,i0)') '==> Entering DATA_SetStates', &
1518 & ', PET', petrank
1519 FLUSH (trac)
1520 END IF
1521 rc=esmf_success
1522!
1523!-----------------------------------------------------------------------
1524! Query gridded component.
1525!-----------------------------------------------------------------------
1526!
1527 CALL esmf_gridcompget (model, &
1528 & localpet=localpet, &
1529 & vm=vm, &
1530 & rc=rc)
1531 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1532 & line=__line__, &
1533 & file=myfile)) THEN
1534 RETURN
1535 END IF
1536!
1537!-----------------------------------------------------------------------
1538! Set a 2D floating-point array descriptor.
1539!-----------------------------------------------------------------------
1540!
1541 CALL esmf_arrayspecset (arrayspec, &
1542 & typekind=esmf_typekind_r8, &
1543 & rank=2, &
1544 & rc=rc)
1545 IF (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
1546 & line=__line__, &
1547 & file=myfile)) THEN
1548 RETURN
1549 END IF
1550 staggerloc=esmf_staggerloc_center
1551!
1552!-----------------------------------------------------------------------
1553! Add export fields into export state.
1554!-----------------------------------------------------------------------
1555!
1556! Set export field(s).
1557!
1558 field_loop : DO icomp=1,nmodels
1559 IF (icomp.ne.idata) THEN
1560 nfiles=dataset(icomp)%Nfiles
1561 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
1562 nfields=dataset(icomp)%Nfields
1563 DO ng=1,models(icomp)%Ngrids
1564 IF (coupled(icomp)%LinkedGrid(ng,idata)) THEN
1565 nd=coupled(idata)%DataCoupledSets(ng,icomp)
1566!
1567! For debugging, inquire state about the number of fields to export.
1568! It should be the same as Nfields.
1569!
1570 CALL esmf_stateget (coupled(idata)% &
1571 & exportstate(nd,icomp), &
1572 & itemcount=exportcount, &
1573 & rc=rc)
1574 IF (esmf_logfounderror(rctocheck=rc, &
1575 & msg=esmf_logerr_passthru, &
1576 & line=__line__, &
1577 & file=myfile)) THEN
1578 RETURN
1579 END IF
1580!
1581! For debugging, inquire state about the list of export field names. It
1582! should be the same as the ones advertised in "DATA_SetInitializeP1".
1583!
1584 IF (.not.allocated(exportnamelist)) THEN
1585 allocate ( exportnamelist(exportcount) )
1586 END IF
1587 CALL esmf_stateget (coupled(idata)% &
1588 & exportstate(nd,icomp), &
1589 & itemnamelist=exportnamelist, &
1590 & rc=rc)
1591 IF (esmf_logfounderror(rctocheck=rc, &
1592 & msg=esmf_logerr_passthru, &
1593 & line=__line__, &
1594 & file=myfile)) THEN
1595 RETURN
1596 END IF
1597!
1598! Add export fields to the state set.
1599!
1600 DO ifld=1,nfields
1601 fieldname=dataset(icomp)%Field(ifld)
1602!
1603 IF (nuopc_isconnected(coupled(idata)% &
1604 & exportstate(nd,icomp), &
1605 & fieldname=trim(fieldname), &
1606 & rc=rc)) THEN
1607!
1608! Create 2D field from the Grid and arraySpec.
1609!
1610 field=esmf_fieldcreate(dataset(icomp)% &
1611 & export(ifld)%grid, &
1612 & arrayspec, &
1613 & indexflag=esmf_index_global, &
1614 & staggerloc=staggerloc, &
1615 & name=trim(fieldname), &
1616 & rc=rc)
1617 IF (esmf_logfounderror(rctocheck=rc, &
1618 & msg=esmf_logerr_passthru, &
1619 & line=__line__, &
1620 & file=myfile)) THEN
1621 RETURN
1622 END IF
1623!
1624! Get number of local decomposition elements (DEs). Usually, a single
1625! Decomposition Element (DE) is associated with each Persistent
1626! Execution Thread (PETs). Thus, localDEcount=1.
1627!
1628 CALL esmf_gridget (dataset(icomp)% &
1629 & export(ifld)%grid, &
1630 & localdecount=localdecount, &
1631 & rc=rc)
1632 IF (esmf_logfounderror(rctocheck=rc, &
1633 & msg=esmf_logerr_passthru, &
1634 & line=__line__, &
1635 & file=myfile)) THEN
1636 RETURN
1637 END IF
1638
1639# ifdef TIME_INTERP_NOT_WORKING
1640!
1641! Create standard Attribute Package for each export field. Then, nest
1642! custom Attribute Package around it.
1643!
1644 CALL esmf_attributeadd (field, &
1645 & convention='ESMF', &
1646 & purpose='General', &
1647 & rc=rc)
1648 IF (esmf_logfounderror(rctocheck=rc, &
1649 & msg=esmf_logerr_passthru, &
1650 & line=__line__, &
1651 & file=myfile)) THEN
1652 RETURN
1653 END IF
1654!
1655 attlist(1)='TimeInterp'
1656 CALL esmf_attributeadd (field, &
1657 & convention='CustomConvention', &
1658 & purpose='General', &
1659!! & purpose='Instance', &
1660 & attrlist=attlist, &
1661 & nestconvention='ESMF', &
1662 & nestpurpose='General', &
1663 & rc=rc)
1664 IF (esmf_logfounderror(rctocheck=rc, &
1665 & msg=esmf_logerr_passthru, &
1666 & line=__line__, &
1667 & file=myfile)) THEN
1668 RETURN
1669 END IF
1670!
1671 CALL esmf_attributelink (exportstate, field, rc=rc)
1672 IF (esmf_logfounderror(rctocheck=rc, &
1673 & msg=esmf_logerr_passthru, &
1674 & line=__line__, &
1675 & file=myfile)) THEN
1676 RETURN
1677 END IF
1678# endif
1679!
1680! Get pointer to DE-local memory allocation within field. Usually, the
1681! DO-loop is executed once since localDEcount=1.
1682!
1683 DO localde=0,localdecount-1
1684 CALL esmf_fieldget (field, &
1685 & localde=localde, &
1686 & farrayptr=ptr2d, &
1687 & rc=rc)
1688 IF (esmf_logfounderror(rctocheck=rc, &
1689 & msg=esmf_logerr_passthru, &
1690 & line=__line__, &
1691 & file=myfile)) THEN
1692 RETURN
1693 END IF
1694!
1695! Initialize pointer.
1696!
1697 ptr2d=missing_dp
1698!
1699! Nullify pointer to make sure that it does not point on a random part
1700! in the memory.
1701!
1702 IF ( associated(ptr2d) ) nullify (ptr2d)
1703 END DO
1704!
1705! Add field export state.
1706!
1707 CALL nuopc_realize (coupled(idata)% &
1708 & exportstate(nd,icomp), &
1709 & field=field, &
1710 & rc=rc)
1711 IF (esmf_logfounderror(rctocheck=rc, &
1712 & msg=esmf_logerr_passthru, &
1713 & line=__line__, &
1714 & file=myfile)) THEN
1715 RETURN
1716 END IF
1717!
1718! Save field pointer. It will be used by the coupler for regridding. It
1719! needs to be saved only for the coarser grid since the other nested
1720! grids uses the same dataset. There is a problem with the FieldBundles
1721! in the DATA component that yields empty field objects. Perhaps it is
1722! because the FieldBundle stores similar fields discretized on the same
1723! Grid. The DATA component is generic, and a different grid object is
1724! defined for each exported field.
1725!
1726 IF (ng.eq.1) THEN
1727 dataset(icomp)%export(ifld)%field=field
1728 END IF
1729!
1730! Remove field from export state because it is not connected.
1731!
1732 ELSE
1733 IF (localpet.eq.0) THEN
1734 WRITE (dataout,10) trim(fieldname), &
1735 & 'Export State: ', &
1736 & trim(coupled(idata)% &
1737 & explabel(nd))
1738 END IF
1739 CALL esmf_stateremove (coupled(idata)% &
1740 & exportstate(nd,icomp),&
1741 & (/ trim(fieldname) /), &
1742 & rc=rc)
1743 IF (esmf_logfounderror(rctocheck=rc, &
1744 & msg=esmf_logerr_passthru, &
1745 & line=__line__, &
1746 & file=myfile)) THEN
1747 RETURN
1748 END IF
1749 END IF
1750 END DO
1751 END IF
1752 END DO
1753!
1754! Deallocate temporary variable.
1755!
1756 IF ( allocated(exportnamelist) ) THEN
1757 deallocate (exportnamelist)
1758 END IF
1759 END IF
1760 END IF
1761 END DO field_loop
1762!
1763 IF (esm_track) THEN
1764 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_SetStates', &
1765 & ', PET', petrank
1766 FLUSH (trac)
1767 END IF
1768!
1769 10 FORMAT (1x,'DATA_SetStates - Removing field ''',a,''' from ',a, &
1770 & '''',a,'''',/,18x,'because it is not connected.')
1771!
1772 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_esmf_esm::idata, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_setinitializep2().

Here is the caller graph for this function:

◆ data_timeinterp()

subroutine, private esmf_data_mod::data_timeinterp ( real(dp), intent(in) tcurrent,
integer, intent(in) localpet,
integer, intent(out) rc )
private

Definition at line 2747 of file esmf_data.F.

2748!
2749!=======================================================================
2750! !
2751! This routine time interpolates the fields that the DATA component !
2752! exports to other ESM components. The data is loaded to the arrays !
2753! in the structure: !
2754! !
2755! DataSet(Icomp)%Export(ifld)%A2d(:,:) 2D field !
2756! DataSet(Icomp)%Export(ifld)%A3d(:,:,:) 3D field !
2757! !
2758! On Input: !
2759! !
2760! Tcurrent Current time in days (real) !
2761! localPET Local Persistent Execution Thread (integer) !
2762! !
2763! On Output: !
2764! !
2765! DataSet Updated DATA component structure. !
2766! rc Return code flag (integer) !
2767! !
2768!=======================================================================
2769!
2770 USE mod_scalars, ONLY : noerror, exit_flag
2771!
2772 USE strings_mod, ONLY : founderror
2773!
2774! Imported variable declarations.
2775!
2776 integer, intent(in) :: localPET
2777 integer, intent(out) :: rc
2778!
2779 real(dp), intent(in) :: Tcurrent
2780!
2781! Local variable declarations.
2782!
2783 integer :: Icomp, Nfields, Nfiles, Nvdim, ifld
2784 integer :: Tindex, it1, it2
2785 integer :: Im, Jm, Km, i, j, k
2786!
2787 real(dp) :: Tstr, Tend, Tmin, Tmax
2788 real(dp) :: Tintrp(2)
2789 real(dp) :: DayScale, fac, fac1, fac2, w1, w2
2790 real(dp) :: Fval
2791!
2792 character (len=100) :: Vname
2793
2794 character (len=*), parameter :: MyFile = &
2795 & __FILE__//", DATA_TimeInterp"
2796!
2797!-----------------------------------------------------------------------
2798! Initialize return code flag to success state (no error).
2799!-----------------------------------------------------------------------
2800!
2801 IF (esm_track) THEN
2802 WRITE (trac,'(a,a,i0)') '==> Entering DATA_TimeInterp', &
2803 & ', PET', petrank
2804 FLUSH (trac)
2805 END IF
2806 rc=esmf_success
2807!
2808!-----------------------------------------------------------------------
2809! Time interpolate fields to export from data snapshots.
2810!-----------------------------------------------------------------------
2811!
2812 field_loop : DO icomp=1,nmodels
2813 IF (icomp.ne.idata) THEN
2814 nfiles=dataset(icomp)%Nfiles
2815 IF (models(icomp)%IsActive.and.(nfiles.gt.0)) THEN
2816 nfields=dataset(icomp)%Nfields
2817 DO ifld=1,nfields
2818 nvdim=dataset(icomp)%Export(ifld)%Nvdim
2819!
2820! Load properties of export field to read from source NetCDF file.
2821!
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)
2830!
2831! Set linear-interpolation factors. To avoid roundoff, the fractional
2832! days interval are rounded to the nearest millisecond interger toward
2833! zero in the time interpolation weights.
2834!
2835 dayscale=86400.0_dp*1000.0_dp ! days to milliseconds
2836 it1=3-tindex
2837 it2=tindex
2838 fac1=anint((tintrp(it2)-tcurrent)*dayscale)
2839 fac2=anint((tcurrent-tintrp(it1))*dayscale)
2840!
2841! Time-interpolate from gridded or point data.
2842!
2843 IF (((fac1*fac2).ge.0.0_dp).and. &
2844 & ((fac1+fac2).gt.0.0_dp)) THEN
2845 fac=1.0_dp/(fac1+fac2)
2846 w1=fac*fac1
2847 w2=fac*fac2
2848 IF (nvdim.eq.2) THEN ! 2D variable
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
2853 allocate ( dataset(icomp)% &
2854 & export(ifld)%A2d(im,jm) )
2855 END IF
2856 DO j=1,jm
2857 DO i=1,im
2858 fval=w1*dataset(icomp)%Export(ifld)% &
2859 & a2dg(i,j,it1)+ &
2860 & w2*dataset(icomp)%Export(ifld)% &
2861 & a2dg(i,j,it2)
2862 dataset(icomp)%Export(ifld)%A2d(i,j)=fval
2863 END DO
2864 END DO
2865 ELSE IF (nvdim.eq.3) THEN ! 3D variable
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
2871 allocate ( dataset(icomp)% &
2872 & export(ifld)%A3d(im,jm,km) )
2873 END IF
2874 DO k=1,km
2875 DO j=1,jm
2876 DO i=1,im
2877 fval=w1*dataset(icomp)%Export(ifld)% &
2878 & a3dg(i,j,k,it1)+ &
2879 & w2*dataset(icomp)%Export(ifld)% &
2880 & a3dg(i,j,k,it2)
2881 dataset(icomp)%Export(ifld)%A3d(i,j,k)=fval
2882 END DO
2883 END DO
2884 END DO
2885 END IF
2886!
2887! Unable to set-up requested field. Activate error flag to quit.
2888!
2889 ELSE
2890 IF (localpet.eq.0) THEN
2891 WRITE (dataout,10) trim(vname), tcurrent, &
2892 & tmin, tmax, &
2893 & tstr, tend, &
2894 & tintrp(it1), tintrp(it2), &
2895 & fac1, fac2
2896 END IF
2897 exit_flag=2
2898 IF (founderror(exit_flag, noerror, __line__, &
2899 & myfile)) THEN
2900 rc=esmf_rc_val_outofrange
2901 RETURN
2902 END IF
2903 END IF
2904 END DO
2905 END IF
2906 END IF
2907 END DO field_loop
2908!
2909 IF (esm_track) THEN
2910 WRITE (trac,'(a,a,i0)') '<== Exiting DATA_TimeInterp', &
2911 & ', PET', petrank
2912 FLUSH (trac)
2913 END IF
2914!
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)
2922!
2923 RETURN

References mod_esmf_esm::dataout, mod_esmf_esm::dataset, mod_esmf_esm::esm_track, mod_scalars::exit_flag, strings_mod::founderror(), mod_esmf_esm::idata, mod_esmf_esm::models, mod_esmf_esm::nfields, mod_esmf_esm::nmodels, mod_scalars::noerror, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by data_export().

Here is the call graph for this function:
Here is the caller graph for this function: