recursive subroutine MAPL_GenericInitialize ( GC, import, EXPORT, CLOCK, RC )
!ARGUMENTS:
type(ESMF_GridComp), intent(INOUT) :: GC ! Gridded component
type(ESMF_State), intent(INOUT) :: IMPORT ! Import state
type(ESMF_State), intent(INOUT) :: EXPORT ! Export state
type(ESMF_Clock), intent(INOUT) :: CLOCK ! The clock
integer, optional, intent( OUT) :: RC ! Error code:
!EOPI
! ErrLog Variables
character(len=ESMF_MAXSTR) :: IAm
character(len=ESMF_MAXSTR) :: comp_name
integer :: status
integer :: userRC
! Local derived type aliases
type (MAPL_MetaComp),pointer :: STATE
type (MaplGrid ),pointer :: MYGRID
! Local variables
type (ESMF_Time ) :: ringTime
type (ESMF_TimeInterval) :: TIMEINT
type (ESMF_TimeInterval) :: TSTEP
type (ESMF_VM) :: VM
character(len=ESMF_MAXSTR) :: FILENAME
real :: DT
real :: DEFDT
integer :: COUNTS(3)
integer :: COMM
integer :: I, J
integer :: NSUBTILES
integer :: DIMCOUNT
type (ESMF_Grid) :: TILEGRID
type (ESMF_Calendar) :: cal
type (ESMF_Alarm) :: recordAlarm
type (ESMF_Alarm), allocatable :: R_ALARM(:)
integer, allocatable :: R_FILETYPE(:)
integer, dimension(:), allocatable :: ref_date, ref_time, freq
character(len=ESMF_MAXSTR), allocatable :: freq_string(:)
logical :: mnthly
integer :: NRA, sec
character(len=ESMF_MAXSTR) :: AlarmName
character(len=3) :: alarmNum
type(ESMF_Time) :: CurrTime ! Current time of the ESMF clock
type(ESMF_Time) :: RefTime
type(ESMF_TimeInterval) :: Frequency
character(len=ESMF_MAXSTR) :: CHILD_NAME
type(ESMF_Grid) :: CHLGRID
type(ESMF_DistGrid) :: distGRID
integer :: nhms ! Current Time date and hour/minute
type (MAPL_MetaComp), pointer :: PMAPL
integer :: hdr
integer :: DELTSEC
integer :: DTSECS
type(ESMF_TimeInterval) :: DELT
integer :: ndes
integer, allocatable :: minindex(:,:)
integer, allocatable :: maxindex(:,:)
integer, pointer :: ims(:) => null()
integer, pointer :: jms(:) => null()
logical :: isGridValid
logical :: ChldGridValid
integer :: reference_date
integer :: reference_time
integer :: yyyymmdd, hhmmss
integer :: year, month, day, hh, mm, ss
character(len=ESMF_MAXSTR) :: gridTypeAttribute
character(len=ESMF_MAXSTR) :: tmp_label, FILEtpl
character(len=ESMF_MAXSTR) :: id_string
integer :: ens_id_width
real(ESMF_KIND_R8) :: fixedLons, fixedLats
type(ESMF_GridComp) :: GCCS ! this is needed as a workaround
! for recursive ESMF method within method
! calls (see ESMF bug 3004440).
! Only coldstart is affected
logical :: isPresent
logical :: is_associated
character(len=ESMF_MAXSTR) :: positive, comp_to_record
type(ESMF_State), pointer :: child_export_state
type(ESMF_GridComp), pointer :: gridcomp
type(ESMF_State), pointer :: internal_state
logical :: is_test_framework, is_test_framework_driver
!=============================================================================
! Begin...
! Get the target components name and set-up traceback handle.
! -----------------------------------------------------------
Iam = "MAPL_GenericInitialize"
call ESMF_GridCompGet( GC, NAME=comp_name, _RC)
Iam = trim(comp_name) // trim(Iam)
FILENAME = ""
! Retrieve the pointer to the internal state.
! -------------------------------------------
call MAPL_InternalStateGet ( GC, STATE, _RC)
call MAPL_GetResource(STATE, comp_to_record, label='COMPONENT_TO_RECORD:', default='')
call MAPL_GetResource(STATE, is_test_framework, label='TEST_FRAMEWORK:', default=.false.)
call MAPL_GetResource(STATE, is_test_framework_driver, label='TEST_FRAMEWORK_DRIVER:', default=.false.)
if (comp_name == comp_to_record .and. (is_test_framework .or. is_test_framework_driver)) then
! force skipReading and skipWriting in NCIO to be false
call ESMF_AttributeSet(import, name="MAPL_TestFramework", value=.true., _RC)
end if
! Start my timer
!---------------
!C$ call MAPL_TimerOn(STATE,"generic", _RC)
! Put the inherited grid in the generic state
!--------------------------------------------
MYGRID => STATE%GRID
call ESMF_VmGetCurrent(VM, _RC)
call ESMF_VmGet(VM, localPet=MYGRID%MYID, petCount=ndes, _RC)
call ESMF_VmGet(VM, mpicommunicator=comm, _RC)
! TODO: esmfgrid should be obtained separately
isGridValid = grid_is_valid(gc, mygrid%esmfgrid, _RC)
! At this point, this component must have a valid grid!
!------------------------------------------------------
if (isGridValid) then
! Check children's grid. If they don't have a valid grid yet, put this one in their GC
! ------------------------------------------------------------------------------------
do I=1, STATE%get_num_children()
chldGridValid = .false.
gridcomp => STATE%GET_CHILD_GRIDCOMP(I)
chldGridValid = grid_is_valid(gridcomp, ChlGrid, _RC)
if (.not. chldGridValid) then
! This child does not have a valid grid
call ESMF_GridCompSet( gridcomp, GRID = MYGRID%ESMFGRID, _RC )
end if
end do
! We keep these in the component's grid for convenience
!-------------------------------------------------------
call ESMF_GridGet(MYGRID%ESMFGRID, DistGrid=distgrid, dimCount=dimCount, _RC)
call ESMF_DistGridGet(distGRID, deLayout=MYGRID%LAYOUT, _RC)
! Vertical coordinate must exist and be THE THIRD DIMENSION
! ---------------------------------------------------------
MYGRID%VERTDIM = 3
call MAPL_GridGet(MYGRID%ESMFGRID, localCellCountPerDim=COUNTS, _RC)
#ifdef DEBUG
print *,'dbg:myId=',MYGRID%MYID,trim(Iam)
print *,'dbg:local gridcounts=',counts
#endif
! Local sizes of three dimensions
!--------------------------------
MYGRID%IM = COUNTS(1)
MYGRID%JM = COUNTS(2)
MYGRID%LM = COUNTS(3)
call MAPL_GridGet(MYGRID%ESMFGRID, globalCellCountPerDim=COUNTS, _RC)
MYGRID%IM_WORLD = COUNTS(1)
MYGRID%JM_WORLD = COUNTS(2)
allocate(minindex(dimCount,ndes), maxindex(dimCount,ndes), __STAT__)
! Processors in each direction
!-----------------------------
call MAPl_DistGridGet(distgrid, &
minIndex=minindex, &
maxIndex=maxindex, _RC)
call MAPL_GetImsJms(Imins=minindex(1,:),Imaxs=maxindex(1,:),&
Jmins=minindex(2,:),Jmaxs=maxindex(2,:),Ims=ims,Jms=jms,_RC)
MYGRID%NX = size(ims)
MYGRID%NY = size(jms)
allocate(mygrid%i1( MYGRID%nx), mygrid%in( MYGRID%nx))
allocate(mygrid%j1( MYGRID%ny), mygrid%jn( MYGRID%ny))
mygrid%i1 = minindex(1,:mygrid%nx)
mygrid%in = maxindex(1,:mygrid%nx)
mygrid%j1 = minindex(2,1:ndes: MYGRID%nx)
mygrid%jn = maxindex(2,1:ndes: MYGRID%nx)
deallocate(maxindex, minindex)
! My processor coordinates
!-------------------------
#if 0
call ESMF_DELayoutGetDELocalInfo(delayout=MYGRID%LAYOUT, de=MYGRID%MYID, coord=DECOUNT, _RC)
MYGRID%NX0 = DECOUNT(1)
MYGRID%NY0 = DECOUNT(2)
#else
MYGRID%NX0 = mod(MYGRID%MYID,MYGRID%NX) + 1
MYGRID%NY0 = MYGRID%MYID/MYGRID%NX + 1
#endif
call set_checkpoint_restart_options(_RC)
#ifdef DEBUG
print *,"dbg: grid global max=",counts
print *, "NX NY:", MYGRID%NX, MYGRID%NY
print *,'dbg:NX0 NY0=', MYGRID%NX0, MYGRID%NY0
print *, "dbg:ims=", ims
print *, "dbg:jms=", jms
print *,"========================="
#endif
! Clean up
deallocate(jms, ims)
! Create and initialize factors saved as ESMF arrays in MYGRID
!-------------------------------------------------------------
call ESMFL_GridCoordGet( MYGRID%ESMFGRID, MYGRID%LATS , &
Name = "Latitude" , &
Location = ESMF_STAGGERLOC_CENTER , &
Units = MAPL_UnitsRadians , &
RC = status )
call ESMFL_GridCoordGet( MYGRID%ESMFGRID, MYGRID%LONS , &
Name = "Longitude" , &
Location = ESMF_STAGGERLOC_CENTER , &
Units = MAPL_UnitsRadians , &
RC = status )
gridTypeAttribute = ''
call ESMF_AttributeGet(MYGRID%ESMFGRID, name='GridType', isPresent=isPresent, _RC)
if (isPresent) then
call ESMF_AttributeGet(MYGRID%ESMFGRID, name='GridType', value=gridTypeAttribute, _RC)
if (gridTypeAttribute == 'Doubly-Periodic') then
! this is special case: doubly periodic grid
! we ignore ESMF grid coordinates and set LONS/LATS from resource
call MAPL_GetResource( STATE, fixedLons, Label="FIXED_LONS:", _RC)
call MAPL_GetResource( STATE, fixedLats, Label="FIXED_LATS:", _RC)
MYGRID%LONS = fixedLons * (MAPL_PI_R8/180._REAL64)
MYGRID%LATS = fixedLats * (MAPL_PI_R8/180._REAL64)
endif ! doubly-periodic
end if ! isPresent
end if ! isGridValid
! set positive convention
call MAPL_GetResource( STATE, positive, Label="CHECKPOINT_POSITIVE:", &
default='down', _RC)
positive = ESMF_UtilStringLowerCase(positive,_RC)
_ASSERT(trim(positive)=="up".or.trim(positive)=="down","positive must be up or down")
! Put the clock passed down in the generic state
!-----------------------------------------------
call handle_clock_and_main_alarm(clock, _RC)
! Create tiling for all gridded components with associated LocationStream
! -----------------------------------------------------------------------
is_associated=MAPL_LocStreamIsAssociated(STATE%LOCSTREAM, _RC)
if (is_associated) then
NSUBTILES = MAPL_GetNumSubtiles(STATE, _RC)
call MAPL_LocStreamAdjustNsubtiles(STATE%LocStream, NSUBTILES, _RC)
call MAPL_LocStreamGet(STATE%LocStream, TILEGRID=TILEGRID, _RC)
endif
call handle_record(_RC)
!C$ call MAPL_TimerOff(STATE,"generic",_RC)
call initialize_children_and_couplers(_RC)
call MAPL_TimerOn(STATE,"generic")
call create_import_and_initialize_state_variables(_RC)
call ESMF_AttributeSet(import,'POSITIVE',trim(positive),_RC)
call create_internal_and_initialize_state_variables(_RC)
call create_export_state_variables(_RC)
! Create forcing state
STATE%FORCING = ESMF_StateCreate(name = trim(comp_name) // "_FORCING", &
_RC)
! Put the Export state of each child into my export
! -------------------------------------------------
!ALT: export might have to be declared ESMF_STATELIST
do i = 1, state%get_num_children()
child_export_state => state%get_child_export_state(i)
call ESMF_StateAdd(EXPORT, [child_export_state], _RC)
end do
if (.not. associated(STATE%parentGC)) then
call MAPL_AdjustIsNeeded(GC, EXPORT, _RC)
end if
call handle_services(_RC)
! Write Memory Use Statistics.
! -------------------------------------------
call MAPL_MemUtilsWrite(VM, Iam, _RC )
call MAPL_TimerOff(STATE,"generic", _RC)
_RETURN(ESMF_SUCCESS)
contains
logical function grid_is_valid(gc, grid, rc)
type(ESMF_GridComp), intent(inout) :: gc
type(ESMF_Grid), intent(out) :: grid
integer, optional, intent(out) :: rc
integer :: status
logical :: is_present
logical :: is_created
grid_is_valid = .false.
call ESMF_GridCompGet(gc, gridIsPresent=is_present, _RC)
if (is_present) then
call ESMF_GridCompGet(gc, grid=grid, _RC)
is_created = ESMF_GridIsCreated(grid, _RC)
if (is_created) then
call ESMF_GridValidate(grid, _RC)
grid_is_valid = .true.
end if
end if
_RETURN(ESMF_SUCCESS)
end function grid_is_valid
subroutine set_checkpoint_restart_options(rc)
integer, optional, intent(out) :: rc
integer :: num_readers, num_writers
character(len=ESMF_MAXSTR) :: split_checkpoint
character(len=ESMF_MAXSTR) :: split_restart
character(len=ESMF_MAXSTR) :: write_restart_by_oserver
integer :: j
integer :: status
call MAPL_GetResource( STATE, num_readers, Label="NUM_READERS:", &
default=1, _RC)
call MAPL_GetResource( STATE, num_writers, Label="NUM_WRITERS:", &
default=1, _RC)
call MAPL_GetResource( STATE, split_checkpoint, Label="SPLIT_CHECKPOINT:", &
default='NO', _RC)
call MAPL_GetResource( STATE, split_restart, Label="SPLIT_RESTART:", &
default='NO', _RC)
split_restart = ESMF_UtilStringUpperCase(split_restart,_RC)
split_checkpoint = ESMF_UtilStringUpperCase(split_checkpoint,_RC)
call MAPL_GetResource( STATE, write_restart_by_oserver, Label="WRITE_RESTART_BY_OSERVER:", &
default='NO', _RC)
write_restart_by_oserver = ESMF_UtilStringUpperCase(write_restart_by_oserver,_RC)
if (trim(write_restart_by_oserver) == 'YES') then
! reset other choices
! io_rank 0 becomes the root
!num_writers = 1
!split_checkpoint = 'NO'
mygrid%write_restart_by_oserver = .true.
endif
mygrid%comm = comm
mygrid%num_readers = num_readers
mygrid%num_writers = num_writers
mygrid%split_checkpoint = .false.
mygrid%split_restart = .false.
if (trim(split_checkpoint) == 'YES') then
mygrid%split_checkpoint = .true.
endif
if (trim(split_restart) == 'YES') then
mygrid%split_restart = .true.
endif
_RETURN(ESMF_SUCCESS)
end subroutine set_checkpoint_restart_options
recursive subroutine initialize_children_and_couplers(rc)
integer, optional, intent(out) :: rc
integer :: NC
integer :: i
integer :: MAXPHASES
integer :: NUMPHASES
integer :: PHASE
type (MAPL_MetaPtr), allocatable :: CHLDMAPL(:)
type(ESMF_State), pointer :: child_import_state
type(ESMF_State), pointer :: child_export_state
integer :: status
! Initialize the children
! -----------------------
NC = STATE%get_num_children()
if (STATE%ChildInit) then
allocate(CHLDMAPL(NC), stat=status)
MAXPHASES = 0
do I=1,NC
gridcomp => STATE%GET_CHILD_GRIDCOMP(I)
call MAPL_GetObjectFromGC(gridcomp, CHLDMAPL(I)%PTR, _RC)
MAXPHASES = MAX(MAXPHASES, SIZE(CHLDMAPL(I)%PTR%PHASE_INIT))
end do
if (MAXPHASES > 1) then
call WRITE_PARALLEL( &
"WARNING: multiple INITIALIZE methods detected " // &
"for the children of " // &
trim(comp_name)// ". " // &
"Although this is allowed, MAPL is currently restricted " //&
"to the default PHASE=1 and no longer will " // &
"automatically execute all of them" )
end if
PHASE = 1
do I=1,NC
NUMPHASES = SIZE(CHLDMAPL(I)%PTR%PHASE_INIT)
if (PHASE .le. NUMPHASES) then
gridcomp => STATE%GET_CHILD_GRIDCOMP(I)
call ESMF_GridCompGet( gridcomp, NAME=CHILD_NAME, _RC )
call MAPL_TimerOn (STATE,trim(CHILD_NAME))
child_import_state => STATE%get_child_import_state(i)
child_export_state => STATE%get_child_export_state(i)
call ESMF_GridCompInitialize (gridcomp, &
importState=child_import_state, &
exportState=child_export_state, &
clock=CLOCK, PHASE=CHLDMAPL(I)%PTR%PHASE_INIT(PHASE), &
userRC=userRC, _RC )
_VERIFY(userRC)
call MAPL_TimerOff(STATE,trim(CHILD_NAME))
end if
end do
deallocate(CHLDMAPL)
!ALT addition for ExtData component.
! We are doing this after all children have been initialized
!----------------------------------
if (.not. isGridValid) then
if (associated(STATE%COMPONENT_SPEC%import%OLD_VAR_SPECS)) then
call MAPL_StateCreateFromSpecNew(IMPORT,STATE%COMPONENT_SPEC%IMPORT,_RC)
end if
end if
! Initialize all needed couplers
! ---------------------------------------------------
do I=1,NC
do J=1,NC
if(STATE%CCcreated(J,I)) then
! call WRITE_PARALLEL( "DEBUG: initilaizing CPL in " // &
! trim(comp_name) // " for " // &
! trim(STATE%GCNameList(J)) // " and " // &
! trim(STATE%GCNameList(I)))
child_export_state => STATE%get_child_export_state(j)
child_import_state => STATE%get_child_import_state(i)
call ESMF_CplCompInitialize (STATE%CCS(J,I), &
importState=child_export_state, &
exportState=child_import_state, &
clock=CLOCK, userRC=userRC, _RC )
_VERIFY(userRC)
endif
enddo
! ---------------------------------------------------
enddo
endif
_RETURN(ESMF_SUCCESS)
end subroutine initialize_children_and_couplers
subroutine handle_clock_and_main_alarm(clock, unusable, rc)
type(ESMF_Clock), intent(in) :: clock
class(KeywordEnforcer), optional, intent(in) :: unusable
integer, optional, intent(out) :: rc
logical :: run_at_interval_start
STATE%CLOCK = CLOCK
call ESMF_ClockGet(CLOCK, TIMESTEP = DELT, _RC)
call ESMF_TimeIntervalGet(DELT, S=DELTSEC, _RC)
_ASSERT(DELTSEC /= 0,'needs informative message')
STATE%HEARTBEAT = DELTSEC
! We get our calling interval from the configuration,
! set the alarm, and attach it to the callers clock.
! ---------------------------------------------------
call ESMF_ClockGet(clock, calendar = cal, currTime=currTime, timestep=tstep, _RC)
call ESMF_ConfigGetAttribute( state%CF, DEFDT, Label="RUN_DT:", _RC)
DTSECS = nint(DEFDT)
! Make sure this component clock's DT is multiple of RUN_DT (heartbeat)
! It should be the same unless we have create a special clock for this
! component
_ASSERT(MOD(DELTSEC,DTSECS)==0,'needs informative message')
call MAPL_GetResource( STATE , DT, Label="DT:", default=DEFDT, _RC)
call MAPL_GetResource( STATE , run_at_interval_start, Label="RUN_AT_INTERVAL_START:", default=.false., _RC)
_ASSERT(DT /= 0.0,'needs informative message')
DTSECS = nint(DT)
! Make sure this component's DT is multiple of CLOCK's timestep
_ASSERT(MOD(DTSECS,DELTSEC)==0,'needs informative message')
call ESMF_TimeIntervalSet(TIMEINT, S=DTSECS , calendar=cal, _RC)
! get current time from clock and create a reference time with optonal override
call ESMF_TimeGet( currTime, YY = YEAR, MM = MONTH, DD = DAY, H=HH, M=MM, S=SS, rc = status )
yyyymmdd = year*10000 + month*100 + day
hhmmss = HH*10000 + MM*100 + SS
! Get Alarm reference date and time from resouce, it defaults to midnight of the current day
call MAPL_GetResource (STATE, reference_date, label='REFERENCE_DATE:', &
default=yyyymmdd, _RC )
call MAPL_GetResource (STATE, reference_time, label='REFERENCE_TIME:', &
default=0, _RC )
YEAR = reference_date/10000
MONTH = mod(reference_date,10000)/100
DAY = mod(reference_date,100)
HH = reference_time/10000
MM = mod(reference_time,10000)/100
SS = mod(reference_time,100)
call ESMF_TimeSet( ringTime, YY = YEAR, MM = MONTH, DD = DAY, &
H = HH, M = MM, S = SS, rc = status )
if (ringTime > currTime) then
ringTime = ringTime - (INT((ringTime - currTime)/TIMEINT)+1)*TIMEINT
end if
if (.not.run_at_interval_start) ringTime = ringTime-TSTEP ! we back off current time with clock's dt since
! we advance the clock AFTER run method
! make sure that ringTime is not in the past
do while (ringTime < currTime)
ringTime = ringTime + TIMEINT
end do
STATE%ALARM(0) = ESMF_AlarmCreate(CLOCK = CLOCK, &
name = trim(comp_name) // "_Alarm" , &
RingInterval = TIMEINT , &
RingTime = ringTime, &
! Enabled = .true. , &
sticky = .false. , &
RC = status )
if(ringTime == currTime) then
call ESMF_AlarmRingerOn(STATE%ALARM(0), _RC)
end if
_RETURN(ESMF_SUCCESS)
end subroutine handle_clock_and_main_alarm
subroutine handle_record(rc)
integer, optional, intent(out) :: rc
! Copy RECORD struct from parent
if (associated(STATE%parentGC)) then
call MAPL_GetObjectFromGC(STATE%parentGC, PMAPL, _RC)
if (associated(PMAPL%RECORD)) then
call MAPL_AddRecord(STATE, PMAPL%RECORD%ALARM, PMAPL%RECORD%FILETYPE, _RC)
end if
end if
! Add this component's own RECORD
call ESMF_ConfigFindLabel( STATE%CF, LABEL="RECORD_FREQUENCY:", isPresent=isPresent, _RC)
if (isPresent) then
nra = ESMF_ConfigGetLen( STATE%CF, RC = status)
_ASSERT( NRA > 0,'Empty list is not allowed')
allocate(ref_date(NRA), ref_time(NRA), freq(NRA), freq_string(NRA), stat=status)
call ESMF_ConfigFindLabel( STATE%CF, LABEL="RECORD_FREQUENCY:", _RC)
call ESMF_ConfigGetAttribute( STATE%CF, valueList=freq_string, count=NRA, _RC)
if (.not. all(freq_string == 'monthly')) then
call ESMF_ConfigFindLabel( STATE%CF, LABEL="RECORD_REF_DATE:", _RC)
! _ASSERT(NRA == ESMF_ConfigGetLen(STATE%CF),'needs informative message')
call ESMF_ConfigGetAttribute( STATE%CF, valueList=ref_date, count=NRA, _RC)
call ESMF_ConfigFindLabel( STATE%CF, LABEL="RECORD_REF_TIME:", _RC)
! _ASSERT(NRA == ESMF_ConfigGetLen(STATE%CF),'needs informative message')
call ESMF_ConfigGetAttribute( STATE%CF, valueList=ref_time, count=NRA, _RC)
end if
allocate (R_ALARM(NRA), STAT=status)
allocate (R_FILETYPE(NRA), STAT=status)
DO I = 1, NRA
write(alarmNum,'(I3.3)') I
AlarmName = "RecordAlarm" // alarmNum
call ESMF_ClockGetAlarm(clock, trim(AlarmName), recordAlarm, rc=status)
if (status/=ESMF_SUCCESS) then
monthly: if (freq_string(i) == 'monthly') then
! monthly alarm
mnthly = .true.
! This should ring on the first of each month at midnight
call ESMF_TimeSet( RefTime, YY = year, MM = month, &
DD = 1, H = 0, M = 0, S = 0, calendar=cal, _RC )
call ESMF_TimeIntervalSet( frequency, MM=1, _RC )
RingTime = RefTime
! print *,'DEBUG: creating MONTHLY record alarm'
else
mnthly = .false.
read(freq_string(i),*) freq(i)
call ESMF_TimeSet( RefTime, YY = ref_date(I)/10000, &
MM = mod(ref_date(I),10000)/100, &
DD = mod(ref_date(I),100), &
H = ref_time(I)/10000, &
M = mod(ref_time(I),10000)/100, &
S = mod(ref_time(I),100), calendar=cal, rc=status)
if (status /= 0) then
print *,'Error: ref_date/time ',ref_date(i), ref_time(i)
endif
nhms = freq(I)
sec = nhms/10000*3600 + mod(nhms,10000)/100*60 + mod(nhms,100)
call ESMF_TimeIntervalSet( frequency, S=sec, _RC )
RingTime = RefTime
if (RingTime < currTime .and. sec /= 0) then
RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency
endif
end if monthly
! create alarm
RecordAlarm = ESMF_AlarmCreate( name=trim(AlarmName), clock=clock, RingInterval=Frequency, &
RingTime=RingTime, sticky=.false.,_RC )
if(ringTime == currTime .and. .not.mnthly) then
call ESMF_AlarmRingerOn(RecordAlarm, _RC)
else
call ESMF_AlarmRingerOff(RecordAlarm, _RC)
end if
end if
R_ALARM(I) = recordAlarm
R_FILETYPE(I) = MAPL_Write2DIsk ! default
END DO
call MAPL_AddRecord(STATE, R_ALARM, R_FILETYPE, _RC)
deallocate (freq, ref_time, ref_date, freq_string)
deallocate(R_FILETYPE, R_ALARM)
endif
call MAPL_GetResource( STATE, ens_id_width, &
LABEL="ENS_ID_WIDTH:", default=0, &
_RC)
if (associated(STATE%RECORD)) then
call MAPL_GetResource( STATE, FILENAME, &
LABEL="IMPORT_CHECKPOINT_FILE:", &
rc=status)
if(status==ESMF_SUCCESS) then
STATE%RECORD%IMP_FNAME = FILENAME
STATE%RECORD%IMP_LEN = LEN_TRIM(FILENAME)
else
STATE%RECORD%IMP_LEN = 0
end if
id_string=""
tmp_label = "INTERNAL_CHECKPOINT_FILE:"
call MAPL_GetResource( STATE , FILEtpl, &
LABEL=trim(tmp_label), &
rc=status)
if((status /= ESMF_SUCCESS) .and. ens_id_width > 0) then
i = len(trim(comp_name))
id_string = comp_name(i-ens_id_width+1:i)
tmp_label =comp_name(1:i-ens_id_width)//"_"//trim(tmp_label)
call MAPL_GetResource( STATE , FILEtpl, &
LABEL=trim(tmp_label), &
rc=status)
endif
if(status==ESMF_SUCCESS) then
! if the filename is tempate
call fill_grads_template(filename,trim(adjustl(FILEtpl)),experiment_id=trim(id_string), nymd=yyyymmdd,nhms=hhmmss,_RC)
STATE%RECORD%INT_FNAME = FILENAME
STATE%RECORD%INT_LEN = LEN_TRIM(FILENAME)
else
STATE%RECORD%INT_LEN = 0
end if
end if
_RETURN(ESMF_SUCCESS)
end subroutine handle_record
subroutine create_import_and_initialize_state_variables(rc)
integer, optional, intent(out) :: rc
! Create import and initialize state variables
! --------------------------------------------
if (associated(STATE%COMPONENT_SPEC%IMPORT%OLD_VAR_SPECS) .and. isGridValid) then
is_associated = MAPL_LocStreamIsAssociated(STATE%LOCSTREAM, _RC)
if (is_associated) then
call MAPL_StateCreateFromVarSpecNew(IMPORT,STATE%COMPONENT_SPEC%IMPORT, &
MYGRID%ESMFGRID, &
TILEGRID=TILEGRID, &
_RC )
else
call MAPL_StateCreateFromVarSpecNew(IMPORT,STATE%COMPONENT_SPEC%IMPORT, &
MYGRID%ESMFGRID, &
_RC )
endif
call MAPL_GetResource( STATE , FILENAME, &
LABEL="IMPORT_RESTART_FILE:", &
RC=status)
if(status==ESMF_SUCCESS) then
call MAPL_ESMFStateReadFromFile(IMPORT, CLOCK, FILENAME, &
STATE, .FALSE., rc=status)
if (status /= ESMF_SUCCESS) then
if (MAPL_AM_I_Root(VM)) then
call ESMF_StatePrint(Import)
end if
_RETURN(ESMF_FAILURE)
end if
endif
end if
_RETURN(ESMF_SUCCESS)
end subroutine create_import_and_initialize_state_variables
subroutine create_internal_and_initialize_state_variables(rc)
integer, optional, intent(out) :: rc
! Create internal and initialize state variables
! -----------------------------------------------
internal_state => STATE%get_internal_state()
internal_state = ESMF_StateCreate(name = trim(comp_name) // "_INTERNAL", _RC)
if (associated(STATE%COMPONENT_SPEC%INTERNAL%OLD_VAR_SPECS)) then
is_associated = MAPL_LocStreamIsAssociated(STATE%LOCSTREAM, _RC)
if (is_associated) then
call MAPL_StateCreateFromVarSpecNew(internal_state,STATE%COMPONENT_SPEC%INTERNAL, &
MYGRID%ESMFGRID, &
TILEGRID=TILEGRID, &
_RC )
else
call MAPL_StateCreateFromVarSpecNew(internal_state,STATE%COMPONENT_SPEC%INTERNAL, &
MYGRID%ESMFGRID, &
_RC )
end if
call ESMF_AttributeSet(internal_state,'POSITIVE',trim(positive),_RC)
id_string = ""
tmp_label = "INTERNAL_RESTART_FILE:"
call MAPL_GetResource( STATE , FILEtpl, &
LABEL=trim(tmp_label), &
rc=status)
if((status /=ESMF_SUCCESS) .and. ens_id_width >0) then
i = len(trim(comp_name))
id_string = comp_name(i-ens_id_width+1:i)
tmp_label =comp_name(1:i-ens_id_width)//"_"//trim(tmp_label)
call MAPL_GetResource( STATE , FILEtpl, &
LABEL=trim(tmp_label), &
rc=status)
endif
if(status==ESMF_SUCCESS) then
! if the filename is tempate
call fill_grads_template(filename,trim(adjustl(FILEtpl)),experiment_id=trim(id_string), &
nymd=yyyymmdd,nhms=hhmmss,_RC)
call MAPL_GetResource( STATE , hdr, &
default=0, &
LABEL="INTERNAL_HEADER:", &
_RC)
call MAPL_ESMFStateReadFromFile(internal_state, CLOCK, FILENAME, &
STATE, hdr/=0, rc=status)
if (status /= ESMF_SUCCESS) then
if (MAPL_AM_I_Root(VM)) then
call ESMF_StatePrint(internal_state)
end if
_RETURN(ESMF_FAILURE)
end if
else
! try to coldstart the internal state
! -------------------------------
if (associated(STATE%phase_coldstart)) then
! ALT: workaround bug 3004440 in ESMF (fixed in ESMF_5_1_0)
! please, do not remove, nor change order until we move to 510 or later
allocate(GCCS%compp, stat=status)
GCCS%compp = GC%compp
call ESMF_GridCompReadRestart(GC, importState=import, &
exportState=export, clock=CLOCK, userRC=userRC, _RC)
GC%compp = GCCS%compp
deallocate(GCCS%compp)
endif
endif
end if
_RETURN(ESMF_SUCCESS)
end subroutine create_internal_and_initialize_state_variables
subroutine create_export_state_variables(rc)
integer, optional, intent(out) :: rc
logical :: restoreExport
! Create export state variables
!------------------------------
if (associated(STATE%COMPONENT_SPEC%EXPORT%OLD_VAR_SPECS)) then
is_associated = MAPL_LocStreamIsAssociated(STATE%LOCSTREAM, _RC)
if (is_associated) then
call MAPL_StateCreateFromVarSpecNew(EXPORT,STATE%COMPONENT_SPEC%EXPORT, &
MYGRID%ESMFGRID, &
TILEGRID=TILEGRID, &
DEFER=.true., _RC )
else
call MAPL_StateCreateFromVarSpecNew(EXPORT,STATE%COMPONENT_SPEC%EXPORT, &
MYGRID%ESMFGRID, &
DEFER=.true., _RC )
end if
call MAPL_GetResource(STATE, restoreExport, label='RESTORE_EXPORT_STATE:', default=.false., _RC)
if (restoreExport) then
call MAPL_GetResource( STATE, FILENAME, LABEL='EXPORT_RESTART_FILE:', _RC)
if(status==ESMF_SUCCESS) then
call MAPL_ESMFStateReadFromFile(EXPORT, CLOCK, FILENAME, &
STATE, .FALSE., rc=status)
if (status /= ESMF_SUCCESS) then
if (MAPL_AM_I_Root(VM)) then
call ESMF_StatePrint(EXPORT, _RC)
end if
_RETURN(ESMF_FAILURE)
end if
endif
end if
end if
call ESMF_AttributeSet(export,'POSITIVE',trim(positive),_RC)
_RETURN(ESMF_SUCCESS)
end subroutine create_export_state_variables
subroutine handle_services(rc)
integer, optional, intent(out) :: rc
! Service services processing:
! process any providers
if (state%provided_services%size()>0) then
call ProvidedServiceSet(state%provided_services, import, _RC)
end if
! process any requesters
if (state%requested_services%size()>0) then
call FillRequestBundle(state%requested_services, state%get_internal_state(), _RC)
end if
! process any service connections
call MAPL_ProcessServiceConnections(state, _RC)
_RETURN(ESMF_SUCCESS)
end subroutine handle_services
end subroutine MAPL_GenericInitialize