!! Copyright (C) Stichting Deltares, 2005-2020. !! !! This file is part of iMOD. !! !! This program is free software: you can redistribute it and/or modify !! it under the terms of the GNU General Public License as published by !! the Free Software Foundation, either version 3 of the License, or !! (at your option) any later version. !! !! This program is distributed in the hope that it will be useful, !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! GNU General Public License for more details. !! !! You should have received a copy of the GNU General Public License !! along with this program. If not, see . !! !! Contact: imod.support@deltares.nl !! Stichting Deltares !! P.O. Box 177 !! 2600 MH Delft, The Netherlands. !! MODULE MOD_PMANAGER_TIME USE WINTERACTER USE RESOURCE USE MOD_PMANAGER_PAR USE MOD_QKSORT USE MOD_UTL, ONLY : UTL_WSELECTFILE,UTL_GETUNIT,ITOS,HMSTOITIME,JD,UTL_FILLDATES,UTL_GDATE,ITIMETOHMS,ITIMETOGDATE,UTL_CAP USE MOD_IDF, ONLY : IDFDEALLOCATEX,IDFDEALLOCATESX USE MOD_PREF_PAR, ONLY : PREFVAL USE MOD_OSD, ONLY : OSD_OPEN CONTAINS !###====================================================================== SUBROUTINE PMANAGER_COMPUTEDELT() !###====================================================================== IMPLICIT NONE INTEGER,PARAMETER :: SDAY=60*60*24 INTEGER :: JD1,JD2,I,ISC1,ISC2 DO I=1,PRJNPER-1 !## skip steady-state IF(SIM(I)%DELT.EQ.0.0D0.OR.UTL_CAP(SIM(I)%CDATE,'U').EQ.'STEADY-STATE')CYCLE IF(SIM(I)%IYR+SIM(I)%IMH+SIM(I)%IDY+SIM(I)%IHR+SIM(I)%IMT+SIM(I)%ISC.LE.0)THEN SIM(I)%DELT=0.0D0; SIM(I)%CDATE='STEADY-STATE' CYCLE ENDIF !## compute delta-t for previous timestep JD1=JD(SIM(I )%IYR,SIM(I )%IMH,SIM(I )%IDY) JD2=JD(SIM(I+1)%IYR,SIM(I+1)%IMH,SIM(I+1)%IDY) SIM(I)%DDAY=JD2-JD1-1 !## compute net seconds between timesteps ISC1=SIM(I)%IHR*3600+SIM(I)%IMT*60+SIM(I)%ISC ISC1=SDAY-ISC1 ISC2=SIM(I+1)%IHR*3600+SIM(I+1)%IMT*60+SIM(I+1)%ISC SIM(I)%DSEC=ISC1+ISC2 DO IF(SIM(I)%DSEC.LT.SDAY)EXIT SIM(I)%DDAY=SIM(I)%DDAY+1 SIM(I)%DSEC=SIM(I)%DSEC-SDAY ENDDO SIM(I)%DELT=REAL(SIM(I)%DDAY,8)+SIM(I)%DSEC/REAL(SDAY,8) ENDDO !## last timestep is zero 0 will not be part of the model SIM(PRJNPER)%DELT =0.0D0 SIM(PRJNPER)%ISAVE=0.0D0 SIM(PRJNPER)%ISUM =0.0D0 ! SIM%NSTP =1 ! SIM%TMULT =1.0D0 END SUBROUTINE PMANAGER_COMPUTEDELT !###====================================================================== LOGICAL FUNCTION PMANAGER_FILLTIMESTEPS() !###====================================================================== IMPLICIT NONE INTEGER :: JD1,JD2,IPERIOD,I,ISS,IHR,IMT,ISC,IHMS1,IHMS2,ISTEADY,ISTEP,ID,DD PMANAGER_FILLTIMESTEPS=.FALSE. ID=WINFODIALOG(CURRENTDIALOG) CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4) !## get timestep configurations CALL WDIALOGGETMENU(IDF_MENU4,IPERIOD) CALL WDIALOGGETINTEGER(IDF_INTEGER12,ISTEP) !## get steady-transient simulation option, ISS=1 steady, ISS=2 transient CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ISS) CALL WDIALOGGETCHECKBOX(IDF_CHECK2,ISTEADY) IF(ASSOCIATED(SIM))DEALLOCATE(SIM) !## transient IF(ISS.EQ.2)THEN !## get the dates CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2,JD1) CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU3,IDF_INTEGER4,JD2) !## get the hours,minutes,seconds CALL WDIALOGGETINTEGER(IDF_INTEGER6,IHR) CALL WDIALOGGETINTEGER(IDF_INTEGER7,IMT) CALL WDIALOGGETINTEGER(IDF_INTEGER8,ISC) IHMS1=HMSTOITIME(IHR,IMT,ISC) CALL WDIALOGGETINTEGER(IDF_INTEGER9,IHR) CALL WDIALOGGETINTEGER(IDF_INTEGER10,IMT) CALL WDIALOGGETINTEGER(IDF_INTEGER11,ISC) IHMS2=HMSTOITIME(IHR,IMT,ISC) !## estimate before how many timesteps DD=JD2-JD1 SELECT CASE (IPERIOD) !## minutes CASE (1); DD=DD*(24*60) !## hours CASE (2); DD=DD*24 !## weekly CASE (4); DD=DD/7 !## decade CASE (5); DD=DD/10 !## 14/28 CASE (6); DD=DD/14 !## monthly CASE (7); DD=DD/30 !## yearly CASE (8); DD=DD/365 END SELECT IF(DD.GT.1E6)THEN CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to continue, your current'//CHAR(13)//'selection might '//TRIM(ITOS(DD))//' timesteps.','Error') IF(WINFODIALOG(4).NE.1)THEN; CALL WDIALOGSELECT(ID); RETURN; ENDIF ENDIF ALLOCATE(SIM(100)); SIM%DELT=HUGE(1.0D0) CALL PMANAGER_ASSIGNTIMESTEPS(1,2,JD1,JD2,IHMS1,IHMS2,IPERIOD,ISTEP) CALL PMANAGER_COMPUTEDELT() !## add first steady-state step IF(ISTEADY.EQ.1)THEN ALLOCATE(SIM_C(PRJNPER+1)); DO I=2,PRJNPER+1; SIM_C(I)=SIM(I-1); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C !## first is always a steady-state - potentially SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0D0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0 SIM(1)%IYR=0; SIM(1)%IMH=0; SIM(1)%IDY=0; SIM(1)%IHR=0; SIM(1)%IMT=0; SIM(1)%ISC=0 SIM(1)%NSTP=1; SIM(1)%TMULT=1.0D0 SIM(1)%TTSMULT=1.0D0; SIM(1)%TTSMAX=0.0D0; SIM(1)%DT0=0.0D0; SIM(1)%MXSTRN=3000 PRJNPER=PRJNPER+1 ENDIF ELSE PRJNPER=1; ALLOCATE(SIM(1)); SIM%DELT=HUGE(1.0D0) SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0D0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0 SIM(1)%IYR=0; SIM(1)%IMH=0; SIM(1)%IDY=0; SIM(1)%IHR=0; SIM(1)%IMT=0; SIM(1)%ISC=0 SIM(1)%NSTP=1; SIM(1)%TMULT=1.0D0 SIM(1)%TTSMULT=1.0D0; SIM(1)%TTSMAX=0.0D0; SIM(1)%DT0=0.0D0; SIM(1)%MXSTRN=3000 ENDIF CALL WDIALOGSELECT(ID) PMANAGER_FILLTIMESTEPS=.TRUE. END FUNCTION PMANAGER_FILLTIMESTEPS !###====================================================================== SUBROUTINE PMANAGER_TIMESTEPS_GETISTEP(IPERIOD,ISTATE,ISTEP) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IPERIOD INTEGER,INTENT(OUT) :: ISTATE,ISTEP SELECT CASE (IPERIOD) CASE (1,2,3,7,8) !## hourly,daily,monthly,yearly ISTATE=1; ISTEP=1 CASE (4) !## weekly ISTATE=1; ISTEP=1 CASE (5) !## decade ISTATE=1; ISTEP=1 CASE (6) !## 14/28 ISTATE=0; ISTEP=14 CASE (9,10) !## all ISTATE=0; ISTEP=0 END SELECT END SUBROUTINE PMANAGER_TIMESTEPS_GETISTEP !###====================================================================== SUBROUTINE PMANAGER_PUTTIMEINGRID() !###====================================================================== IMPLICIT NONE INTEGER :: I,ID,ICONFIG ID=WINFODIALOG(CURRENTDIALOG) !## get the main configuration CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1) CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ICONFIG) CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4) IF(PRJNPER.GT.WINFOGRID(IDF_GRID1,GRIDROWSMAX))THEN CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'There is a maximum of '// & TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX)))//' timesteps in this iMOD version'//CHAR(13)// & 'iMOD displays '//TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX)))//' records only of '//TRIM(ITOS(PRJNPER)),'Warning') PRJNPER=WINFOGRID(IDF_GRID1,GRIDROWSMAX) ALLOCATE(SIM_C(PRJNPER)); DO I=1,PRJNPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C ENDIF CALL WGRIDROWS(IDF_GRID1,PRJNPER) DO I=1,PRJNPER; CALL WGRIDLABELROW(IDF_GRID1,I,TRIM(ITOS(I))); ENDDO CALL WGRIDPUTSTRING (IDF_GRID1,1,SIM%CDATE,PRJNPER) CALL WGRIDPUTDOUBLE (IDF_GRID1,2,SIM%DELT ,PRJNPER) CALL WGRIDPUTINTEGER(IDF_GRID1,3,SIM%ISAVE,PRJNPER) CALL WGRIDPUTINTEGER(IDF_GRID1,4,SIM%NSTP ,PRJNPER) CALL WGRIDPUTDOUBLE (IDF_GRID1,5,SIM%TMULT,PRJNPER) SELECT CASE (ICONFIG) CASE (4,5) CALL WGRIDPUTDOUBLE (IDF_GRID1,6,SIM%TTSMULT,PRJNPER) CALL WGRIDPUTDOUBLE (IDF_GRID1,7,SIM%TTSMAX ,PRJNPER) CALL WGRIDPUTDOUBLE (IDF_GRID1,8,SIM%DT0 ,PRJNPER) CALL WGRIDPUTINTEGER(IDF_GRID1,9,SIM%MXSTRN ,PRJNPER) END SELECT CALL WGRIDSTATE(IDF_GRID1,1,2) CALL WGRIDSTATE(IDF_GRID1,2,2) I=1; IF(SIM(1)%DELT.LE.0.0D0)I=2; I=MIN(I,PRJNPER) CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,I,PRJNPER) CALL WDIALOGRANGEINTEGER(IDF_INTEGER2,I,PRJNPER) CALL WDIALOGPUTINTEGER(IDF_INTEGER1,I) CALL WDIALOGPUTINTEGER(IDF_INTEGER2,I) CALL WDIALOGPUTINTEGER(IDF_INTEGER15,PRJNPER) CALL WDIALOGSELECT(ID) END SUBROUTINE PMANAGER_PUTTIMEINGRID !###====================================================================== SUBROUTINE PMANAGER_INSERTTIMES(IROW1,IROW2,IPERIOD,ISTEP,ITG,ION) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IROW1,IROW2,IPERIOD,ISTEP,ITG,ION INTEGER :: IR1,IR2,IHMS1,IHMS2,JD1,JD2,I,J INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME INTEGER(KIND=8) :: STIME,ETIME !## get the hours,minutes,seconds IR1=MAX(1,IROW1); IR2=MIN(SIZE(SIM),IROW2+1) IHMS1=HMSTOITIME(SIM(IR1)%IHR,SIM(IR1)%IMT,SIM(IR1)%ISC) IHMS2=HMSTOITIME(SIM(IR2)%IHR,SIM(IR2)%IMT,SIM(IR2)%ISC) JD1=JD(SIM(IR1)%IYR,SIM(IR1)%IMH,SIM(IR1)%IDY) JD2=JD(SIM(IR2)%IYR,SIM(IR2)%IMH,SIM(IR2)%IDY) ALLOCATE(SIM_C2(SIZE(SIM))); SIM_C2=SIM; DEALLOCATE(SIM) !## all selected between irow1 and irow2 IF(ITG.EQ.2.AND.IPERIOD.EQ.10)THEN PRJNPER=IROW2-IROW1+1; ALLOCATE(SIM(PRJNPER)) DO I=1,PRJNPER; SIM(I)=SIM_C2(I+IROW1-1); ENDDO ELSE !## create new timesteps in between ALLOCATE(SIM(100)); SIM%DELT=HUGE(1.0D0) CALL PMANAGER_ASSIGNTIMESTEPS(1,2,JD1,JD2,IHMS1,IHMS2,IPERIOD,ISTEP) ENDIF !## adjust time-steps IF(ITG.EQ.1)THEN J=PRJNPER+IR1+(SIZE(SIM_C2)-IR2+1) ALLOCATE(ITIME(J)) !## fill in previous timesteps before ir1 - skip steady-state J=0; DO I=1,IR1 J=J+1 ITIME(J)=SIM_C2(I)%IYR*10000000000+SIM_C2(I)%IMH*100000000+SIM_C2(I)%IDY*1000000+SIM_C2(I)%IHR*10000+SIM_C2(I)%IMT*100+SIM_C2(I)%ISC ENDDO STIME=ITIME(1) !## fill in previous timesteps after ir2 DO I=IR2,SIZE(SIM_C2) J=J+1 ITIME(J)=SIM_C2(I)%IYR*10000000000+SIM_C2(I)%IMH*100000000+SIM_C2(I)%IDY*1000000+SIM_C2(I)%IHR*10000+SIM_C2(I)%IMT*100+SIM_C2(I)%ISC ENDDO ETIME=ITIME(J) !## fill in the renewed timsteps DO I=1,PRJNPER J=J+1 ITIME(J)=SIM(I)%IYR*10000000000+SIM(I)%IMH*100000000+SIM(I)%IDY*1000000+SIM(I)%IHR*10000+SIM(I)%IMT*100+SIM(I)%ISC ENDDO CALL PMANAGER_SORTTIMES(ITIME,STIME,ETIME); DEALLOCATE(ITIME) !## recompute delt CALL PMANAGER_COMPUTEDELT() !## adjust saving interval ELSE DO I=1,PRJNPER DO J=1,SIZE(SIM_C2) IF(SIM(I)%IYR.EQ.SIM_C2(J)%IYR.AND. & SIM(I)%IMH.EQ.SIM_C2(J)%IMH.AND. & SIM(I)%IDY.EQ.SIM_C2(J)%IDY.AND. & SIM(I)%IHR.EQ.SIM_C2(J)%IHR.AND. & SIM(I)%IMT.EQ.SIM_C2(J)%IMT.AND. & SIM(I)%ISC.EQ.SIM_C2(J)%ISC)THEN; SIM_C2(J)%ISAVE=ION-1; EXIT; ENDIF ENDDO ENDDO DEALLOCATE(SIM); SIM=>SIM_C2; PRJNPER=SIZE(SIM) ENDIF !## put in the menu CALL PMANAGER_PUTTIMEINGRID() END SUBROUTINE PMANAGER_INSERTTIMES !###====================================================================== SUBROUTINE PMANAGER_GETPRJNPER(JD1,IHMS1,JD2,IHMS2) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: JD1,IHMS1,JD2,IHMS2 INTEGER :: I,J,K,IYR,IMH,IDY,IHR,IMT,ISC,IPER INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME INTEGER(KIND=8) :: STIME,ETIME ALLOCATE(ITIME(100)); ITIME=INT(0,8) CALL UTL_GDATE(JD1,IYR,IMH,IDY); CALL ITIMETOHMS(IHMS1,IHR,IMT,ISC) ITIME(1)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC CALL UTL_GDATE(JD2,IYR,IMH,IDY); CALL ITIMETOHMS(IHMS2,IHR,IMT,ISC) ITIME(2)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC !## fill in list IPER=2 DO I=1,MAXTOPICS IF(.NOT.TOPICS(I)%TIMDEP)CYCLE IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE DO J=1,SIZE(TOPICS(I)%STRESS) !## skip steady-state IF(TRIM(UTL_CAP(TOPICS(I)%STRESS(J)%CDATE,'U')).EQ.'STEADY-STATE')CYCLE IYR=TOPICS(I)%STRESS(J)%IYR; IMH=TOPICS(I)%STRESS(J)%IMH; IDY=TOPICS(I)%STRESS(J)%IDY IHR=TOPICS(I)%STRESS(J)%IHR; IMT=TOPICS(I)%STRESS(J)%IMT; ISC=TOPICS(I)%STRESS(J)%ISC !## true date specified IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN IPER=IPER+1; CALL PMANAGER_GETPRJNPER_ITIME(ITIME,IPER) ITIME(IPER)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC ELSE !## include used periods DO K=1,NPERIOD IF(TRIM(UTL_CAP(TOPICS(I)%STRESS(J)%CDATE,'U')).EQ.TRIM(UTL_CAP(PERIOD(K)%NAME,'U')))EXIT ENDDO !## see whether the current stress is within mentioned period IF(K.LE.NPERIOD)THEN IYR=PERIOD(K)%IYR; IMH=PERIOD(K)%IMH; IDY=PERIOD(K)%IDY; IHR=PERIOD(K)%IHR; IMT=PERIOD(K)%IMT; ISC=PERIOD(K)%ISC !## true date specified IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN IPER=IPER+1; CALL PMANAGER_GETPRJNPER_ITIME(ITIME,IPER) ITIME(IPER)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC ENDIF ELSE !## not known period specified CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot find the definition for the specified'//CHAR(13)// & 'period called: '//TRIM(TOPICS(I)%STRESS(J)%CDATE),'Error') PRJNPER=0; RETURN ENDIF ENDIF ENDDO ENDDO STIME=ITIME(1); ETIME=ITIME(2) CALL PMANAGER_SORTTIMES(ITIME,STIME,ETIME) DEALLOCATE(ITIME) END SUBROUTINE PMANAGER_GETPRJNPER !###====================================================================== SUBROUTINE PMANAGER_SORTTIMES(ITIME,STIME,ETIME) !###====================================================================== IMPLICIT NONE INTEGER(KIND=8),INTENT(IN) :: STIME,ETIME INTEGER(KIND=8),DIMENSION(:),POINTER,INTENT(INOUT) :: ITIME INTEGER(KIND=8),DIMENSION(:),POINTER :: JTIME INTEGER :: IPER,I CALL QKSORT_INT8(SIZE(ITIME),ITIME) ALLOCATE(JTIME(SIZE(ITIME))) PRJNPER=1 !## start time JTIME(1)=STIME !## get first date inside time window DO IPER=1,SIZE(ITIME) !## too early IF(ITIME(IPER).LE.STIME)CYCLE; EXIT ENDDO !## get number of unique dates DO I=IPER,SIZE(ITIME) !## too late - stop IF(ITIME(I).GT.ETIME)EXIT IF(I.GT.1)THEN IF(ITIME(I).NE.ITIME(I-1))THEN PRJNPER=PRJNPER+1; JTIME(PRJNPER)=ITIME(I) ENDIF ENDIF ENDDO IF(PRJNPER.EQ.0)THEN CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No stress-periods found in the packages.','Warning') ELSE ALLOCATE(SIM(PRJNPER)); SIM%DELT=HUGE(1.0D0) DO I=1,PRJNPER WRITE(SIM(I)%CDATE,'(I14)') JTIME(I) READ(SIM(I)%CDATE,'(I4,5I2)') SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC SIM(I)%ISAVE=1; SIM(I)%ISUM=0 ENDDO ENDIF DEALLOCATE(JTIME) END SUBROUTINE PMANAGER_SORTTIMES !###====================================================================== SUBROUTINE PMANAGER_GETPRJNPER_ITIME(ITIME,IPER) !###====================================================================== IMPLICIT NONE INTEGER(KIND=8),INTENT(INOUT),DIMENSION(:),POINTER :: ITIME INTEGER,INTENT(IN) :: IPER INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME_C INTEGER :: N,I !## check size of the SIM vector IF(SIZE(ITIME).LT.IPER)THEN N=SIZE(ITIME)+100; ALLOCATE(ITIME_C(N)); ITIME_C=INT(0,8) DO I=1,SIZE(ITIME); ITIME_C(I)=ITIME(I); ENDDO DEALLOCATE(ITIME); ITIME=>ITIME_C ENDIF END SUBROUTINE PMANAGER_GETPRJNPER_ITIME !###====================================================================== SUBROUTINE PMANAGER_ASSIGNTIMESTEPS(I1,I2,JD1,JD2,IHMS1,IHMS2,IPERIOD,JSTEP) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: I1,I2,IPERIOD,JD1,JD2,IHMS1,IHMS2,JSTEP INTEGER :: I,ISTEP ISTEP=JSTEP !## fill in final date on position(1) CALL UTL_GDATE(JD2,SIM(I1)%IYR,SIM(I1)%IMH,SIM(I1)%IDY) CALL ITIMETOHMS(IHMS2,SIM(I1)%IHR,SIM(I1)%IMT,SIM(I1)%ISC) !## fill in start date on position(1) CALL UTL_GDATE(JD1,SIM(I2)%IYR,SIM(I2)%IMH,SIM(I2)%IDY) CALL ITIMETOHMS(IHMS1,SIM(I2)%IHR,SIM(I2)%IMT,SIM(I2)%ISC) !## overrule in case istep=0 IF(ISTEP.EQ.0)THEN SELECT CASE (IPERIOD) CASE (1,2,3,7,8) !## minutes,hourly,daily,monthly,yearly ISTEP=1 CASE (4) !## weekly ISTEP=7 CASE (5) !## decade ISTEP=10 CASE (6) !## 14/28 ISTEP=14 END SELECT ENDIF SELECT CASE (IPERIOD) CASE (4) !## weekly ISTEP=JSTEP*7 CASE (5) !## decade ISTEP=JSTEP*10 END SELECT !## fill in intermediate timesteps SELECT CASE (IPERIOD) CASE (1) !## minutes I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,5))EXIT; ENDDO; PRJNPER=I CASE (2) !## hourly I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,4))EXIT; ENDDO; PRJNPER=I CASE (3) !## daily I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; PRJNPER=I CASE (4) !## weekly I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; PRJNPER=I CASE (5) !## decade I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; PRJNPER=I CASE (6) !## 14/28 I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1,10,7))EXIT; ENDDO; PRJNPER=I CASE (7) !## monthly I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,2))EXIT; ENDDO; PRJNPER=I CASE (8) !## yearly I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,1))EXIT; ENDDO; PRJNPER=I CASE (9) !## packages CALL PMANAGER_GETPRJNPER(JD1,IHMS1,JD2,IHMS2) END SELECT !## remove first "temporary" timestep SELECT CASE (IPERIOD) CASE (1:8) !## make sure size(sim) is equal to prjnper ALLOCATE(SIM_C(PRJNPER-1)); DO I=1,PRJNPER-1; SIM_C(I)=SIM(I+1); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C; PRJNPER=PRJNPER-1 END SELECT DO I=1,PRJNPER WRITE(SIM(I)%CDATE,'(I4.4,5(A1,I2.2))') SIM(I)%IYR,'-',SIM(I)%IMH,'-',SIM(I)%IDY,' ',SIM(I)%IHR,':',SIM(I)%IMT,':',SIM(I)%ISC SIM(I)%ISAVE=1; SIM(I)%ISUM =0; SIM(I)%TMULT=1.0D0; SIM(I)%NSTP=1 SIM(I)%TTSMULT=1.0D0; SIM(I)%TTSMAX=0.0D0; SIM(I)%DT0=0.0D0; SIM(I)%MXSTRN=3000 ENDDO !## make sure size(sim) is equal to prjnper IF(PRJNPER.LT.SIZE(SIM))THEN ALLOCATE(SIM_C(PRJNPER)); DO I=1,PRJNPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C ENDIF END SUBROUTINE PMANAGER_ASSIGNTIMESTEPS !###====================================================================== LOGICAL FUNCTION PMANAGER_ADDTIMESTEP(ISIM,ESIM,ISTEP,TSTEP) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: ISIM,ESIM,TSTEP,ISTEP INTEGER :: IDAY,IHMS1,IHMS2,JD1,JD2,I,N !## added a step, or otherwise not PMANAGER_ADDTIMESTEP=.TRUE. !## check size of the SIM vector IF(SIZE(SIM).LE.ISIM)THEN N=SIZE(SIM)+100; ALLOCATE(SIM_C(N)) DO I=1,SIZE(SIM); SIM_C(I)=SIM(I); ENDDO DEALLOCATE(SIM); SIM=>SIM_C ENDIF !## copy previous timestep SIM(ISIM)=SIM(ISIM-1) !## add a timestep to it according to the type of the timestep SELECT CASE (TSTEP) CASE (1) !## iyear SIM(ISIM)%IYR=SIM(ISIM-1)%IYR+ISTEP CASE (2) !## imonth SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+ISTEP CASE (3) !## iday SIM(ISIM)%IDY=SIM(ISIM-1)%IDY+ISTEP CASE (4) !## ihour SIM(ISIM)%IHR=SIM(ISIM-1)%IHR+ISTEP CASE (5) !## iminute SIM(ISIM)%IMT=SIM(ISIM-1)%IMT+ISTEP CASE (6) !## isecond SIM(ISIM)%ISC=SIM(ISIM-1)%ISC+ISTEP CASE (7) !## 14/28 IF(SIM(ISIM-1)%IDY.EQ.14)THEN SIM(ISIM)%IDY=28 ELSEIF(SIM(ISIM-1)%IDY.EQ.28)THEN SIM(ISIM)%IDY=14; SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+1 ELSEIF(SIM(ISIM-1)%IDY.GT.14.AND.SIM(ISIM-1)%IDY.LT.28)THEN SIM(ISIM)%IDY=28 ELSE SIM(ISIM)%IDY=14; IF(SIM(ISIM-1)%IDY.GT.28)SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+1 ENDIF END SELECT !## correct seconds DO IF(SIM(ISIM)%ISC.LT.60)EXIT SIM(ISIM)%ISC=SIM(ISIM)%ISC-60; SIM(ISIM)%IMT=SIM(ISIM)%IMT+1 ENDDO !## correct minutes DO IF(SIM(ISIM)%IMT.LT.60)EXIT SIM(ISIM)%IMT=SIM(ISIM)%IMT-60; SIM(ISIM)%IHR=SIM(ISIM)%IHR+1 ENDDO !## correct hours DO IF(SIM(ISIM)%IHR.LT.24)EXIT SIM(ISIM)%IHR=SIM(ISIM)%IHR-24; SIM(ISIM)%IDY=SIM(ISIM)%IDY+1 ENDDO !## no minutes available ihms1=0 otherwise ihms1=1 IHMS1=HMSTOITIME(SIM(ISIM)%IHR,SIM(ISIM)%IMT,SIM(ISIM)%ISC) IHMS1=MIN(IHMS1,1) !## correct days DO IDAY=WDATEDAYSINMONTH(SIM(ISIM)%IYR,SIM(ISIM)%IMH) IF(SIM(ISIM)%IDY.LE.IDAY)EXIT SIM(ISIM)%IDY=SIM(ISIM)%IDY-IDAY; SIM(ISIM)%IMH=SIM(ISIM)%IMH+1 ENDDO !## correct month DO IF(SIM(ISIM)%IMH.LE.12)EXIT SIM(ISIM)%IMH=SIM(ISIM)%IMH-12; SIM(ISIM)%IYR=SIM(ISIM)%IYR+1 ENDDO !## evaluate whether the new date is greater or equal esim - trim on it alternatively JD1=JD(SIM(ISIM)%IYR,SIM(ISIM)%IMH,SIM(ISIM)%IDY) JD2=JD(SIM(ESIM)%IYR,SIM(ESIM)%IMH,SIM(ESIM)%IDY) IHMS1=HMSTOITIME(SIM(ISIM)%IHR,SIM(ISIM)%IMT,SIM(ISIM)%ISC) IHMS2=HMSTOITIME(SIM(ESIM)%IHR,SIM(ESIM)%IMT,SIM(ESIM)%ISC) !## not yet finished - return IF(JD1.LT.JD2)THEN RETURN !## trim and finish ELSEIF(JD1.GT.JD2)THEN SIM(ISIM)=SIM(ESIM) ELSE !## not yet finished - return IF(IHMS1.LT.IHMS2)THEN RETURN !## trim and finish ELSE SIM(ISIM)=SIM(ESIM) ENDIF ENDIF PMANAGER_ADDTIMESTEP=.FALSE. END FUNCTION PMANAGER_ADDTIMESTEP !###====================================================================== SUBROUTINE PMANAGER_SAVETIMESTEPS(ID,IBATCH,FNAME_IN) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: ID,IBATCH CHARACTER(LEN=*),INTENT(IN) :: FNAME_IN INTEGER :: I,N,IOS,IU,ICONFIG CHARACTER(LEN=256) :: FNAME INTEGER(KIND=8) :: IDATE INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TMPREAL !## get the main configuration CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1) CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ICONFIG) IF(ID.EQ.ID_OPEN)THEN IF(LEN_TRIM(FNAME_IN).EQ.0)THEN FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.tim' IF(.NOT.UTL_WSELECTFILE('iMOD Time Files (*.tim)|*.tim|', & LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,& 'Load iMOD Time File'))RETURN ELSE FNAME=FNAME_IN ENDIF IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED') IF(IU.EQ.0)RETURN N=100; IF(ASSOCIATED(SIM))DEALLOCATE(SIM); ALLOCATE(SIM(N)); SIM%DELT=HUGE(1.0D0) PRJNPER=1; DO READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT SELECT CASE (ICONFIG) CASE (1,2,3) READ(LINE,*,IOSTAT=IOS) SIM(PRJNPER)%CDATE,SIM(PRJNPER)%ISAVE,SIM(PRJNPER)%NSTP,SIM(PRJNPER)%TMULT IF(IOS.NE.0)THEN SIM(PRJNPER)%NSTP=1; SIM(PRJNPER)%TMULT=1.0D0 READ(LINE,*,IOSTAT=IOS) SIM(PRJNPER)%CDATE,SIM(PRJNPER)%ISAVE ENDIF CASE (4,5) READ(LINE,*,IOSTAT=IOS) SIM(PRJNPER)%CDATE ,SIM(PRJNPER)%ISAVE ,SIM(PRJNPER)%NSTP,SIM(PRJNPER)%TMULT, & SIM(PRJNPER)%TTSMULT,SIM(PRJNPER)%TTSMAX,SIM(PRJNPER)%DT0 ,SIM(PRJNPER)%MXSTRN END SELECT IF(IOS.NE.0)EXIT PRJNPER=PRJNPER+1 IF(PRJNPER.GE.N)THEN ALLOCATE(SIM_C(N+100)); SIM_C%DELT=HUGE(1.0D0); DO I=1,N; SIM_C(I)=SIM(I); ENDDO DEALLOCATE(SIM); SIM=>SIM_C; N=SIZE(SIM) ENDIF ENDDO PRJNPER=PRJNPER-1 !## make sure lenght is equal to PRJNPER IF(PRJNPER.LT.SIZE(SIM))THEN ALLOCATE(SIM_C(PRJNPER)); SIM_C%DELT=HUGE(1.0D0); DO I=1,PRJNPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C ENDIF DO I=1,PRJNPER READ(SIM(I)%CDATE,'(I14)') IDATE CALL ITIMETOGDATE(IDATE,SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC) ENDDO CALL PMANAGER_COMPUTEDELT() !## put in the menu IF(IBATCH.EQ.0)CALL PMANAGER_PUTTIMEINGRID() ALLOCATE(TMPREAL(PRJNPER),TMPINT(PRJNPER)) TMPREAL=SIM%TTSMULT CALL WGRIDPUTDOUBLE (IDF_GRID1,6,TMPREAL,PRJNPER) TMPREAL=SIM%TTSMAX CALL WGRIDPUTDOUBLE (IDF_GRID1,7,TMPREAL,PRJNPER) TMPREAL=SIM%DT0 CALL WGRIDPUTDOUBLE (IDF_GRID1,8,TMPREAL,PRJNPER) TMPINT=SIM%MXSTRN CALL WGRIDPUTINTEGER(IDF_GRID1,9,TMPINT,PRJNPER) DEALLOCATE(TMPREAL,TMPINT) CLOSE(IU) ELSEIF(ID.EQ.ID_SAVE)THEN IF(LEN_TRIM(FNAME_IN).EQ.0)THEN FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.tim' IF(.NOT.UTL_WSELECTFILE('iMOD Time Files (*.tim)|*.tim|', & SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Time File'))RETURN ELSE FNAME=FNAME_IN ENDIF IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED') IF(IU.EQ.0)RETURN DO I=1,SIZE(SIM) SELECT CASE (ICONFIG) CASE (1,2,3) WRITE(LINE,'(I4.4,5I2.2,A1,I2,A1,I4,A1,G12.5)') SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC, & ',',SIM(I)%ISAVE,',',SIM(I)%NSTP,',',SIM(I)%TMULT CASE (4,5) WRITE(LINE,*,IOSTAT=IOS) SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC, & ',',SIM(I)%ISAVE,',',SIM(I)%NSTP,',',SIM(I)%TMULT,',',SIM(PRJNPER)%TTSMULT,',',SIM(PRJNPER)%TTSMAX, & ',',SIM(PRJNPER)%DT0,',',SIM(PRJNPER)%MXSTRN END SELECT WRITE(IU,'(A)') TRIM(LINE) ENDDO CLOSE(IU) CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written project tim-file:'//CHAR(13)//TRIM(FNAME),'Information') ENDIF END SUBROUTINE PMANAGER_SAVETIMESTEPS END MODULE MOD_PMANAGER_TIME