diff --git a/base/MAPL_Cap.F90 b/base/MAPL_Cap.F90 index 844ce8ccc14f..04304dac3143 100644 --- a/base/MAPL_Cap.F90 +++ b/base/MAPL_Cap.F90 @@ -44,6 +44,7 @@ module MAPL_CapMod procedure :: run_member procedure :: run_model procedure :: step_model + procedure :: rewind_model procedure :: create_member_subcommunicator procedure :: initialize_io_clients_servers @@ -416,7 +417,14 @@ subroutine step_model(this, rc) integer :: status call this%cap_gc%step(rc = status); _VERIFY(status) end subroutine step_model - + + subroutine rewind_model(this, time, rc) + class(MAPL_Cap), intent(inout) :: this + type(ESMF_Time), intent(inout) :: time + integer, intent(out) :: rc + integer :: status + call this%cap_gc%rewind_clock(time,rc = status); _VERIFY(status) + end subroutine rewind_model integer function create_member_subcommunicator(this, comm, unusable, rc) result(subcommunicator) class (MAPL_Cap), intent(in) :: this diff --git a/base/MAPL_CapGridComp.F90 b/base/MAPL_CapGridComp.F90 index da83c94cb8ca..d054b7cb0e0c 100644 --- a/base/MAPL_CapGridComp.F90 +++ b/base/MAPL_CapGridComp.F90 @@ -53,6 +53,9 @@ module MAPL_CapGridCompMod type(ESMF_VM) :: vm real(kind=real64) :: loop_start_timer type(ESMF_Time) :: cap_restart_time + type(ESMF_Alarm), allocatable :: alarm_list(:) + type(ESMF_Time), allocatable :: AlarmRingTime(:) + logical, allocatable :: ringingState(:) contains procedure :: set_services procedure :: initialize @@ -64,6 +67,10 @@ module MAPL_CapGridCompMod procedure :: get_model_duration procedure :: get_am_i_root procedure :: get_heartbeat_dt + procedure :: get_current_time + procedure :: rewind_clock + procedure :: record_state + procedure :: refresh_state end type MAPL_CapGridComp type :: MAPL_CapGridComp_Wrapper @@ -915,6 +922,18 @@ function get_heartbeat_dt(this, rc) result (heartbeatdt) end function get_heartbeat_dt + function get_current_time(this, rc) result (current_time) + class (MAPL_CapGridComp) :: this + type(ESMF_Time) :: current_time + integer, optional, intent(out) :: rc + integer :: status + call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) + _VERIFY(status) + + _RETURN(ESMF_SUCCESS) + + end function get_current_time + function get_CapGridComp_from_gc(gc) result(cap) type(ESMF_GridComp), intent(inout) :: gc @@ -1097,7 +1116,6 @@ subroutine step(this, rc) ! Advance the Clock before running History and Record ! --------------------------------------------------- - call ESMF_ClockAdvance(this%clock, rc = status) _VERIFY(STATUS) call ESMF_ClockAdvance(this%clock_hist, rc = status) @@ -1163,10 +1181,100 @@ subroutine step(this, rc) 1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & 2x,'Throughput(days/day)[Avg Tot Run]: ',f6.1,1x,f6.1,1x,f6.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & f5.1,'% : ',f5.1,'% Mem Comm:Used') - _RETURN(ESMF_SUCCESS) end subroutine step + subroutine record_state(this, rc) + class(MAPL_CapGridComp), intent(inout) :: this + integer, intent(out) :: rc + integer :: status + type(MAPL_MetaComp), pointer :: maplobj + + integer :: nalarms,i + + call MAPL_GetObjectFromGC(this%gcs(this%root_id),maplobj,rc=status) + _VERIFY(status) + call MAPL_GenericStateSave(this%gcs(this%root_id),this%child_imports(this%root_id), & + this%child_exports(this%root_id),this%clock,rc=status) + + call ESMF_ClockGet(this%clock,alarmCount=nalarms,rc=status) + _VERIFY(status) + + allocate(this%alarm_list(nalarms),this%ringingState(nalarms),this%alarmRingTime(nalarms),stat=status) + _VERIFY(status) + call ESMF_ClockGetAlarmList(this%clock, alarmListFlag=ESMF_ALARMLIST_ALL, & + alarmList=this%alarm_list, rc=status) + _VERIFY(status) + do i = 1, nalarms + call ESMF_AlarmGet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) + VERIFY_(STATUS) + end do + + _RETURN(_SUCCESS) + + end subroutine record_state + + subroutine refresh_state(this, rc) + class(MAPL_CapGridComp), intent(inout) :: this + integer, intent(out) :: rc + integer :: status + + integer :: i + call MAPL_GenericStateRestore(this%gcs(this%root_id),this%child_imports(this%root_id), & + this%child_exports(this%root_id),this%clock,rc=status) + _VERIFY(status) + DO I = 1, size(this%alarm_list) + call ESMF_AlarmSet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) + _VERIFY(STATUS) + END DO + + _RETURN(_SUCCESS) + + end subroutine refresh_state + + subroutine rewind_clock(this, time, rc) + class(MAPL_CapGridComp), intent(inout) :: this + type(ESMF_Time), intent(inout) :: time + integer, intent(out) :: rc + integer :: status + type(ESMF_Time) :: current_time,ct + + call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) + _VERIFY(status) + if (current_time > time) then + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,rc=status) + _VERIFY(status) + do + call ESMF_ClockAdvance(this%clock,rc=status) + _VERIFY(status) + call ESMF_ClockGet(this%clock,currTime=ct,rc=status) + _VERIFY(status) + if (ct==time) exit + enddo + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,rc=status) + _VERIFY(status) + end if + + call ESMF_ClockGet(this%clock_hist,currTime=current_time,rc=status) + _VERIFY(status) + if (current_time > time) then + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,rc=status) + _VERIFY(status) + do + call ESMF_ClockAdvance(this%clock_hist,rc=status) + _VERIFY(status) + call ESMF_ClockGet(this%clock_hist,currTime=ct,rc=status) + _VERIFY(status) + if (ct==time) exit + enddo + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,rc=status) + _VERIFY(status) + end if + + + _RETURN(_SUCCESS) + end subroutine rewind_clock + ! !IROUTINE: MAPL_ClockInit -- Sets the clock diff --git a/base/MAPL_CapOptions.F90 b/base/MAPL_CapOptions.F90 index 51eca157e2e5..0c6a6d0e3b7b 100644 --- a/base/MAPL_CapOptions.F90 +++ b/base/MAPL_CapOptions.F90 @@ -41,12 +41,13 @@ module MAPL_CapOptionsMod contains - function new_CapOptions(unusable, cap_rc_file, egress_file, ensemble_subdir_prefix, rc) result (cap_options) + function new_CapOptions(unusable, cap_rc_file, egress_file, ensemble_subdir_prefix, esmf_logging_mode, rc) result (cap_options) type (MAPL_CapOptions) :: cap_options class (KeywordEnforcer), optional, intent(in) :: unusable character(*), optional, intent(in) :: cap_rc_file character(*), optional, intent(in) :: egress_file character(*), optional, intent(in) :: ensemble_subdir_prefix + type(ESMF_LogKind_Flag), optional, intent(in) :: esmf_logging_mode integer, optional, intent(out) :: rc @@ -64,6 +65,7 @@ function new_CapOptions(unusable, cap_rc_file, egress_file, ensemble_subdir_pref if (present(cap_rc_file)) cap_options%cap_rc_file = cap_rc_file if (present(egress_file)) cap_options%egress_file = egress_file if (present(ensemble_subdir_prefix)) cap_options%ensemble_subdir_prefix = ensemble_subdir_prefix + if (present(esmf_logging_mode)) cap_options%esmf_logging_mode = esmf_logging_mode _RETURN(_SUCCESS) diff --git a/base/MAPL_Generic.F90 b/base/MAPL_Generic.F90 index 15b9d7bb495f..44fe7aca0128 100644 --- a/base/MAPL_Generic.F90 +++ b/base/MAPL_Generic.F90 @@ -207,6 +207,11 @@ module MAPL_GenericMod public MAPL_ESMFStateReadFromFile public MAPL_InternalStateRetrieve public :: MAPL_GetLogger + public MAPL_SetStateSave + public MAPL_GenericStateSave + public MAPL_StateSave + public MAPL_GenericStateRestore + public MAPL_StateRestore !BOP ! !PUBLIC TYPES: @@ -365,6 +370,13 @@ module MAPL_GenericMod integer :: INT_LEN end type MAPL_GenericRecordType +type MAPL_InitialState + integer :: FILETYPE = MAPL_Write2Ram + character(len=:), allocatable :: IMP_FNAME + character(len=:), allocatable :: INT_FNAME +end type MAPL_InitialState + + type MAPL_Connectivity type (MAPL_VarConn), pointer :: CONNECT(:) => null() type (MAPL_VarConn), pointer :: DONOTCONN(:) => null() @@ -417,6 +429,7 @@ module MAPL_GenericMod type (MAPL_LocStream) :: LOCSTREAM character(len=ESMF_MAXSTR) :: COMPNAME type (MAPL_GenericRecordType) , pointer :: RECORD => null() + type (MAPL_InitialState) :: initial_state type (ESMF_State) :: FORCING type (MAPL_Connectivity) :: connectList integer , pointer :: phase_init (:) => null() @@ -5424,7 +5437,7 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) nwrgt1 = (mpl%grid%num_readers > 1) - + if(INDEX(FNAME,'*') == 0) then if (AmIRoot) then block @@ -9766,6 +9779,318 @@ integer function MAPL_AddMethod(PHASE, RC) _RETURN(ESMF_SUCCESS) end function MAPL_AddMethod + + recursive subroutine MAPL_SetStateSave(state,filetype,rc) + type(MAPL_MetaComp), intent(inout) :: state + integer, intent(in ) :: filetype + integer, optional, intent(out) :: rc + type(MAPL_MetaComp), pointer :: CMAPL => null() + integer :: k, status + + if (associated(state%gcs)) then + do k=1,size(state%GCS) + call MAPL_GetObjectFromGC ( state%GCS(K), CMAPL, RC=STATUS) + _VERIFY(STATUS) + call MAPL_SetStateSave(CMAPL,filetype,RC=STATUS) + _VERIFY(STATUS) + enddo + end if + + state%initial_state%filetype = filetype + + end subroutine MAPL_SetStateSave + + recursive subroutine MAPL_GenericStateSave( GC, IMPORT, EXPORT, CLOCK, RC ) + type(ESMF_GridComp), intent(inout) :: GC ! composite 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: + + type(mapl_metacomp), pointer :: state + integer :: i,filetype + + character(len=14) :: datestamp + character(len=1) :: separator + + character(len=ESMF_MAXSTR) :: filetypechar + character(len=4) :: extension + integer :: hdr + integer :: status + character(len=:), allocatable :: tmpstr + character(len=ESMF_MAXSTR) :: filename + + call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_GetResource( STATE, FILENAME, & + LABEL="IMPORT_CHECKPOINT_FILE:", & + RC=STATUS) + if(STATUS==ESMF_SUCCESS) then + _ASSERT(.not.allocated(state%initial_state%imp_fname),"can only save one state") + STATE%initial_state%IMP_FNAME = FILENAME + end if + call MAPL_GetResource( STATE , filename, & + LABEL="INTERNAL_CHECKPOINT_FILE:", & + RC=STATUS) + if(STATUS==ESMF_SUCCESS) then + _ASSERT(.not.allocated(state%initial_state%int_fname),"can only save one state") + STATE%initial_state%INT_FNAME = FILENAME + end if + + if(associated(STATE%GCS)) then + do I=1,size(STATE%GCS) + call MAPL_GenericStateSave (STATE%GCS(I), & + STATE%GIM(I), & + STATE%GEX(I), & + CLOCK, RC=STATUS ) + _VERIFY(status) + enddo + endif + + call MAPL_DateStampGet(clock, datestamp, rc=status) + _VERIFY(STATUS) + filetype=state%initial_state%filetype + if (FILETYPE /= MAPL_Write2Disk) then + separator = '*' + else + separator = '.' + end if + + if (allocated(state%initial_state%imp_fname)) then + call MAPL_GetResource( STATE, filetypechar, LABEL="IMPORT_CHECKPOINT_TYPE:", RC=STATUS ) + if ( STATUS/=ESMF_SUCCESS .or. filetypechar == "default" ) then + call MAPL_GetResource( STATE, filetypechar, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=STATUS ) + _VERIFY(STATUS) + end if + filetypechar = ESMF_UtilStringLowerCase(filetypechar,rc=STATUS) + _VERIFY(STATUS) + if (filetypechar == 'pnc4') then + extension = '.nc4' + else + extension = '.bin' + end if + tmpstr=trim(state%initial_state%imp_fname) + deallocate(state%initial_state%imp_fname) + STATE%initial_state%IMP_FNAME = tmpstr // separator // DATESTAMP // extension + deallocate(tmpstr) + end if + + if (allocated(state%initial_state%int_fname)) then + call MAPL_GetResource( STATE, hdr, LABEL="INTERNAL_HEADER:", default=0, RC=STATUS ) + _VERIFY(STATUS) + call MAPL_GetResource( STATE, filetypechar, LABEL="INTERNAL_CHECKPOINT_TYPE:", RC=STATUS ) + if ( STATUS/=ESMF_SUCCESS .or. filetypechar == "default" ) then + call MAPL_GetResource( STATE, filetypechar, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=STATUS ) + _VERIFY(STATUS) + end if + filetypechar = ESMF_UtilStringLowerCase(filetypechar,rc=STATUS) + _VERIFY(STATUS) + if (filetypechar == 'pnc4') then + extension = '.nc4' + else + extension = '.bin' + end if + tmpstr=trim(state%initial_state%int_fname) + deallocate(state%initial_state%int_fname) + STATE%initial_state%INT_FNAME = tmpstr // separator // DATESTAMP // extension + deallocate(tmpstr) + end if + + ! call the actual record method + call MAPL_StateSave (GC, IMPORT, EXPORT, CLOCK, RC=STATUS ) + _VERIFY(STATUS) + _RETURN(_SUCCESS) + + end subroutine MAPL_GenericStateSave + +subroutine MAPL_StateSave( GC, IMPORT, EXPORT, CLOCK, RC ) + + type(ESMF_GridComp), intent(inout) :: GC ! composite 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: + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + type (MAPL_MetaComp), pointer :: STATE + integer :: hdr + character(len=ESMF_MAXSTR) :: FILETYPE + + _UNUSED_DUMMY(EXPORT) + + Iam = "MAPL_StateSave" + call ESMF_GridCompGet(GC, name=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // Iam + + call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) + _VERIFY(STATUS) + + if (allocated(state%initial_state%imp_fname)) then + call MAPL_GetResource( STATE, FILETYPE, LABEL="IMPORT_CHECKPOINT_TYPE:", RC=STATUS ) + if ( STATUS/=ESMF_SUCCESS .or. FILETYPE == "default" ) then + call MAPL_GetResource( STATE, FILETYPE, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=STATUS ) + _VERIFY(STATUS) + end if + call MAPL_ESMFStateWriteToFile(IMPORT, CLOCK, & + STATE%initial_state%IMP_FNAME, & + FILETYPE, STATE, .FALSE., oClients = o_Clients, & + RC=STATUS) + _VERIFY(STATUS) + end if + + if (allocated(state%initial_state%int_fname)) then + call MAPL_GetResource( STATE, hdr, LABEL="INTERNAL_HEADER:", default=0, RC=STATUS ) + _VERIFY(STATUS) + call MAPL_GetResource( STATE, FILETYPE, LABEL="INTERNAL_CHECKPOINT_TYPE:", RC=STATUS ) + if ( STATUS/=ESMF_SUCCESS .or. FILETYPE == "default" ) then + call MAPL_GetResource( STATE, FILETYPE, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=STATUS ) + _VERIFY(STATUS) + end if + call MAPL_ESMFStateWriteToFile(STATE%INTERNAL, CLOCK, & + STATE%initial_state%INT_FNAME, & + FILETYPE, STATE, hdr/=0, oClients = o_Clients, & + RC=STATUS) + _VERIFY(STATUS) + end if + + _RETURN(ESMF_SUCCESS) +end subroutine MAPL_StateSave + + + recursive subroutine MAPL_GenericStateRestore ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! composite 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: + ! = 0 all is well + ! otherwise, error +!EOPI + +! LOCAL VARIABLES + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + character(len=ESMF_MAXSTR) :: CHILD_NAME + integer :: STATUS + integer :: I + type (MAPL_MetaComp), pointer :: STATE + character(len=ESMF_MAXSTR) :: filetypechar + character(len=4) :: extension + class(BaseProfiler), pointer :: t_p +!============================================================================= + +! Begin... + + Iam = "MAPL_GenericStateRestore" + call ESMF_GridCompGet(GC, name=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +!---------------------------------- + + call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_GenericStateClockOn(STATE,"TOTAL") +! Refresh the children +! --------------------- + if(associated(STATE%GCS)) then + do I=1,size(STATE%GCS) + call ESMF_GridCompGet( STATE%GCS(I), NAME=CHILD_NAME, RC=STATUS ) + _VERIFY(STATUS) + call MAPL_GenericStateRestore (STATE%GCS(I), STATE%GIM(I), STATE%GEX(I), CLOCK, & + RC=STATUS ) + _VERIFY(STATUS) + enddo + endif +! Do my "own" refresh +! ------------------ + call MAPL_GenericStateClockOn(STATE,"--GenRefreshMine") + + call MAPL_StateRestore (GC, IMPORT, EXPORT, CLOCK, RC=STATUS ) + _VERIFY(STATUS) + + _RETURN(ESMF_SUCCESS) +end subroutine MAPL_GenericStateRestore + +subroutine MAPL_StateRestore( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! composite 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: + ! = 0 all is well + ! otherwise, error +!EOPI + +! LOCAL VARIABLES + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + type (MAPL_MetaComp), pointer :: STATE + integer :: hdr, unit + _UNUSED_DUMMY(EXPORT) + +! Begin... + + Iam = "MAPL_StateRefresh" + call ESMF_GridCompGet(GC, name=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // Iam + + +! Retrieve the pointer to the state +!---------------------------------- + + call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) + _VERIFY(STATUS) + + + if (allocated(STATE%initial_state%imp_fname)) then + call MAPL_ESMFStateReadFromFile(IMPORT, CLOCK, & + STATE%initial_state%IMP_FNAME, & + STATE, .FALSE., RC=STATUS) + _VERIFY(STATUS) + UNIT = GETFILE(STATE%initial_state%IMP_FNAME, RC=STATUS) + _VERIFY(STATUS) + call MAPL_DestroyFile(unit = UNIT, rc=STATUS) + _VERIFY(STATUS) + end if + + if (allocated(state%initial_state%int_fname)) then + call MAPL_GetResource( STATE , hdr, & + default=0, & + LABEL="INTERNAL_HEADER:", & + RC=STATUS) + _VERIFY(STATUS) + call MAPL_ESMFStateReadFromFile(STATE%INTERNAL, CLOCK, & + STATE%initial_state%INT_FNAME, & + STATE, hdr/=0, RC=STATUS) + _VERIFY(STATUS) + UNIT = GETFILE(STATE%initial_state%INT_FNAME, RC=STATUS) + _VERIFY(STATUS) + call MAPL_DestroyFile(unit = UNIT, rc=STATUS) + _VERIFY(STATUS) + end if + + _RETURN(ESMF_SUCCESS) +end subroutine MAPL_StateRestore + subroutine MAPL_AddRecord(MAPLOBJ, ALARM, FILETYPE, RC) type(MAPL_MetaComp), intent(inout) :: MAPLOBJ type(ESMF_Alarm), intent(INout) :: ALARM(:)