diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b693509a9c9..5422be7b67d4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,8 +9,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed issues with alarms when clocks are run in reverse. + ### Added +- Added option to run in reverse + ### Changed ### Removed diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 7c67794be568..e4a6b300b4f5 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -177,7 +177,9 @@ module MAPL_GenericMod public MAPL_RequestService ! MAPL_Util - !public MAPL_GenericStateClockAdd + public MAPL_GenericStateClockOn + public MAPL_GenericStateClockOff + public MAPL_GenericStateClockAdd public MAPL_TimerOn public MAPL_TimerOff public MAPL_TimerAdd diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 5ae46fe1fd4e..e917145b5d3d 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -78,6 +78,7 @@ module MAPL_CapGridCompMod procedure :: initialize_history procedure :: run procedure :: step + procedure :: step_reverse procedure :: finalize procedure :: get_model_duration procedure :: get_am_i_root @@ -210,6 +211,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) character(len=ESMF_MAXSTR ) :: DYCORE character(len=ESMF_MAXPATHLEN) :: user_dirpath,tempString logical :: tend,foundPath + integer :: reverseTime logical :: cap_clock_is_present @@ -530,6 +532,16 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call ESMF_ConfigGetAttribute(cap%cf_root, value=ReplayMode, Label="REPLAY_MODE:", default="NoReplay", rc=status) _VERIFY(STATUS) + ! pass REVERSE_TIME resource to history and root config + call MAPL_GetResource(MAPLOBJ, reverseTime, "REVERSE_TIME:", default = 0, rc = status) + _VERIFY(status) + + call MAPL_ConfigSetAttribute(cap%cf_root, value=reverseTime, Label="REVERSE_TIME:", rc=status) + _VERIFY(STATUS) + + call MAPL_ConfigSetAttribute(cap%cf_hist, value=reverseTime, Label="REVERSE_TIME:", rc=status) + _VERIFY(STATUS) + ! Register the children with MAPL !-------------------------------- @@ -1113,6 +1125,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) integer, optional, intent(in) :: phase integer, optional, intent(out) :: rc + integer :: reverse_time integer :: n, status, phase_ logical :: done @@ -1120,6 +1133,18 @@ subroutine run_MAPL_GridComp(gc, phase, rc) type (MAPL_MetaComp), pointer :: MAPLOBJ procedure(), pointer :: root_set_services + + ! instantiate Alarm lists + ! type(ESMF_Alarm) :: alarm(200), hist_alarm(400) + + ! local variables for Get methods + integer :: ringingAlarmCount ! at any time step (0 to NUMALARMS) + integer :: alarmCount, hist_alarmCount + + ! name, loop counter, result code + character (len=ESMF_MAXSTR) :: name + integer :: i, result + cap => get_CapGridComp_from_gc(gc) call MAPL_GetObjectFromGC(gc, maplobj, rc=status) _VERIFY(status) @@ -1129,6 +1154,73 @@ subroutine run_MAPL_GridComp(gc, phase, rc) if (.not. cap%printspec > 0) then + ! Check if user wants to reverse time + call MAPL_Set(MAPLOBJ, name = cap%name, cf = cap%config, rc = status) + _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, reverse_time, label='REVERSE_TIME:', & + default=0, rc = status) + _VERIFY(STATUS) + + if ( reverse_time == 1 ) then + ! call ESMF_ClockGetAlarmList(cap%clock, ESMF_ALARMLIST_ALL, & + ! alarmList=alarm, alarmCount=alarmCount, rc = status ) + ! _VERIFY(STATUS) + + ! call ESMF_ClockGetAlarmList(cap%clock_hist, ESMF_ALARMLIST_ALL, & + ! alarmList=hist_alarm, alarmCount=hist_alarmCount, rc = status ) + ! _VERIFY(STATUS) + + if (MAPL_Am_I_Root()) THEN + + ! WRITE(*,1003) 'clock', alarmCount + + ! WRITE(*,1003) 'clock_hist', hist_alarmCount + + WRITE(*,1001) cap%nsteps + endif +1001 FORMAT(' MAPL_CapGC running for ', i3, ' timesteps') +1003 FORMAT(3x, a10, ' has ', i3, ' alarms') + + FAKE_TIME_LOOP: do n = 1, cap%nsteps + + if (MAPL_Am_I_Root()) & + WRITE(*,1002) n, cap%nsteps +1002 FORMAT(' MAPL_CapGC running step ', i3, ' of ', i3) + + if (.not.cap%lperp) then + done = ESMF_ClockIsDone(cap%clock_hist, rc = status) + _VERIFY(status) + if (done .and. MAPL_Am_I_Root()) & + WRITE(*,*) ' MAPL_CapGC: No perpetual clock and history is done. Exiting loop' + if (done) exit + endif + ! Advance the Clock before running History and Record + ! --------------------------------------------------- + call ESMF_ClockAdvance(cap%clock, rc = status) + _VERIFY(STATUS) + call ESMF_ClockAdvance(cap%clock_hist, rc = status) + _VERIFY(STATUS) + + ! Update Perpetual Clock + ! ---------------------- + + if (cap%lperp) then + call Perpetual_Clock(cap, status) + _VERIFY(status) + end if + enddo FAKE_TIME_LOOP + + if (MAPL_Am_I_Root()) & + WRITE(*,*) ' MAPL_CapGC finished time loop, reversing clocks' + ! Reverse the direction of the clocks + call ESMF_ClockSet( cap%clock, direction=ESMF_DIRECTION_REVERSE, & + advanceCount=0, rc=status ) + call ESMF_ClockSet( cap%clock_hist, direction=ESMF_DIRECTION_REVERSE, & + advanceCount=0, rc=status ) + cap%nsteps = cap%nsteps + 1 + endif ! reverse_time == 1 + + ! Time Loop starts by checking for Segment Ending Time !----------------------------------------------------- if (cap%compute_throughput) then @@ -1148,12 +1240,29 @@ subroutine run_MAPL_GridComp(gc, phase, rc) _VERIFY(status) if (.not.cap%lperp) then - done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) + if ( reverse_time == 0 ) then + done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) + else + done = ESMF_ClockIsDone(cap%clock_hist, rc = status) + endif _VERIFY(status) + if (MAPL_Am_I_Root() .and. done) THEN + call ESMF_ClockPrint(cap%clock_hist, options='currTime string', rc = status) + _VERIFY(status) + call ESMF_ClockPrint(cap%clock_hist, options='stopTime string', rc = status) + _VERIFY(status) + call ESMF_ClockPrint(cap%clock_hist, options='direction', rc = status) + _VERIFY(status) + endif if (done) exit endif - call cap%step(phase=phase_, rc=status) + if ( .not. reverse_time ) then + call cap%step(phase=phase_, rc=status) + else + call cap%step_reverse(phase=phase_, n .eq. 1, rc=status) + endif + _VERIFY(status) ! Reset loop average timer to get a better @@ -1569,6 +1678,222 @@ subroutine rewind_clock(this, time, rc) _RETURN(_SUCCESS) end subroutine rewind_clock + subroutine step_reverse(this, unusable, phase, first, rc) + class(MAPL_CapGridComp), intent(inout) :: this + class(KeywordEnforcer), optional, intent(in ) :: unusable + integer, optional, intent(it) :: phase + logical, intent(in) :: first + integer, intent(out) :: rc + + integer :: status, phase_ + + + type(ESMF_Time) :: currTime + + _UNUSED_DUMMY(unusable) + phase_ = 1 + if (present(phase)) phase_ = phase + + call ESMF_GridCompGet(this%gc, vm = this%vm) + ! Run the ExtData Component + ! -------------------------- + if (phase_ == 1) then + call first_phase(first, rc=status) + _VERIFY(status) + + endif ! phase_ == 1 + + + ! Run the Gridded Component + ! -------------------------- + call ESMF_GridCompRun(this%gcs(this%root_id), importstate = this%child_imports(this%root_id), & + exportstate = this%child_exports(this%root_id), & + clock = this%clock, userrc = status) + _VERIFY(status) + + ! Synchronize for Next TimeStep + ! ----------------------------- + + call ESMF_VMBarrier(this%vm, rc = status) + _VERIFY(STATUS) + + ! Call History Run for Output + ! --------------------------- + + call ESMF_GridCompRun(this%gcs(this%history_id), importstate=this%child_imports(this%history_id), & + exportstate = this%child_exports(this%history_id), & + clock = this%clock_hist, userrc = status) + _VERIFY(status) + + ! Advance the Clock and run History and Record + ! --------------------------------------------------- + if (phase_ == this%n_run_phases) then + + call last_phase(rc=status) + _VERIFY(STATUS) + + endif !phase_ == last + + _RETURN(ESMF_SUCCESS) + + contains + + subroutine first_phase(first, rc) + logical, intent(in) :: first + integer, optional, intent(out) :: rc + + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_H, AGCM_M, AGCM_S + + if (this%compute_throughput) then + if (.not.this%started_loop_timer) then + this%starts%loop_start_timer = MPI_WTime(status) + this%started_loop_timer=.true. + end if + this%starts%start_timer = MPI_Wtime(status) + end if + + call ESMF_GridCompRun(this%gcs(this%extdata_id), importState = this%child_imports(this%extdata_id), & + exportState = this%child_exports(this%extdata_id), & + clock = this%clock, userrc = status) + _VERIFY(status) + + ! Call Record for intermediate checkpoint (if desired) + ! Note that we are not doing a Record for History. + ! ------------------------------------------------------ + ! don't output reverse checkpoints + ! call ESMF_GridCompWriteRestart(this%gcs(this%root_id), importstate = this%child_imports(this%root_id), & + ! exportstate = this%child_exports(this%root_id), & + ! clock = this%clock_hist, userrc = status) + ! _VERIFY(status) + + ! Advance the Clock before running History and Record + ! --------------------------------------------------- + if (.not. first) THEN + call ESMF_ClockAdvance(this%clock, rc = status) + _VERIFY(STATUS) + call ESMF_ClockAdvance(this%clock_hist, rc = status) + _VERIFY(STATUS) + + ! Update Perpetual Clock + ! ---------------------- + + if (this%lperp) then + call Perpetual_Clock(this, status) + _VERIFY(status) + end if + end if + + if (this%compute_throughput) then + call ESMF_VMBarrier(this%vm,rc=status) + _VERIFY(status) + this%starts%start_run_timer = MPI_WTime(status) + end if + + + call ESMF_ClockGet(this%clock, CurrTime = currTime, rc = status) + _VERIFY(status) + call ESMF_TimeGet(CurrTime, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_H , & + M = AGCM_M , & + S = AGCM_S, rc=status) + _VERIFY(status) + if (this%AmIRoot) write(6,1000) AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S +1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2) + + + _RETURN(_SUCCESS) + + end subroutine + + subroutine last_phase(rc) + integer, optional, intent(out) :: rc + integer :: status + + if (this%compute_throughput) then + call ESMF_VMBarrier(this%vm,rc=status) + _VERIFY(status) + end_run_timer = MPI_WTime(status) + end if + + call ESMF_GridCompRun(this%gcs(this%history_id), importstate=this%child_imports(this%history_id), & + exportstate = this%child_exports(this%history_id), & + clock = this%clock_hist, userrc = status) + _VERIFY(status) + ! Estimate throughput times + ! --------------------------- + if (this%compute_throughput) then + call print_throughput(rc=status) + _VERIFY(STATUS) + end if + + _RETURN(_SUCCESS) + + end subroutine + + subroutine print_throughput(rc) + integer, optional, intent(out) :: rc + integer :: status, n + + real(kind=REAL64) :: TIME_REMAINING + real(kind=REAL64) :: LOOP_THROUGHPUT + real(kind=REAL64) :: INST_THROUGHPUT + real(kind=REAL64) :: RUN_THROUGHPUT + real :: mem_total, mem_commit, mem_committed_percent + real :: mem_used, mem_used_percent + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: delt + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_H, AGCM_M, AGCM_S + integer :: HRS_R, MIN_R, SEC_R + + + call ESMF_ClockGet(this%clock, CurrTime = currTime, rc = status) + _VERIFY(status) + call ESMF_TimeGet(CurrTime, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_H , & + M = AGCM_M , & + S = AGCM_S, rc=status) + _VERIFY(status) + delt=currTime-this%cap_restart_time + ! Call system clock to estimate throughput simulated Days/Day + call ESMF_VMBarrier( this%vm, RC=STATUS ) + _VERIFY(STATUS) + END_TIMER = MPI_Wtime(status) + n=this%get_step_counter() + !GridCompRun Timer [Inst] + RUN_THROUGHPUT = REAL( this%HEARTBEAT_DT,kind=REAL64)/(END_RUN_TIMER-this%starts%start_run_timer) + ! Time loop throughput [Inst] + INST_THROUGHPUT = REAL( this%HEARTBEAT_DT,kind=REAL64)/(END_TIMER-this%starts%start_timer) + ! Time loop throughput [Avg] + LOOP_THROUGHPUT = REAL(n*this%HEARTBEAT_DT,kind=REAL64)/(END_TIMER-this%starts%loop_start_timer) + ! Estimate time remaining (seconds) + TIME_REMAINING = REAL((this%nsteps-n)*this%HEARTBEAT_DT,kind=REAL64)/LOOP_THROUGHPUT + HRS_R = FLOOR(TIME_REMAINING/3600.0) + MIN_R = FLOOR(TIME_REMAINING/60.0 - 60.0*HRS_R) + SEC_R = FLOOR(TIME_REMAINING - 3600.0*HRS_R - 60.0*MIN_R) + ! Reset Inst timer + this%starts%start_timer = END_TIMER + ! Get percent of used memory + call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, RC=STATUS ) + _VERIFY(STATUS) + ! Get percent of committed memory + call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, RC=STATUS ) + _VERIFY(STATUS) + + if( mapl_am_I_Root(this%vm) ) write(6,1000) + LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& + mem_committed_percent,mem_used_percent + 1000 format(2x,'Throughput(days/day)[Avg Tot Run]: ',f8.1,1x,f8.1,1x,f8.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & + f5.1,'% : ',f5.1,'% Mem Comm:Used') + + _RETURN(_SUCCESS) + + end subroutine + + end subroutine step_reverse ! !IROUTINE: MAPL_ClockInit -- Sets the clock diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 034738b8e97b..0f9d40481848 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -276,6 +276,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(ESMF_State), pointer :: exptmp (:) type(ESMF_State) :: expsrc, expdst type(ESMF_Time) :: StartTime + type(ESMF_Time) :: EndTime type(ESMF_Time) :: CurrTime type(ESMF_Time) :: RingTime type(ESMF_Time) :: RefTime @@ -283,6 +284,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(ESMF_Time) :: nextMonth type(ESMF_TimeInterval) :: oneMonth, dur type(ESMF_TimeInterval) :: Frequency + type(ESMF_TimeInterval) :: OneSecond type(ESMF_Array) :: array type(ESMF_Field) :: field type(ESMF_Field) :: f @@ -428,6 +430,16 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) logical :: has_conservative_keyword, has_regrid_keyword integer :: create_mode + +! debug variables + type(ESMF_Time) :: debugTime + type(ESMF_TimeInterval) :: timeStep + character(len=ESMF_MAXSTR) :: TimeString + logical :: ringing + integer :: alarmCount +! adjoint variable + integer :: reverseTime + ! Begin !------ @@ -464,6 +476,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ClockGet ( clock, calendar=cal, rc=STATUS ) ; _VERIFY(STATUS) call ESMF_ClockGet ( clock, currTime=CurrTime, rc=STATUS ) ; _VERIFY(STATUS) call ESMF_ClockGet ( clock, StartTime=StartTime,rc=STATUS ) ; _VERIFY(STATUS) + call ESMF_ClockGet ( clock, stopTime=EndTime, rc=STATUS ) ; _VERIFY(STATUS) call ESMF_TimeGet ( StartTime, TimeString=string ,rc=STATUS ) ; _VERIFY(STATUS) read(string( 1: 4),'(i4.4)') year @@ -564,6 +577,13 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=intstate%version, & label='VERSION:', default=0, rc=status) _VERIFY(STATUS) + + ! Are we running the adjoint? + call ESMF_ConfigGetAttribute(config, reverseTime, & + Label="REVERSE_TIME:" , & + Default=0, RC=STATUS) + _VERIFY(STATUS) + if( MAPL_AM_I_ROOT() ) then print * print *, 'EXPSRC:',trim(INTSTATE%expsrc) @@ -571,6 +591,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) print *, 'Descr: ',trim(INTSTATE%expdsc) print *, 'DisableSubVmChecks:', disableSubVmChecks print * + if (reverseTime .eq. 1) THEN + print *, 'REVERSE_TIME = "', reverseTime, '"' + endif endif ! Determine Number of Output Streams @@ -828,9 +851,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute ( cfg, list(n)%ref_date, default=nymdc, & label=trim(string) // 'ref_date:',rc=status ) _VERIFY(STATUS) - _ASSERT(is_valid_date(list(n)%ref_date),'Invalid ref_date') call ESMF_ConfigGetAttribute ( cfg, list(n)%ref_time, default=000000, & label=trim(string) // 'ref_time:',rc=status ) + _VERIFY(STATUS) _ASSERT(is_valid_time(list(n)%ref_time),'Invalid ref_time') @@ -915,7 +938,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%ref_time < 0 .OR. & list(n)%duration < 0 ) list(n)%disabled = .true. - old_fields_style = .true. ! unless if (intstate%version >= 2) then call ESMF_ConfigGetAttribute ( cfg, value=field_set_name, label=trim(string)//'field_set:', & @@ -1228,6 +1250,15 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (list(n)%disabled) cycle + ! if(list(n)%mode == "instantaneous" .or. list(n)%ForceOffsetZero) then + ! sec = 0 + ! else + ! IntState%average(n) = .true. + ! sec = MAPL_nsecf(list(n)%acc_interval) / 2 + ! endif + ! call ESMF_TimeIntervalSet( INTSTATE%STAMPOFFSET(n), S=sec, rc=status ) + ! _VERIFY(STATUS) + ! His and Seg Alarms based on Reference Date and Time ! --------------------------------------------------- REF_TIME(1) = list(n)%ref_date/10000 @@ -1269,19 +1300,86 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! Added Logic to eliminate BEG_DATE = cap_restart date problem ! ------------------------------------------------------------ if (RefTime == startTime) then - RingTime = RefTime + Frequency + if (list(n)%backwards) then + RingTime = RefTime + else + RingTime = RefTime + Frequency + endif end if ! if (RingTime < currTime .and. sec /= 0 ) then - RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency + if (list(n)%backwards) then + RingTime = RingTime - (INT((currTime - RingTime)/frequency)+1)*frequency + else + RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency + endif + endif + if(.true. .and. MAPL_AM_I_ROOT() ) then + write(6,*) "Setting history alarm for species ", n + + call ESMF_TimeGet ( RingTime, timeString=tmpstring, rc=status ) ; _VERIFY(STATUS) + + read(tmpstring( 1: 4),'(i4.4)') year + read(tmpstring( 6: 7),'(i2.2)') month + read(tmpstring( 9:10),'(i2.2)') day + read(tmpstring(12:13),'(i2.2)') hour + read(tmpstring(15:16),'(i2.2)') minute + write(6,'(1X,"RingTime: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " backwards:",L1)') & + year, month, day, hour, minute, list(n)%backwards + + call ESMF_ClockGet(clock, currtime=debugtime, timeStep=timestep,rc=status) ; _VERIFY(STATUS) + call ESMF_TimeIntervalGet ( timestep, h=hour,m=minute, rc=status ) ; _VERIFY(STATUS) + + if (hour < 0 .or. minute < 0) then + write(6,'("Clock Timestep = -", i2.2, ":", i2.2)') hour, abs(minute) + else + write(6,'("Clock Timestep = ", i2.2, ":", i2.2)') hour, abs(minute) + end if + call ESMF_TimeGet ( DebugTime, timeString=tmpstring, rc=status ) ; _VERIFY(STATUS) + + read(tmpstring( 1: 4),'(i4.4)') year + read(tmpstring( 6: 7),'(i2.2)') month + read(tmpstring( 9:10),'(i2.2)') day + read(tmpstring(12:13),'(i2.2)') hour + read(tmpstring(15:16),'(i2.2)') minute + write(6,'(1X,"Current Time: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " backwards:",L1)') & + year, month, day, hour, minute, list(n)%backwards endif if ( list(n)%backwards ) then - list(n)%his_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, rc=status ) + list(n)%his_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) else list(n)%his_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) endif _VERIFY(STATUS) + call ESMF_ClockGetAlarmList(clock, ESMF_ALARMLIST_ALL, & + alarmCount=alarmCount, rc = status ) + _VERIFY(STATUS) + ! WRITE(6,'(" History Clock now has ", i3, " alarms.")') alarmCount + + ! I don't understand what's going on here. For some reason when I create the alarm when the clock is running + ! with a negative timestep, it immediately rings, even though it's an hour in the past... + ! if (ESMF_AlarmIsRinging(list(n)%his_alarm)) THEN + ! call ESMF_AlarmSet(list(n)%his_alarm, RingTime=RingTime, ringing=.false., rc=status); _VERIFY(STATUS) + ! endif + if(.false. .and. MAPL_AM_I_ROOT() ) then + call ESMF_AlarmGet(list(n)%his_alarm, RingTime=DebugTime, ringing=ringing, rc=STATUS); _VERIFY(STATUS) + call ESMF_TimeGet ( DebugTime, timeString=TimeString, rc=status ) ; _VERIFY(STATUS) + + read(timestring( 1: 4),'(i4.4)') year + read(timestring( 6: 7),'(i2.2)') month + read(timestring( 9:10),'(i2.2)') day + read(timestring(12:13),'(i2.2)') hour + read(timestring(15:16),'(i2.2)') minute + write(6,'(1X,"Alarm ", i3, " Ring Time: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " ringing: ", L1)') & + n, year, month, day, hour, minute, ringing + endif + + + !ALT if monthly overwrite duration and frequency + if (list(n)%monthly) then + list(n)%duration = 1 !ALT simply non-zero + end if if( list(n)%duration.ne.0 ) then if (.not.list(n)%monthly) then sec = MAPL_nsecf( list(n)%duration ) @@ -1292,16 +1390,17 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! and for debugging print call WRITE_PARALLEL("DEBUG: monthly averaging is active for collection "//trim(list(n)%collection)) end if + ! RingTime = RefTime + IntState%StampOffset(n) RingTime = RefTime if (RingTime < currTime) then RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency endif - if ( list(n)%backwards ) then - list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, rc=status ) - else - list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) - endif + list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) _VERIFY(STATUS) + call ESMF_ClockGetAlarmList(clock, ESMF_ALARMLIST_ALL, & + alarmCount=alarmCount, rc = status ) + _VERIFY(STATUS) + ! WRITE(6,'(" History Clock now has ", i3, " alarms.")') alarmCount if (list(n)%monthly .and. (currTime == RingTime)) then call ESMF_AlarmRingerOn( list(n)%his_alarm,rc=status ) _VERIFY(STATUS) @@ -1312,6 +1411,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, enabled=.false., & ringTime=currTime, name='historyNewSegment', rc=status ) _VERIFY(STATUS) + call ESMF_ClockGetAlarmList(clock, ESMF_ALARMLIST_ALL, & + alarmCount=alarmCount, rc = status ) + _VERIFY(STATUS) + ! WRITE(6,'(" History Clock now has ", i3, " alarms.")') alarmCount endif ! Mon Alarm based on 1st of Month 00Z @@ -1335,11 +1438,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) do while ( RingTime < currTime ) RingTime = RingTime + Frequency enddo - if ( list(n)%backwards ) then - list(n)%mon_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, rc=status ) - else - list(n)%mon_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) - endif + list(n)%mon_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) _VERIFY(STATUS) if(list(n)%monthly) then !ALT this is temporary workaround. It has a memory leak @@ -1349,6 +1448,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%his_alarm = list(n)%mon_alarm intState%stampOffset(n) = Frequency ! we go to the beginning of the month end if + call ESMF_ClockGetAlarmList(clock, ESMF_ALARMLIST_ALL, & + alarmCount=alarmCount, rc = status ) + _VERIFY(STATUS) + ! WRITE(6,'(" History Clock now has ", i3, " alarms.")') alarmCount ! End Alarm based on end_date and end_time ! ---------------------------------------- @@ -1367,19 +1470,27 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) M = REF_TIME(5), & S = REF_TIME(6), calendar=cal, rc=rc ) - if ( list(n)%backwards ) then - list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=RingTime, rc=status ) - else - list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=RingTime, sticky=.false., rc=status ) - endif + list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=RingTime, sticky=.false., rc=status ) _VERIFY(STATUS) else - if ( list(n)%backwards ) then - list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=CurrTime, rc=status ) + if (reverseTime .eq. 1) then + if (MAPL_Am_I_Root()) & + WRITE(*,*) ' Setting end_alarm to disabled!' + call ESMF_TimeIntervalSet( OneSecond, S = 1, rc=rc ) + ringTime = startTime - oneSecond + list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=ringTime, sticky=.false., enabled=.false., rc=status ) else - list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=CurrTime, sticky=.false., rc=status ) + call ESMF_TimeIntervalSet( OneSecond, S = 1, rc=rc ) + ringTime = endTime + oneSecond + list(n)%end_alarm = ESMF_AlarmCreate( clock=clock, RingTime=ringTime, sticky=.false., rc=status ) endif + + _VERIFY(STATUS) + call ESMF_ClockGetAlarmList(clock, ESMF_ALARMLIST_ALL, & + alarmCount=alarmCount, rc = status ) _VERIFY(STATUS) + ! WRITE(6,'(" History Clock now has ", i3, " alarms.")') alarmCount + call ESMF_AlarmRingerOff(list(n)%end_alarm, rc=status ) _VERIFY(STATUS) endif @@ -2251,6 +2362,13 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (allocated(ungridded_coord)) deallocate(ungridded_coord) else + + if (.false. .and. MAPL_AM_I_ROOT()) THEN + WRITE(*,*) 'REFRESH = ', REFRESH, ' AVGINT = ', AVGINT + WRITE(*,*) 'acc_int = ', MAPL_nsecf(list(n)%acc_interval), & + ' freq = ', MAPL_nsecf(list(n)%frequency) + + endif call MAPL_VarSpecCreateInList(INTSTATE%SRCS(n)%SPEC, & SHORT_NAME = SHORT_NAME, & @@ -3385,6 +3503,15 @@ subroutine Run ( gc, import, export, clock, rc ) integer :: status logical :: file_exists +! Debug variables + type(ESMF_Time) :: CurrTime + character(len=ESMF_MAXSTR) :: TimeString + integer :: year,month,day,hour,minute + logical :: alarmEnabled + type(ESMF_Time) :: RingTime + character(len=ESMF_MAXSTR) :: tmpstring + + !============================================================================= ! Begin... @@ -3418,6 +3545,44 @@ subroutine Run ( gc, import, export, clock, rc ) _VERIFY(STATUS) Ignore = .false. + if(.false. .and. MAPL_AM_I_ROOT() ) then + write(6,*) "Checking history time" + call ESMF_ClockGet ( clock, currTime=CurrTime ,rc=STATUS ) ; _VERIFY(STATUS) + + call ESMF_TimeGet ( CurrTime, timeString=TimeString, rc=status ) ; _VERIFY(STATUS) + + read(timestring( 1: 4),'(i4.4)') year + read(timestring( 6: 7),'(i2.2)') month + read(timestring( 9:10),'(i2.2)') day + read(timestring(12:13),'(i2.2)') hour + read(timestring(15:16),'(i2.2)') minute + write(6,'(1X,"CurrTime: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " FWD:",L1)') & + year, month, day, hour, minute, FWD + do n=1,nlist + call ESMF_AlarmGet(list(n)%his_alarm, ringTime=CurrTime, ringing=alarmEnabled, rc=STATUS); _VERIFY(STATUS) + call ESMF_TimeGet ( CurrTime, timeString=TimeString, rc=status ) ; _VERIFY(STATUS) + + read(timestring( 1: 4),'(i4.4)') year + read(timestring( 6: 7),'(i2.2)') month + read(timestring( 9:10),'(i2.2)') day + read(timestring(12:13),'(i2.2)') hour + read(timestring(15:16),'(i2.2)') minute + write(6,'(1X,"Alarm ", i3, " Ring Time: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " ringing: ", L1)') & + n, year, month, day, hour, minute, alarmEnabled + + call ESMF_AlarmGet(list(n)%his_alarm, prevRingTime=CurrTime, enabled=alarmEnabled, rc=STATUS); _VERIFY(STATUS) + call ESMF_TimeGet ( CurrTime, timeString=TimeString, rc=status ) ; _VERIFY(STATUS) + + read(timestring( 1: 4),'(i4.4)') year + read(timestring( 6: 7),'(i2.2)') month + read(timestring( 9:10),'(i2.2)') day + read(timestring(12:13),'(i2.2)') hour + read(timestring(15:16),'(i2.2)') minute + write(6,'(1X,"Alarm ", i3, " Prev Ring Time: ",i4.4, "/", i2.2, "/", i2.2, "T", i2.2, ":", i2.2, " enabled: ", L1)') & + n, year, month, day, hour, minute, alarmEnabled + + end do + endif ! decide if clock direction and collections' backwards mode agree do n=1,nlist @@ -3498,6 +3663,10 @@ subroutine Run ( gc, import, export, clock, rc ) if (list(n)%disabled .or. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then list(n)%disabled = .true. Writing(n) = .false. + if (MAPL_am_I_Root()) THEN + WRITE(*, 1999) n + ENDIF +1999 FORMAT('Not Writing alarm ', i3, ' because end_alarm is ringing') else if (list(n)%timeseries_output) then Writing(n) = .true. else