!! 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_UTL
USE WINTERACTER
USE RESOURCE
USE MOD_COLOURS, ONLY : ICOLOR
USE MOD_IDFPLOT, ONLY : IDFZOOM,IDFPLOT
USE MOD_MODEL_PAR
USE MOD_BATCH_UTL, ONLY : IMODBATCH_RUNFILE_READ,IMODBATCH_RUNFILE_INITPBMAN
USE MOD_PMANAGER_PAR
USE MOD_PMANAGER_TIME
USE MOD_PMANAGER_MF6NETWORK, ONLY : PMANAGER_GENERATEMFNETWORKS
USE MOD_POLYGON_PAR, ONLY : SHP
USE MOD_POLYGON_UTL, ONLY : POLYGON1CLOSE
USE IMODVAR
USE MOD_IDF
USE MOD_UTL
USE MOD_OSD
USE MOD_PREF_PAR
USE DATEVAR
USE MODPLOT
USE MOD_ABOUT
!USE MOD_IPEST_GLM, ONLY : IPEST_GLM_MAIN,IPEST_GLM_RESET_PARAMETER
!USE MOD_IPEST_IES, ONLY : IPEST_IES_MAIN
!## needed for active packages
TYPE TOBJ
CHARACTER(LEN=MAXLENPRJ) :: PLIST
INTEGER :: IPLIST,JPLIST,KPLIST
CHARACTER(LEN=12),POINTER,DIMENSION(:) :: CLAY
INTEGER,POINTER,DIMENSION(:) :: ILAY
END TYPE TOBJ
TYPE(TOBJ),ALLOCATABLE,DIMENSION(:),PRIVATE :: PCKLIST
CONTAINS
!###======================================================================
LOGICAL FUNCTION PMANAGER_SAVEMF2005_MOD_READ(IDF,ITOPIC,IFILE,SCL_D,SCL_U,IINV,IPRT,ISIZE)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ITOPIC,IFILE,SCL_D,SCL_U,IINV,IPRT
INTEGER,INTENT(OUT),DIMENSION(:),OPTIONAL :: ISIZE
CHARACTER(LEN=256) :: FNAME
TYPE(IDFOBJ),INTENT(INOUT) :: IDF
TYPE(IDFOBJ) :: TMPIDF
INTEGER :: ICNST,ILAY
REAL(KIND=DP_KIND) :: FCT,IMP,CNST
PMANAGER_SAVEMF2005_MOD_READ=.TRUE.
FCT =FNAMES(IFILE)%FCT
IMP =FNAMES(IFILE)%IMP
ILAY =FNAMES(IFILE)%ILAY
ICNST=FNAMES(IFILE)%ICNST
CNST =FNAMES(IFILE)%CNST
FNAME=FNAMES(IFILE)%FNAME
IF(IPRT.GT.0)THEN
WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
IFILE,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(FNAME)//CHAR(39)
ENDIF
IF(ICNST.EQ.1)THEN
IDF%X=CNST
ELSEIF(ICNST.EQ.2.OR.ICNST.EQ.3)THEN
IDF%FNAME=FNAME
!## check whether IDF oversizes simulation window and log it
IF(PRESENT(ISIZE))THEN
ISIZE=0
IF(IDFREAD(TMPIDF,IDF%FNAME,0))THEN
IF(TMPIDF%XMIN.LT.IDF%XMIN)ISIZE(1)=1
IF(TMPIDF%XMAX.GT.IDF%XMAX)ISIZE(3)=1
IF(TMPIDF%YMIN.LT.IDF%YMIN)ISIZE(2)=1
IF(TMPIDF%YMAX.GT.IDF%YMAX)ISIZE(4)=1
ENDIF
ENDIF
!## read/clip/scale idf file
PMANAGER_SAVEMF2005_MOD_READ=IDFREADSCALE(IDF%FNAME,IDF,SCL_U,SCL_D,1.0D0,0)
ENDIF
!## apply factors if no errors occured
IF(PMANAGER_SAVEMF2005_MOD_READ)CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,IDF,FCT,IMP,SCL_U)
END FUNCTION PMANAGER_SAVEMF2005_MOD_READ
!###======================================================================
LOGICAL FUNCTION PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,ILAY,IFBND)
!###======================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: EXFNAME
TYPE(IDFOBJ),INTENT(INOUT) :: IDF
CHARACTER(LEN=256) :: SFNAME
INTEGER,INTENT(IN) :: IINT,IU,ILAY,IFBND
INTEGER :: JU,IROW,ICOL,I,N
REAL(KIND=DP_KIND) :: MINV,MAXV
PMANAGER_SAVEMF2005_MOD_U2DREL=.FALSE.
!## correct for boundary conditions
IF(.NOT.PMANAGER_SAVEMF2005_PCK_GETMINMAX(IDF%X,IDF%NCOL,IDF%NROW,BND(ILAY)%X,MINV,MAXV,IFBND))RETURN
!## constant value
IF(MAXV.EQ.MINV)THEN
IF(IINT.EQ.0)THEN
IF(MAXV.EQ.IDF%NODATA)THEN
LINE='CONSTANT '//TRIM(RTOS(HNOFLOW,'E',7))
ELSE
LINE='CONSTANT '//TRIM(RTOS(MAXV,'E',7))
ENDIF
ELSEIF(IINT.EQ.1)THEN
IF(MAXV.EQ.IDF%NODATA)THEN
LINE='CONSTANT '//TRIM(ITOS(0))
ELSE
LINE='CONSTANT '//TRIM(ITOS(INT(MAXV)))
ENDIF
ENDIF
IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') ' '//TRIM(LINE)
ELSE
CALL UTL_CREATEDIR(EXFNAME(:INDEX(EXFNAME,'\',.TRUE.)-1))
IF(PBMAN%IFORMAT.EQ.3)THEN; N=4; ELSE; N=3; ENDIF
SFNAME=EXFNAME; DO I=1,N; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
IF(IU.NE.0)THEN
IF(PBMAN%IFORMAT.EQ.2)THEN
IF(IINT.EQ.0)WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
IF(IINT.EQ.1)WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1 (FREE) -1'
ELSE
IF(IINT.EQ.0)WRITE(IU,'(A)') ' OPEN/CLOSE '//TRIM(SFNAME)//' FACTOR 1.0D0 IPRN -1'
IF(IINT.EQ.1)WRITE(IU,'(A)') ' OPEN/CLOSE '//TRIM(SFNAME)//' FACTOR 1 IPRN -1'
ENDIF
ENDIF
IF(TRIM(EXFNAME(INDEX(EXFNAME,'.',.TRUE.)+1:)).EQ.'ASC')THEN
JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
WRITE(JU,'(A14,I10)') 'NCOLS' ,IDF%NCOL
WRITE(JU,'(A14,I10)') 'NROWS' ,IDF%NROW
WRITE(JU,'(A14,G15.7)') 'XLLCORNER' ,IDF%XMIN
WRITE(JU,'(A14,G15.7)') 'YLLCORNER' ,IDF%YMIN
WRITE(JU,'(A14,G15.7)') 'CELLSIZE' ,IDF%DX
WRITE(JU,'(A14,G15.7)') 'NODATA_VALUE ',IDF%NODATA
IF(IINT.EQ.1)THEN
DO IROW=1,IDF%NROW; WRITE(JU,*) (INT(IDF%X(ICOL,IROW)),ICOL=1,IDF%NCOL); ENDDO
ELSE
DO IROW=1,IDF%NROW; WRITE(JU,*) (IDF%X(ICOL,IROW) ,ICOL=1,IDF%NCOL); ENDDO
ENDIF
CLOSE(JU)
ELSEIF(TRIM(EXFNAME(INDEX(EXFNAME,'.',.TRUE.)+1:)).EQ.'IDF')THEN
IF(.NOT.IDFWRITE(IDF,EXFNAME,1))RETURN
ELSE
JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
IF(LFREEFORMAT)THEN
CALL IDFWRITEFREE(JU,IDF,IINT,'B','*')
ELSE
IF(IINT.EQ.1)THEN
DO IROW=1,IDF%NROW; WRITE(JU,*) (INT(IDF%X(ICOL,IROW)),ICOL=1,IDF%NCOL); ENDDO
ELSE
DO IROW=1,IDF%NROW; WRITE(JU,*) (IDF%X(ICOL,IROW) ,ICOL=1,IDF%NCOL); ENDDO
ENDIF
ENDIF
CLOSE(JU)
ENDIF
ENDIF
PMANAGER_SAVEMF2005_MOD_U2DREL=.TRUE.
END FUNCTION PMANAGER_SAVEMF2005_MOD_U2DREL
!###======================================================================
SUBROUTINE PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,IDF,FCT,IMP,SCL_U)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IINV,ICNST,SCL_U
REAL(KIND=DP_KIND),INTENT(IN) :: FCT,IMP
TYPE(IDFOBJ),INTENT(INOUT) :: IDF
INTEGER :: IROW,ICOL
!## replace nodata for hnoflow-value
DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
!## not constant value and equal to nodata - skip it
IF(ICNST.EQ.2.AND.IDF%X(ICOL,IROW).EQ.IDF%NODATA)THEN
!## geometric will otherwise ignore zero as entry which is allowed
IF(SCL_U.EQ.3)THEN
IDF%X(ICOL,IROW)=0.0D0
ELSE
IDF%X(ICOL,IROW)=HNOFLOW
ENDIF
ELSE
IDF%X(ICOL,IROW)=IDF%X(ICOL,IROW)*FCT+IMP
ENDIF
!## translate from resistance into reciprocal conductance
!## translate from vka into reciprocal vka
IF(IINV.EQ.1)THEN
IF(IDF%X(ICOL,IROW).NE.0.0D0.AND.IDF%X(ICOL,IROW).NE.HNOFLOW)IDF%X(ICOL,IROW)=1.0D0/IDF%X(ICOL,IROW)
ENDIF
ENDDO; ENDDO
IDF%NODATA=HNOFLOW
END SUBROUTINE PMANAGER_SAVEMF2005_FCTIMP
!###======================================================================
LOGICAL FUNCTION UTL_PMANAGER_REFRESH(ICODE)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ICODE
INTEGER :: I
UTL_PMANAGER_REFRESH=.FALSE.
IF(ICODE.EQ.1)THEN
!## check if something there yet
DO I=1,MAXTOPICS
IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
CALL PMANAGER_GETNFILES((/I/),TOPICS(I)%NLAY,DEFINED=TOPICS(I)%DEFINED)
IF(TOPICS(I)%DEFINED)EXIT
ENDIF
ENDDO
IF(I.LE.MAXTOPICS)THEN
CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to refresh the Project Manager?','Question')
IF(WINFODIALOG(4).NE.1)RETURN
ENDIF
ENDIF
DO I=1,SIZE(TOPICS); CALL PMANAGER_DEALLOCATE(I); ENDDO; CALL PMANAGER_DEALLOCATE_PEST(); NPERIOD=0; NSPECIES=0
CALL PMANAGER_UTL_INIT()
UTL_PMANAGER_REFRESH=.TRUE.
END FUNCTION UTL_PMANAGER_REFRESH
!###======================================================================
SUBROUTINE PMANAGER_SORTTOPIC(ITOPIC,IPER)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ITOPIC,IPER
INTEGER :: I,J,II,K,N,M,JJ,IYR,IMH,IDY,IHR,IMT,ISC
INTEGER,ALLOCATABLE,DIMENSION(:) :: ILAY,ISORT
REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: RTIME
!## sort selected systems in layer
N=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
IF(N.GT.1)THEN
ALLOCATE(ILAY(N),ISORT(N)); ILAY=0
DO I=1,N; ISORT(I)=I; ENDDO
DO I=1,N; ILAY(I)=TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,I)%ILAY; ENDDO
CALL WSORT(ILAY,1,N,IORDER=ISORT)
J =SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,1)
K =SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
NULLIFY(TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP)
ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(J,K))
DO I=1,N
J=ISORT(I)
DO II=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,1)
TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(II,I)=TOPICS(ITOPIC)%STRESS(IPER)%FILES(II,J)
ENDDO
ENDDO
DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES)
TOPICS(ITOPIC)%STRESS(IPER)%FILES=>TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP
DEALLOCATE(ILAY,ISORT)
ENDIF
!## sort selected systems in time
IF(TOPICS(ITOPIC)%TIMDEP)THEN
N=SIZE(TOPICS(ITOPIC)%STRESS)
IF(N.GT.1)THEN
ALLOCATE(RTIME(N),ISORT(N)); RTIME=0.0D0; DO I=1,N; ISORT(I)=I; ENDDO !ISORT=0
DO I=1,N
IYR=TOPICS(ITOPIC)%STRESS(I)%IYR; IMH=TOPICS(ITOPIC)%STRESS(I)%IMH
IDY=TOPICS(ITOPIC)%STRESS(I)%IDY; IHR=TOPICS(ITOPIC)%STRESS(I)%IHR
IMT=TOPICS(ITOPIC)%STRESS(I)%IMT; ISC=TOPICS(ITOPIC)%STRESS(I)%ISC
RTIME(I)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC
ENDDO
CALL UTL_WSORT(RTIME,1,N,IORDER=ISORT)
N=SIZE(TOPICS(ITOPIC)%STRESS); ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(N))
DO I=1,N
J=ISORT(I)
!## create items for j
N =SIZE(TOPICS(ITOPIC)%STRESS(J)%FILES,1)
M =SIZE(TOPICS(ITOPIC)%STRESS(J)%FILES,2)
NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES); ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES(N,M))
TOPICS(ITOPIC)%STRESS_TMP(I)%FILES%FNAME=''
TOPICS(ITOPIC)%STRESS_TMP(I)%CDATE=TOPICS(ITOPIC)%STRESS(J)%CDATE
TOPICS(ITOPIC)%STRESS_TMP(I)%IYR =TOPICS(ITOPIC)%STRESS(J)%IYR
TOPICS(ITOPIC)%STRESS_TMP(I)%IMH =TOPICS(ITOPIC)%STRESS(J)%IMH
TOPICS(ITOPIC)%STRESS_TMP(I)%IDY =TOPICS(ITOPIC)%STRESS(J)%IDY
TOPICS(ITOPIC)%STRESS_TMP(I)%IHR =TOPICS(ITOPIC)%STRESS(J)%IHR
TOPICS(ITOPIC)%STRESS_TMP(I)%IMT =TOPICS(ITOPIC)%STRESS(J)%IMT
TOPICS(ITOPIC)%STRESS_TMP(I)%ISC =TOPICS(ITOPIC)%STRESS(J)%ISC
DO II=1,SIZE(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES,1)
DO JJ=1,SIZE(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES,2)
TOPICS(ITOPIC)%STRESS_TMP(I)%FILES(II,JJ)=TOPICS(ITOPIC)%STRESS(J)%FILES(II,JJ)
ENDDO
ENDDO
ENDDO
DEALLOCATE(TOPICS(ITOPIC)%STRESS)
TOPICS(ITOPIC)%STRESS=>TOPICS(ITOPIC)%STRESS_TMP
DEALLOCATE(RTIME,ISORT)
ENDIF
ENDIF
END SUBROUTINE PMANAGER_SORTTOPIC
!###======================================================================
INTEGER FUNCTION PMANAGER_GETFNAMES(IL1,IL2,JSYS,JSUB,JPER)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IL1,IL2,JSYS,JSUB,JPER
INTEGER :: KK,I,J,JJ,ISYS,ISUB,IPER,IL
LOGICAL :: LEX
PMANAGER_GETFNAMES=0
KK=0
!## find fnames for model layers
DO IL=IL1,IL2
!## find topics
DO J=1,SIZE(PRJILIST)
JJ=PRJILIST(J)
!## skip last - if that is vcw/kvv
IF(IL1.NE.IL2.AND.IL.EQ.IL2)THEN
IF(JJ.EQ.TVCW.OR.JJ.EQ.TKVV)CYCLE
ENDIF
IF(.NOT.ASSOCIATED(TOPICS(JJ)%STRESS))CYCLE
DO IPER=1,SIZE(TOPICS(JJ)%STRESS)
!## not appropriate system
IF(IPER.NE.JPER.AND.JPER.NE.0)CYCLE
IF(.NOT.ASSOCIATED(TOPICS(JJ)%STRESS(IPER)%FILES))CYCLE
!## number of subtopics
DO ISUB=1,SIZE(TOPICS(JJ)%STRESS(IPER)%FILES,1)
!## not appropriate system
IF(ISUB.NE.JSUB.AND.JSUB.NE.0)CYCLE
!## number of systems
DO ISYS=1,SIZE(TOPICS(JJ)%STRESS(IPER)%FILES,2)
!## not appropriate system
IF(ISYS.NE.JSYS.AND.JSYS.NE.0)CYCLE
!## not appropriate layer
IF(IL.NE.0)THEN
IF(TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%ILAY.NE.IL)CYCLE
ENDIF
KK=KK+1; CALL PMANAGER_INCREASEFNAMES(KK)
FNAMES(KK)%ILAY =TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%ILAY
FNAMES(KK)%ICNST=TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%ICNST
FNAMES(KK)%CNST =TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%CNST
FNAMES(KK)%FCT =TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%FCT
FNAMES(KK)%IMP =TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%IMP
FNAMES(KK)%FNAME=TOPICS(JJ)%STRESS(IPER)%FILES(ISUB,ISYS)%FNAME
!## read only the first appropriate file
EXIT
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
!## actual found files
PMANAGER_GETFNAMES=KK
LINE=TOPICS(PRJILIST(1))%TNAME(1:5)
DO J=2,SIZE(PRJILIST); LINE=TRIM(LINE)//','//TOPICS(PRJILIST(J))%TNAME(1:5); ENDDO
IF(PMANAGER_GETFNAMES.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No compulsory files found for package(s):'//CHAR(13)//TRIM(LINE),'Warning')
!## check whether file(s) exist
DO I=1,KK
!## filename read
IF(FNAMES(I)%ICNST.GT.1)THEN
INQUIRE(FILE=FNAMES(I)%FNAME,EXIST=LEX)
IF(.NOT.LEX)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot find the following file:'//CHAR(13)// &
TRIM(FNAMES(I)%FNAME),'Warning'); PMANAGER_GETFNAMES=0
ENDIF
ENDIF
ENDDO
END FUNCTION PMANAGER_GETFNAMES
!###======================================================================
SUBROUTINE PMANAGER_INCREASEFNAMES(K)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: K
INTEGER :: I,N
IF(.NOT.ASSOCIATED(FNAMES))THEN; ALLOCATE(FNAMES(1)); RETURN; ENDIF
N=SIZE(FNAMES); IF(K.LE.N)RETURN
ALLOCATE(FNAMES_BU(N+10)); DO I=1,N; FNAMES_BU(I)=FNAMES(I); ENDDO
DEALLOCATE(FNAMES); FNAMES=>FNAMES_BU
END SUBROUTINE PMANAGER_INCREASEFNAMES
!###======================================================================
LOGICAL FUNCTION PMANAGER_GETPACKAGES(IOPTION,IBATCH)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IOPTION,IBATCH
INTEGER :: I
PMANAGER_GETPACKAGES=.FALSE.
!## overrule ipst if not as keyword given
IF(IBATCH.EQ.1)THEN
IF(PBMAN%IPEST+PBMAN%IPESTP.EQ.0)TOPICS(TPST)%IACT_MODEL=0
IF(PBMAN%IIES.EQ.0) TOPICS(TIES)%IACT_MODEL=0
ENDIF
!## check if topic is active and complete
DO I=1,MAXTOPICS
TOPICS(I)%NLAY=0; IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE
IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
CALL PMANAGER_GETNFILES((/I/),TOPICS(I)%NLAY,DEFINED=TOPICS(I)%DEFINED)
ENDIF
ENDDO
IF(IOPTION.EQ.0)THEN; PMANAGER_GETPACKAGES=.TRUE.; RETURN; ENDIF
!## turn metaswap off for steady-state
IF(PBMAN%IFORMAT.GT.2)THEN; TOPICS(TCAP)%IACT_MODEL=1
ELSE; IF(PBMAN%ISS.EQ.0)TOPICS(TCAP)%IACT_MODEL=0; ENDIF
IF(TOPICS(TPST)%DEFINED.AND.PBMAN%IPESTP.EQ.0)PBMAN%IPEST=1
IF(TOPICS(TIES)%DEFINED.AND.PBMAN%IIES.EQ.0) PBMAN%IIES=1
!## test if important packages are complete
SELECT CASE (PBMAN%IFORMAT)
!## modflow 2005 (run/nam)
CASE (1,2,3,4)
IF(.NOT.TOPICS(TPCG)%IACT_MODEL.EQ.1)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is compulsory to add a solver, e.g. PCG','Error'); RETURN
ENDIF
LPKS=.FALSE.
IF(TOPICS(TPCG)%IACT_MODEL.EQ.1.AND.PBMAN%IPKS.EQ.1)THEN
TOPICS(TPCG)%DEFINED=.FALSE.; LPKS=.TRUE.
ENDIF
!## mt3d
CASE (5)
IF(.NOT.TOPICS(TGCG)%IACT_MODEL.EQ.1)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is compulsory to add a solver, e.g. GCG','Error'); RETURN
ENDIF
END SELECT
!## if vcw/kvv specified use quasi-3d discretisation
LQBD=.FALSE.; IF(PRJNLAY.GT.1)THEN
IF(TOPICS(TVCW)%NLAY.GT.0.OR.TOPICS(TKVV)%NLAY.GT.0)LQBD=.TRUE.
ENDIF
PMANAGER_GETPACKAGES=.TRUE.
END FUNCTION PMANAGER_GETPACKAGES
!###======================================================================
LOGICAL FUNCTION PMANAGER_INIT_SIMAREA(IDF,IBATCH)
!###======================================================================
IMPLICIT NONE
TYPE(IDFOBJ),INTENT(INOUT) :: IDF
INTEGER,INTENT(IN) :: IBATCH
INTEGER :: I,J,K,II,ISUB,ILAY
PMANAGER_INIT_SIMAREA=.FALSE.
IF(PBMAN%IWINDOW.EQ.3)THEN
!## read other layers as well if needed
IF(PBMAN%SMTYPE.EQ.1)THEN
ISUB=PBMAN%ISUBMODEL
J=0; DO ILAY=1,SIZE(PBMAN%ILAY)
IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; J=J+1
PBMAN%SM(ISUB)%IDF(J)%FNAME=PBMAN%BNDFILE(:INDEX(PBMAN%BNDFILE,'.IDF',.TRUE.)-1)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
IF(.NOT.IDFREAD(PBMAN%SM(ISUB)%IDF(J),PBMAN%SM(ISUB)%IDF(J)%FNAME,1))RETURN
ENDDO
CALL IDFCOPY(PBMAN%SM(ISUB)%IDF(1),IDF)
ELSE
IF(.NOT.IDFREAD(IDF,PBMAN%BNDFILE,1))RETURN
ENDIF
PMANAGER_INIT_SIMAREA=.TRUE.; RETURN
ENDIF
!## get estimated of the current modeldomain
JLOOP: DO K=1,SIZE(TOPICS)
!## skip wel,mnw,hfb,isg,sfr
SELECT CASE (K)
CASE (15,19:21,29,30,33); CYCLE
END SELECT
IF(.NOT.ASSOCIATED(TOPICS(K)%STRESS))CYCLE
DO J=1,SIZE(TOPICS(K)%STRESS)
IF(.NOT.ASSOCIATED(TOPICS(K)%STRESS(J)%FILES))CYCLE
!## number of systems
DO I=1,SIZE(TOPICS(K)%STRESS(J)%FILES,1)
!## number of layers
DO II=1,SIZE(TOPICS(K)%STRESS(J)%FILES,2)
IF(TOPICS(K)%STRESS(J)%FILES(I,II)%ICNST.EQ.2)THEN
IF(.NOT.IDFREAD(IDF,TOPICS(K)%STRESS(J)%FILES(I,II)%FNAME,0))THEN
RETURN
ENDIF
EXIT JLOOP
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO JLOOP
IF(K.GT.SIZE(TOPICS))THEN
IF(IBATCH.EQ.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot determine the size of the model.'//CHAR(13)// &
'Please specify at least ONE IDF file in the PRJ file','Error')
ELSE
WRITE(*,'(/A/)') 'iMOD cannot determine the size of the model. Please specify at least ONE IDF file in the PRJ file or '// &
'specify a simulation window beforehand'
ENDIF
RETURN
ENDIF
!## in case non-equi network is read, et rid of the ieq settings
CALL IDFDEALLOCATESX(IDF); IDF%IEQ=0
PMANAGER_INIT_SIMAREA=.TRUE.
END FUNCTION PMANAGER_INIT_SIMAREA
!###======================================================================
LOGICAL FUNCTION PMANAGER_INITSIM(FNAME,IBATCH,IRUN)
!###======================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(OUT) :: FNAME
INTEGER,INTENT(OUT) :: IRUN
INTEGER,INTENT(IN) :: IBATCH
INTEGER :: ITYPE,IOS,IU
CHARACTER(LEN=52) :: MODELNAME
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: ID,I,J,ISTEP,ITRANSIENT,ISTEADY,N,TMP,IFGROUND,SNAP
LOGICAL :: LEX
INTEGER,DIMENSION(:),ALLOCATABLE :: TMPARRAY
PMANAGER_INITSIM=.FALSE.; IRUN=0
CALL WDIALOGSELECT(ID_DPMANAGER)
!## load dialog
CALL WDIALOGLOAD(ID_DSIMMANAGER,ID_DSIMMANAGER)
!## fill in existing ini files
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
CALL UTL_IMODFILLMENU(IDF_MENU1,TRIM(PREFVAL(1))//'\RUNFILES','*.INI','F',N,0,0)
N=MIN(1,N); CALL WDIALOGFIELDSTATE(ID_OPEN,N); CALL WDIALOGSELECT(ID_DSIMMANAGER)
I=0; IF(.NOT.PMANAGER_INITSIM_INITFIELDS(IBATCH,ITRANSIENT,ISTEADY))I=1
IF(I.EQ.0)THEN
!## put pbman variable on dialogs
IF(.NOT.PMANAGER_INITSIM_PUT_PBMAN())I=1
ENDIF
IF(I.EQ.1)THEN; CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID); RETURN; ENDIF
!## start dialog
IF(IBATCH.EQ.0)THEN
!## zoom to full model dimension
MPW%XMIN=PRJIDF%XMIN; MPW%YMIN=PRJIDF%YMIN
MPW%XMAX=PRJIDF%XMAX; MPW%YMAX=PRJIDF%YMAX
CALL IDFZOOM(ID_DGOTOXY,0.0D0,0.0D0,0); CALL IDFPLOT(1)
SUBMODEL=0.0D0; CALL PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL WDIALOGFIELDOPTIONS(IDF_REAL10,EDITFIELDCHANGED,1)
CALL WDIALOGFIELDOPTIONS(IDF_REAL7,EDITFIELDCHANGED,1)
CALL WDIALOGFIELDOPTIONS(IDF_REAL8,EDITFIELDCHANGED,1)
CALL WDIALOGFIELDOPTIONS(IDF_STRING1,EDITFIELDCHANGED,1)
CALL WDIALOGFIELDOPTIONS(IDF_STRING3,EDITFIELDCHANGED,1)
CALL WDIALOGSELECT(ID_DSIMMANAGER)
CALL UTL_DIALOGSHOW(-1,-1,0,2)
DO
CALL WMESSAGE(ITYPE,MESSAGE)
SELECT CASE (MESSAGE%WIN)
!## main window
CASE(ID_DSIMMANAGER)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
CASE (IDOK) ! Start modelrun
!## fill timesteps - if not yet done
LEX=.TRUE.; IF(.NOT.ASSOCIATED(SIM))LEX=PMANAGER_FILLTIMESTEPS()
IF(LEX)THEN
!## output folder for a runfile
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
CALL WDIALOGGETMENU(IDF_MENU2,I,MODELNAME)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,PBMAN%IFORMAT)
!## name without dot - extent will be added to it below
I=INDEX(MODELNAME,'.',.TRUE.); IF(I.GT.0)MODELNAME=MODELNAME(:I-1)
!## new convention, in stead of variable modelname
PBMAN%MODELNAME=TRIM(MODELNAME)
SELECT CASE (PBMAN%IFORMAT)
!## mf2005-run,seawat-run
CASE (1,4)
PBMAN%OUTPUT=TRIM(PREFVAL(1))//'\MODELS\'//TRIM(PBMAN%MODELNAME)
PBMAN%RUNFILE=TRIM(PBMAN%OUTPUT)//'\'//TRIM(PBMAN%MODELNAME)//'.RUN'
!## mt3d
CASE (5)
CALL WDIALOGGETMENU(IDF_MENU3,I,PBMAN%FLOW_RESULT_DIR)
PBMAN%FLOW_RESULT_DIR=TRIM(PREFVAL(1))//'\MODELS\'//TRIM(PBMAN%FLOW_RESULT_DIR)
PBMAN%OUTPUT=TRIM(PBMAN%FLOW_RESULT_DIR)//'\MT3D\'//TRIM(PBMAN%MODELNAME)
PBMAN%RUNFILE=TRIM(PBMAN%OUTPUT)//'\'//TRIM(PBMAN%MODELNAME)//'.RUN'
!## mf2005-nam,mf6-nam
CASE (2,3)
PBMAN%OUTPUT=TRIM(PREFVAL(1))//'\MODELS\'//TRIM(PBMAN%MODELNAME)
PBMAN%RUNFILE=TRIM(PBMAN%OUTPUT)//'\'//TRIM(PBMAN%MODELNAME)//'.NAM'
END SELECT
!## create folder
CALL UTL_CREATEDIR(PBMAN%OUTPUT)
CALL WMESSAGEBOX(YESNO,COMMONNO,QUESTIONICON,'iMOD will create result folder:'//CHAR(13)// &
'{imod folder}\MODELS\'//TRIM(PBMAN%MODELNAME)//CHAR(13)//CHAR(13)//'Are you sure to continue?','Question')
IF(WINFODIALOG(4) .EQ.1)EXIT
ENDIF
CASE (IDCANCEL)
EXIT
!## start help functionality
CASE (IDHELP)
CALL UTL_GETHELP('*','VMO.iSM.SimManMain')
END SELECT
END SELECT
!## tab1 main configuration tab
CASE(ID_DSIMMANAGER_TAB1)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
CALL PMANAGER_INITSIM_FIELDS_TAB1(MESSAGE%VALUE1,MESSAGE%VALUE2,ITRANSIENT,ISTEADY)
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
CASE (ID_OPEN) !## Open existing INI file batch function RUNFILE
CALL WDIALOGGETMENU(IDF_MENU1,I,FNAME) ! select fname without root from menu
FNAME=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(FNAME) ! add root to fname
IU=UTL_GETUNIT(); OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ')
!## read parameters
IF(.NOT.IMODBATCH_RUNFILE_READ(IU,0))THEN ! should be READ INI FILE?
!## fill dialogs with default PBMAN content
IF(.NOT.PMANAGER_INITSIM_PUT_PBMAN())THEN; ENDIF
ENDIF
CLOSE(IU)
END SELECT
END SELECT
!## tab2 layer/packages
CASE(ID_DSIMMANAGER_TAB2)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
SELECT CASE (MESSAGE%VALUE2)
CASE (IDF_GRID2)
CALL PMANAGER_INITSIM_FIELDS_TAB2()
END SELECT
SELECT CASE (MESSAGE%VALUE1)
END SELECT
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
CASE (ID_APPLY)
CALL PMANAGERLAYERTYPES_PRJNLAY()
CASE (ID_APPLY2)
CALL PMANAGERLAYERTYPES_PRJNLAY_CONFIGALL()
END SELECT
END SELECT
!## tab3 spatial
CASE(ID_DSIMMANAGER_TAB3)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
IF(MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
SELECT CASE (MESSAGE%VALUE2)
CASE (IDF_RADIO1,IDF_RADIO2,IDF_RADIO3,IDF_RADIO4,IDF_RADIO5,IDF_REAL10,IDF_REAL7,IDF_REAL8,IDF_STRING1,IDF_STRING3,IDF_CHECK1)
CALL PMANAGER_INITSIM_FIELDS_TAB3()
END SELECT
ENDIF
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
CASE (ID_DRAW)
CALL WDIALOGGETCHECKBOX(IDF_CHECK2,SNAP)
CALL PMANAGER_INITSIM_DRAW_SIMBOX(SNAP)
CASE (ID_OPEN1)
FNAME=TRIM(PREFVAL(1))//'\*.IDF'
LEX=UTL_WSELECTFILE('Select (network) IDF File (*.idf)|*.idf|', &
LOADDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Select (network) IDF File')
IF(LEX)THEN
CALL WDIALOGPUTSTRING(IDF_STRING2,FNAME)
CALL PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
ENDIF
CASE (ID_OPEN2)
FNAME=TRIM(PREFVAL(1))//'\*.GEN'
LEX=UTL_WSELECTFILE('Select (network) GEN File (*.gen)|*.gen|', &
LOADDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Select (network) GEN File')
IF(LEX)THEN
CALL WDIALOGPUTSTRING(IDF_STRING3,FNAME)
CALL PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
ENDIF
END SELECT
END SELECT
!## tab4 time
CASE(ID_DSIMMANAGER_TAB4)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
SELECT CASE (MESSAGE%VALUE2)
CASE (IDF_RADIO1,IDF_RADIO2)
CALL PMANAGER_INITSIM_FIELDS_TAB4()
CASE (IDF_MENU4)
CALL WDIALOGGETMENU(IDF_MENU4,I)
CALL PMANAGER_TIMESTEPS_GETISTEP(I,J,ISTEP)
CALL WDIALOGPUTINTEGER(IDF_INTEGER12,ISTEP)
CALL WDIALOGFIELDSTATE(IDF_INTEGER12,J)
CASE (IDF_INTEGER2,IDF_INTEGER3,IDF_MENU2)
CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2)
CASE (IDF_INTEGER4,IDF_INTEGER5,IDF_MENU3)
CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU3,IDF_INTEGER4)
END SELECT
SELECT CASE (MESSAGE%VALUE1)
END SELECT
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
CASE (ID_SIMCUSTOMIZE)
!## fill in actual stress periods
IF(PMANAGER_FILLTIMESTEPS())CALL PMANAGER_PUTTIMEINGRID()
CASE (ID_SAVE)
!## store saving (done manually)
I=SIZE(SIM); CALL WGRIDGETINTEGER(IDF_GRID1,3,SIM%ISAVE,I)
CALL WGRIDGETINTEGER(IDF_GRID1,4,SIM%NSTP,I); CALL WGRIDGETDOUBLE(IDF_GRID1,5,SIM%TMULT,I)
CALL PMANAGER_SAVETIMESTEPS(MESSAGE%VALUE1,0,'')
CASE (ID_OPEN)
CALL PMANAGER_SAVETIMESTEPS(MESSAGE%VALUE1,0,'')
END SELECT
END SELECT
!## tab5 output
CASE(ID_DSIMMANAGER_TAB5)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
SELECT CASE (MESSAGE%VALUE2)
CASE (IDF_MENU1)
CALL PMANAGER_INITSIM_PUTISAVE()
CASE (IDF_MENU2)
CALL PMANAGER_INITSIM_GETISAVE()
END SELECT
SELECT CASE (MESSAGE%VALUE1)
CASE (IDF_MENU1)
CALL PMANAGER_INITSIM_PUTISAVE()
CASE (IDF_MENU2)
CALL PMANAGER_INITSIM_GETISAVE()
END SELECT
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
END SELECT
END SELECT
!## tab6 misc
CASE(ID_DSIMMANAGER_TAB6)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
SELECT CASE (MESSAGE%VALUE2)
CASE(IDF_RADIO6,IDF_RADIO7)
END SELECT
SELECT CASE (MESSAGE%VALUE1)
END SELECT
CASE(PUSHBUTTON)
SELECT CASE (MESSAGE%VALUE1)
END SELECT
END SELECT
!## tab6_tab1 misc modflow
CASE(ID_DSIMMANAGER_TAB6_TAB1)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
!## something changed, check all
CALL PMANAGER_INITSIM_FIELDS_TAB6_TAB1()
END SELECT
!## tab6_tab2 misc seawat/mt3d
CASE(ID_DSIMMANAGER_TAB6_TAB2)
CALL WDIALOGSELECT(MESSAGE%WIN)
SELECT CASE (ITYPE)
CASE (FIELDCHANGED)
!## something changed, check all
CALL PMANAGER_INITSIM_FIELDS_TAB6_TAB2()
END SELECT
END SELECT
ENDDO
!## in case iMOD batch
ELSE
!## set modflow2005,modflow6,imod-wq executable
PREFVAL(8) =PBMAN%MODFLOW
PREFVAL(9) =PBMAN%IMOD_WQ
PREFVAL(12)=PBMAN%MODFLOW6
!## save only, or start model as well
MESSAGE%VALUE1=IDOK
ENDIF !## in case iMOD batch
IF(MESSAGE%VALUE1.EQ.IDOK)THEN
!## get values from tab1
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,PBMAN%IFORMAT)
!## get subsoil format BCF or LPF
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO6,I)
SELECT CASE (PBMAN%IFORMAT)
!## RUN file, modflow2005
CASE (1,2)
LBCF=.FALSE.; IF(I.EQ.1)LBCF=.TRUE. !## bcf
LLPF=.FALSE.; IF(I.EQ.2)LLPF=.TRUE. !## lpf
!## mf6
CASE (3)
LBCF=.FALSE.; LLPF=.FALSE.; LNPF=.TRUE.
!## seawat
CASE (4)
LBCF=.FALSE.; IF(I.EQ.1)LBCF=.TRUE. !## bcf
LLPF=.FALSE.; IF(I.EQ.2)LLPF=.TRUE. !## lpf
!## mt3d
CASE (5)
END SELECT
!## simulate on foreground
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IFGROUND)
CALL WDIALOGGETCHECKBOX(IDF_CHECK1,PBMAN%ISOLVE); PBMAN%ISOLVE=ABS(PBMAN%ISOLVE-1)
!## get values from tab2
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
!## get number of modelllayers
CALL WDIALOGGETINTEGER(IDF_INTEGER1,PRJNLAY)
!## get laycon
CALL WGRIDGETMENU(IDF_GRID1,2,LAYCON,PRJNLAY)
!## get active packages
J=SIZE(PCKLIST)
!## use of TMPARRAY to avoid temporary array in wgridgetcheckbox()
ALLOCATE(TMPARRAY(J))
CALL WGRIDGETCHECKBOX(IDF_GRID2,1,TMPARRAY,J)
PCKLIST%IPLIST=TMPARRAY
!## interpolation options
CALL WGRIDGETCHECKBOX(IDF_GRID2,3,TMPARRAY,J)
PCKLIST%KPLIST=TMPARRAY
DEALLOCATE(TMPARRAY)
DO I=1,SIZE(PCKLIST)
TOPICS(PCKLIST(I)%JPLIST)%IACT_MODEL=PCKLIST(I)%IPLIST
ENDDO
DO I=1,SIZE(PCKLIST)
PBMAN%INT(PCKLIST(I)%JPLIST)=PCKLIST(I)%KPLIST
ENDDO
!## get values from tab3
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,PBMAN%IWINDOW)
SELECT CASE (PBMAN%IWINDOW)
!## full extent
CASE (1)
CALL WDIALOGGETDOUBLE(IDF_REAL10,SUBMODEL(5)) !## dimensions from first idf in prj file
!## apply submodelling
CASE (2)
ISUBMODEL=1; SUBMODEL=0.0D0
CALL WDIALOGGETSTRING(IDF_STRING1,LINE)
READ(LINE,*,IOSTAT=IOS) SUBMODEL(1),SUBMODEL(2),SUBMODEL(3),SUBMODEL(4)
CALL WDIALOGGETDOUBLE(IDF_REAL7,SUBMODEL(5)) !## cellsize
CALL WDIALOGGETDOUBLE(IDF_REAL8,SUBMODEL(6)) !## buffer
CALL WDIALOGGETDOUBLE(IDF_REAL9,SUBMODEL(7)) !## buffercs
!## spatial dimension from idf
CASE (3)
CALL WDIALOGGETSTRING(IDF_STRING2,PBMAN%BNDFILE)
ISUBMODEL=0
!## mf6 - gen files
CASE (4)
ISUBMODEL=0
END SELECT
!## get values from tab4
IF(LEN_TRIM(PBMAN%TIMFNAME).NE.0)THEN
CALL PMANAGER_SAVETIMESTEPS(ID_OPEN,1,PBMAN%TIMFNAME)
ELSE
!## read from grid to update sim()
IF(ASSOCIATED(SIM))THEN
CALL WGRIDGETINTEGER(IDF_GRID1,3,SIM%ISAVE,I)
CALL WGRIDGETINTEGER(IDF_GRID1,4,SIM%NSTP ,I)
CALL WGRIDGETDOUBLE(IDF_GRID1, 5,SIM%TMULT,I)
ELSE
LEX=.TRUE.; IF(.NOT.ASSOCIATED(SIM))LEX=PMANAGER_FILLTIMESTEPS()
ENDIF
I=SIZE(SIM)
ENDIF
!## get values from tab5
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB5)
!## save summed systems budget
CALL WDIALOGGETCHECKBOX(IDF_CHECK2,PBMAN%SSYSTEM)
IF(ASSOCIATED(SIM))SIM%ISUM=PBMAN%SSYSTEM
!## output precision
CALL WDIALOGGETCHECKBOX(IDF_CHECK3,PBMAN%IDOUBLE)
CALL WDIALOGGETCHECKBOX(IDF_CHECK4,PBMAN%ISAVEENDDATE)
CALL PMANAGER_INITSIM_GETISAVE()
!## fill in appropriate save conditions in pbman
DO I=1,SIZE(PCKLIST)
IF(SUM(PCKLIST(I)%ILAY).EQ.0)THEN
IF(ASSOCIATED(PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY))DEALLOCATE(PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY)
ELSE
IF(ASSOCIATED(PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY))DEALLOCATE(PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY)
N=0; DO J=1,PRJNLAY; IF(PCKLIST(I)%ILAY(J).EQ.1)N=N+1;ENDDO
ALLOCATE(PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY(N))
N=0; DO J=1,PRJNLAY
IF(PCKLIST(I)%ILAY(J).EQ.1)THEN
N=N+1; PBMAN%ISAVE(PCKLIST(I)%JPLIST)%ILAY(N)=J
ENDIF
ENDDO
ENDIF
ENDDO
!## get values from tab6 mf2005 settings
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB1)
CALL WDIALOGGETMENU(IDF_MENU2,PBMAN%ICONSISTENCY)
PBMAN%ICONSISTENCY=PBMAN%ICONSISTENCY-1
CALL WDIALOGGETDOUBLE(IDF_DOUBLE1,PBMAN%MINTHICKNESS)
CALL WDIALOGGETCHECKBOX(IDF_CHECK1,PBMAN%ICONCHK)
CALL WDIALOGGETCHECKBOX(IDF_CHECK2,PBMAN%ICHKCHD)
CALL WDIALOGGETCHECKBOX(IDF_CHECK3,PBMAN%DWEL)
CALL WDIALOGGETCHECKBOX(IDF_CHECK4,PBMAN%DISG)
CALL WDIALOGGETCHECKBOX(IDF_CHECK5,PBMAN%DSFR)
CALL WDIALOGGETDOUBLE(IDF_DOUBLE2,PBMAN%MINKD)
CALL WDIALOGGETDOUBLE(IDF_DOUBLE3,PBMAN%MINC)
!## iMOD-WQ
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB2)
CALL WDIALOGGETINTEGER(IDF_INTEGER1,PBMAN%BTN%NPROBS)
CALL WDIALOGGETINTEGER(IDF_INTEGER2,PBMAN%BTN%NPRMAS)
CALL WDIALOGGETMENU(IDF_MENU1,TMP) ; PBMAN%ADV%MIXELM=TMP-2
CALL WDIALOGGETMENU(IDF_MENU2,TMP) ; PBMAN%ADV%NADVFD= TMP-1
CALL WDIALOGGETDOUBLE(IDF_DOUBLE1,PBMAN%ADV%PERCEL)
CALL WDIALOGGETINTEGER(IDF_DOUBLE2,PBMAN%SSM%MXSS)
ENDIF
!## remove polygons from mf6
CALL POLYGON1CLOSE()
!## remove dialog
CALL WDIALOGSELECT(ID_DSIMMANAGER); CALL WDIALOGUNLOAD()
IF(IBATCH.EQ.0)THEN
CALL WDIALOGSELECT(ID)
!# redraw graphical canvas
CALL IDFPLOT(1)
ENDIF
IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
!## start the model as well
IF(PBMAN%ISOLVE)IRUN=1; IF(IFGROUND.EQ.0)IRUN=-1
!## final check
IF((ITRANSIENT.EQ.1.AND.ISTEADY.EQ.0).AND.SIZE(SIM).EQ.1)THEN
IF(SIM(1)%DELT.EQ.0.0D0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot start this model as you have defined a timestep length'//CHAR(13)// &
'of zero (steady-state), and all your packages are assigned'//CHAR(13)//'to a transient period.','Warning')
RETURN
ENDIF
ENDIF
PMANAGER_INITSIM=.TRUE.
END FUNCTION PMANAGER_INITSIM
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_DEAL()
!###======================================================================
IMPLICIT NONE
INTEGER :: I
IF(ALLOCATED(LAYCON))DEALLOCATE(LAYCON)
IF(ASSOCIATED(SIM))DEALLOCATE(SIM)
IF(ALLOCATED(PCKLIST))THEN
DO I=1,SIZE(PCKLIST)
IF(ASSOCIATED(PCKLIST(I)%CLAY))DEALLOCATE(PCKLIST(I)%CLAY)
IF(ASSOCIATED(PCKLIST(I)%ILAY))DEALLOCATE(PCKLIST(I)%ILAY)
ENDDO
DEALLOCATE(PCKLIST)
ENDIF
DO I=1,SIZE(PEST%PARAM)
IF(ASSOCIATED(PEST%PARAM(I)%ALPHA_HISTORY))DEALLOCATE(PEST%PARAM(I)%ALPHA_HISTORY)
IF(ASSOCIATED(PEST%PARAM(I)%GALPHA)) DEALLOCATE(PEST%PARAM(I)%GALPHA)
IF(ASSOCIATED(PEST%PARAM(I)%LALPHA)) DEALLOCATE(PEST%PARAM(I)%LALPHA)
IF(ASSOCIATED(PEST%PARAM(I)%ILS)) DEALLOCATE(PEST%PARAM(I)%ILS)
IF(ASSOCIATED(PEST%PARAM(I)%COV)) DEALLOCATE(PEST%PARAM(I)%COV)
IF(ASSOCIATED(PEST%PARAM(I)%INVCOV)) DEALLOCATE(PEST%PARAM(I)%INVCOV)
IF(ASSOCIATED(PEST%PARAM(I)%ISQRTCOV)) DEALLOCATE(PEST%PARAM(I)%ISQRTCOV)
IF(ASSOCIATED(PEST%PARAM(I)%AM)) DEALLOCATE(PEST%PARAM(I)%AM)
IF(ASSOCIATED(PEST%PARAM(I)%MPR)) DEALLOCATE(PEST%PARAM(I)%MPR)
IF(ASSOCIATED(PEST%PARAM(I)%MEAN)) DEALLOCATE(PEST%PARAM(I)%MEAN)
IF(ASSOCIATED(PEST%PARAM(I)%STD)) DEALLOCATE(PEST%PARAM(I)%STD)
ENDDO
END SUBROUTINE PMANAGER_INITSIM_DEAL
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_DRAW_SIMBOX(SNAP)
!###======================================================================
IMPLICIT NONE
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: ITYPE,IDOWN,SNAP,I,J
REAL(KIND=DP_KIND) :: XC1,YC1,XC2,YC2,MOUSEX,MOUSEY
CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(4,'Click your right mouse button to quit')
CALL WCURSORSHAPE(ID_CURSORNETWORK)
IDOWN=0
DO
CALL WMESSAGE(ITYPE, MESSAGE)
MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
MOUSEY=DBLE(MESSAGE%GY)+OFFSETY
IF(SNAP.EQ.1.AND.SUBMODEL(5).GT.0)CALL UTL_IDFSNAPTOGRID(MOUSEX,MOUSEX,MOUSEY,MOUSEY,SUBMODEL(5),I,J)
SELECT CASE(ITYPE)
CASE(MOUSEMOVE)
CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(RTOS(MOUSEX,'G',7))//' m; Y:'//TRIM(RTOS(MOUSEY,'G',7))//' m')
XC2=MOUSEX; YC2=MOUSEY
IF(XC2.LT.PRJIDF%XMIN.OR.XC2.GT.PRJIDF%XMAX.OR. &
YC2.LT.PRJIDF%YMIN.OR.YC2.GT.PRJIDF%YMAX)THEN
IF(WINFOMOUSE(MOUSECURSOR).NE.CURHOURGLASS)CALL WCURSORSHAPE(CURHOURGLASS)
CALL WINDOWOUTSTATUSBAR(2,'Outside model domain')
ELSE
IF(WINFOMOUSE(MOUSECURSOR).NE.ID_CURSORNETWORK)CALL WCURSORSHAPE(ID_CURSORNETWORK)
IF(IDOWN.EQ.1)CALL WINDOWOUTSTATUSBAR(2,'DeltaX:'//TRIM(ITOS(INT(XC2-XC1)))//' m; DeltaY:'//TRIM(ITOS(INT(YC2-YC1)))//' m')
ENDIF
!## first point set
IF(IDOWN.EQ.1)THEN
!## fill in coordinates
WRITE(LINE,*) TRIM(RTOS(MIN(XC1,XC2),'F',3))//','//TRIM(RTOS(MIN(YC1,YC2),'F',3))//','// &
TRIM(RTOS(MAX(XC1,XC2),'F',3))//','//TRIM(RTOS(MAX(YC1,YC2),'F',3))
CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(LINE))
!## remove previous one
CALL PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
ENDIF
!## mouse button pressed
CASE (MOUSEBUTDOWN)
SELECT CASE (MESSAGE%VALUE1)
!## left button
CASE (1)
IF(WINFOMOUSE(MOUSECURSOR).NE.CURHOURGLASS)THEN
IF(IDOWN.EQ.0)THEN
XC1=XC2
YC1=YC2
IDOWN=1
ELSEIF(IDOWN.EQ.1)THEN
EXIT
ENDIF
ENDIF
!## right button
CASE (3)
EXIT
END SELECT
CASE (BITMAPSCROLLED)
MPW%IX=MESSAGE%VALUE1
MPW%IY=MESSAGE%VALUE2
END SELECT
ENDDO
CALL WCURSORSHAPE(CURARROW); CALL IGRPLOTMODE(MODECOPY)
CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(2,''); CALL WINDOWOUTSTATUSBAR(4,'')
END SUBROUTINE PMANAGER_INITSIM_DRAW_SIMBOX
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_PLOT_SIMBOX()
!###======================================================================
IMPLICIT NONE
REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2
INTEGER :: I,J,STRLEN,IOS
CHARACTER(LEN=:),ALLOCATABLE :: STRING
!## nothing to draw
IF(SUM(SUBMODEL).EQ.0.0D0)RETURN
CALL UTL_PLOT1BITMAP(); CALL IGRPLOTMODE(MODEXOR)
IF(PBMAN%IGENMF6.EQ.0)THEN
!## black - area of interest
X1=SUBMODEL(1); X2=SUBMODEL(3); Y1=SUBMODEL(2); Y2=SUBMODEL(4)
CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGUP)
CALL IGRCOLOURN(UTL_INVERSECOLOUR(WRGB(0,0,0)))
IF(ABS(X1-X2).GT.0.0D0.AND.ABS(Y2-Y1).GT.0.0D0)CALL DBL_IGRRECTANGLE(X1,Y1,X2,Y2,IOFFSET=1)
CALL IGRFILLPATTERN(OUTLINE); CALL IGRLINEWIDTH(5)
IF(ABS(X1-X2).GT.0.0D0.AND.ABS(Y2-Y1).GT.0.0D0)CALL DBL_IGRRECTANGLE(X1,Y1,X2,Y2,IOFFSET=1)
!## buffer - green
X1=MAX(SUBMODEL(1)-SUBMODEL(6),PRJIDF%XMIN)
X2=MIN(SUBMODEL(3)+SUBMODEL(6),PRJIDF%XMAX)
Y1=MAX(SUBMODEL(2)-SUBMODEL(6),PRJIDF%YMIN)
Y2=MIN(SUBMODEL(4)+SUBMODEL(6),PRJIDF%YMAX)
CALL IGRCOLOURN(UTL_INVERSECOLOUR(WRGB(0,255,0)))
IF(ABS(X1-X2).GT.0.0D0.AND.ABS(Y2-Y1).GT.0.0D0)CALL DBL_IGRRECTANGLE(X1,Y1,X2,Y2,IOFFSET=1)
!## total model area
X1=PRJIDF%XMIN; X2=PRJIDF%XMAX; Y1=PRJIDF%YMIN; Y2=PRJIDF%YMAX
CALL IGRCOLOURN(UTL_INVERSECOLOUR(WRGB(0,0,255)))
IF(ABS(X1-X2).GT.0.0D0.AND.ABS(Y2-Y1).GT.0.0D0)CALL DBL_IGRRECTANGLE(X1,Y1,X2,Y2,IOFFSET=1)
CALL IGRLINEWIDTH(1); CALL IGRFILLPATTERN(SOLID)
!## draw mf6 network
ELSE
CALL IGRFILLPATTERN(OUTLINE); CALL IGRLINEWIDTH(5)
DO I=1,SHP%NPOL
CALL IGRCOLOURN(UTL_INVERSECOLOUR(ICOLOR(I)))
IF(SHP%POL(I)%ITYPE.EQ.ID_POLYGON)THEN
CALL DBL_IGRPOLYGONSIMPLE(SHP%POL(I)%X,SHP%POL(I)%Y,SHP%POL(I)%N,IOFFSET=1)
ENDIF
ENDDO
CALL IGRFILLPATTERN(OUTLINE); CALL IGRLINEWIDTH(1)
!## draw network
STRLEN=SHP%LWIDTH(2); ALLOCATE(CHARACTER(LEN=STRLEN) :: STRING)
DO I=1,SHP%NPOL
CALL IGRCOLOURN(UTL_INVERSECOLOUR(ICOLOR(I)))
!## get cellsize
DO J=1,SHP%LWIDTH(SHP%ILBL); STRING(J:J)=TRIM(SHP%POL(I)%LBL(2)%STRING(J)); ENDDO
READ(STRING,*,IOSTAT=IOS) DX
Y1=SHP%POL(I)%YMIN; Y2=SHP%POL(I)%YMAX
DO X1=SHP%POL(I)%XMIN,SHP%POL(I)%XMAX,DX; CALL DBL_IGRJOIN(X1,Y1,X1,Y2,IOFFSET=1); ENDDO
X1=SHP%POL(I)%XMIN; X2=SHP%POL(I)%XMAX
DO Y1=SHP%POL(I)%YMIN,SHP%POL(I)%YMAX,DX; CALL DBL_IGRJOIN(X1,Y1,X2,Y1,IOFFSET=1); ENDDO
ENDDO
DEALLOCATE(STRING)
ENDIF
CALL UTL_PLOT2BITMAP(); CALL IGRPLOTMODE(MODECOPY)
END SUBROUTINE PMANAGER_INITSIM_PLOT_SIMBOX
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB1(ID1,ID2,ITRANSIENT,ISTEADY)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ID1,ID2,ITRANSIENT,ISTEADY
INTEGER :: I,J,N,ID,IFORMAT,IDTAB
CHARACTER(LEN=256) :: DIR
IF(ID1.NE.ID2)RETURN
ID=WINFODIALOG(CURRENTDIALOG)
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IFORMAT)
!## only refresh if
SELECT CASE (ID1)
CASE (IDF_RADIO1,IDF_RADIO2,IDF_RADIO3,IDF_RADIO4,IDF_RADIO5,IDF_RADIO6)
SELECT CASE (IFORMAT)
!## mf2005-run, seawat-run, mf2005-nam, mf6-nam
CASE (1,2,3,4)
CALL UTL_IMODFILLMENU(IDF_MENU2,TRIM(PREFVAL(1))//'\MODELS','*','D',N,0,0)
CALL WDIALOGPUTSTRING(IDF_LABEL25,'Enter or Select Output Folder:')
I=0; J=1
!## mt3d
CASE (5)
CALL UTL_IMODFILLMENU(IDF_MENU3,TRIM(PREFVAL(1))//'\MODELS','*','D',N,0,0)
CALL WDIALOGPUTSTRING(IDF_LABEL3,'Select Existing iMOD Results:')
CALL WDIALOGGETMENU(IDF_MENU3,N,DIR)
CALL UTL_IMODFILLMENU(IDF_MENU2,TRIM(PREFVAL(1))//'\MODELS\'//TRIM(DIR)//'\MT3D','*','D',N,0,0)
CALL WDIALOGPUTSTRING(IDF_LABEL25,'Enter or Select MT3D Folder:')
I=1; J=1
!## modpath
CASE (6)
CALL UTL_IMODFILLMENU(IDF_MENU3,TRIM(PREFVAL(1))//'\MODELS','*','D',N,0,0)
CALL WDIALOGPUTSTRING(IDF_LABEL3,'Select Existing iMOD Results:')
I=1; J=0
END SELECT
CALL WDIALOGFIELDSTATE(IDF_MENU3 ,I); CALL WDIALOGFIELDSTATE(IDF_LABEL3 ,I)
CALL WDIALOGFIELDSTATE(IDF_MENU2 ,J); CALL WDIALOGFIELDSTATE(IDF_LABEL25,J)
CASE (IDF_MENU3)
CALL WDIALOGGETMENU(IDF_MENU3,N,DIR)
CALL UTL_IMODFILLMENU(IDF_MENU2,TRIM(PREFVAL(1))//'\MODELS\'//TRIM(DIR)//'\MT3D','*','D',N,0,0)
END SELECT
!## option to read in genfiles only for mf6
I=0; IF(IFORMAT.EQ.3)I=1
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL WDIALOGFIELDSTATE(IDF_RADIO4,I)
! J=I; IF(I.EQ.1)THEN
! CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,J); IF(J.NE.4)J=0
! ENDIF
! CALL WDIALOGFIELDSTATE(ID_OPEN2,I)
!## if mt3d than transient is always possible, not for others
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
IF(IFORMAT.EQ.5)THEN
CALL WDIALOGFIELDSTATE(IDF_RADIO2,1)
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
CALL WDIALOGFIELDSTATE(IDF_RADIO1,0)
ELSE
CALL WDIALOGFIELDSTATE(IDF_RADIO2,ITRANSIENT)
IF(ITRANSIENT.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
CALL WDIALOGFIELDSTATE(IDF_RADIO1,ISTEADY)
IF(ISTEADY.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
ENDIF
CALL PMANAGER_INITSIM_FIELDS_TAB4()
SELECT CASE (IFORMAT)
CASE (1,2,3); IDTAB=ID_DSIMMANAGER_TAB6_TAB1; I=1; J=0
CASE (4,5); IDTAB=ID_DSIMMANAGER_TAB6_TAB2; I=0; J=1
CASE (6); IDTAB=0
END SELECT
CALL WDIALOGSELECT(ID_DSIMMANAGER)
IF(IDTAB.NE.0)THEN
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB2,1)
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB5,1)
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB6,1)
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6)
CALL WDIALOGTABSTATE(IDF_TAB1,ID_DSIMMANAGER_TAB6_TAB1,I)
CALL WDIALOGTABSTATE(IDF_TAB1,ID_DSIMMANAGER_TAB6_TAB2,J)
CALL WDIALOGSETTAB(IDF_TAB1,IDTAB)
!## modpath
ELSE
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB2,0) !## no packages/layers
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB5,0) !## no output
CALL WDIALOGTABSTATE(IDF_TAB,ID_DSIMMANAGER_TAB6,0) !## no misc
ENDIF
!## minimal thickness depends on picked configuration
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB1)
I=0; IF(IFORMAT.EQ.2)I=1
CALL WDIALOGFIELDSTATE(IDF_DOUBLE1,I) !## consistency checking
CALL WDIALOGFIELDSTATE(IDF_MENU2 ,I) !## consistency checking
CALL WDIALOGFIELDSTATE(IDF_LABEL2, I) !## consistency checking
CALL WDIALOGFIELDSTATE(IDF_LABEL11,I) !## consistency checking
!## minkd/minc
I=0; IF(IFORMAT.LE.2)I=1
CALL WDIALOGFIELDSTATE(IDF_DOUBLE2,I) !## minkd
CALL WDIALOGFIELDSTATE(IDF_DOUBLE3,I) !## minc
CALL WDIALOGFIELDSTATE(IDF_LABEL3, I) !## minkd
CALL WDIALOGFIELDSTATE(IDF_LABEL4, I) !## minc
CALL WDIALOGFIELDSTATE(IDF_LABEL12,I) !## minkd
CALL WDIALOGFIELDSTATE(IDF_LABEL13,I) !## minc
CALL WDIALOGFIELDSTATE(IDF_CHECK1,I) !## iconchk
CALL WDIALOGFIELDSTATE(IDF_CHECK6,I) !## ifwdl
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
I=0; SELECT CASE (IFORMAT); CASE (4,5); I=2; END SELECT
CALL WGRIDSTATE(IDF_GRID1,6,I); CALL WGRIDSTATE(IDF_GRID1,7,I)
CALL WGRIDSTATE(IDF_GRID1,8,I); CALL WGRIDSTATE(IDF_GRID1,9,I)
CALL PMANAGER_INITSIM_FIELDS_TAB3()
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB1
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB2()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID,N,I
ID=WINFODIALOG(CURRENTDIALOG)
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
N=SIZE(PCKLIST)
CALL WGRIDGETCHECKBOX(IDF_GRID2,1,PCKLIST%IPLIST,N)
DO I=1,N
IF(PCKLIST(I)%IPLIST.EQ.1)THEN
CALL WGRIDCOLOURROW(IDF_GRID2,I,-1,-1)
ELSE
CALL WGRIDCOLOURROW(IDF_GRID2,I,-1,WRGB(255,0,0))
ENDIF
ENDDO
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB2
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB3()
!###======================================================================
IMPLICIT NONE
INTEGER :: I,ID
INTEGER,DIMENSION(4) :: IACT
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
!## window or bndfile
IACT=0 ; CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I); IACT(I)=1
CALL WDIALOGFIELDSTATE(IDF_LABEL4 ,IACT(1))
CALL WDIALOGFIELDSTATE(IDF_REAL10 ,IACT(1))
CALL WDIALOGFIELDSTATE(IDF_LABEL16,IACT(1))
CALL WDIALOGFIELDSTATE(IDF_CHECK3 ,IACT(1))
CALL WDIALOGFIELDSTATE(ID_DRAW ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_LABEL3 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_LABEL9 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_LABEL13,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_LABEL14,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_REAL7 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_REAL8 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_CHECK1 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_CHECK2 ,IACT(2))
CALL WDIALOGFIELDSTATE(IDF_STRING1,IACT(2))
I=0; IF(IACT(2).EQ.1)CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
CALL WDIALOGFIELDSTATE(IDF_REAL9 ,I)
CALL WDIALOGFIELDSTATE(IDF_LABEL15,I)
CALL WDIALOGFIELDSTATE(IDF_OPEN1 ,IACT(3))
CALL WDIALOGFIELDSTATE(IDF_STRING2,IACT(3))
CALL WDIALOGFIELDSTATE(ID_OPEN1, IACT(3))
CALL WDIALOGFIELDSTATE(IDF_OPEN2 ,IACT(4))
CALL WDIALOGFIELDSTATE(IDF_STRING3,IACT(4))
CALL WDIALOGFIELDSTATE(ID_OPEN2, IACT(4))
CALL PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB3
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_PLOT_NETWORK()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID,IOS,INICE,NCOL,NROW,IWINDOW
CHARACTER(LEN=256) :: DIR
ID=WINFODIALOG(CURRENTDIALOG)
!## remove previous network
CALL PMANAGER_INITSIM_PLOT_SIMBOX()
SUBMODEL=0.0D0; PBMAN%IGENMF6=0
!## get values from tab3
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IWINDOW)
SELECT CASE (IWINDOW)
!## full extent
CASE (1)
SUBMODEL(1)=PRJIDF%XMIN; SUBMODEL(2)=PRJIDF%YMIN; SUBMODEL(3)=PRJIDF%XMAX; SUBMODEL(4)=PRJIDF%YMAX
CALL WDIALOGGETDOUBLE(IDF_REAL10,SUBMODEL(5)) !## dimensions from first idf in prj file
IF(SUBMODEL(5).LE.0.0D0)SUBMODEL=0.0D0
CALL WDIALOGGETCHECKBOX(IDF_CHECK3,INICE)
!## apply submodelling
CASE (2)
CALL WDIALOGGETSTRING(IDF_STRING1,LINE)
READ(LINE,*,IOSTAT=IOS) SUBMODEL(1),SUBMODEL(2),SUBMODEL(3),SUBMODEL(4)
IF(IOS.NE.0)SUBMODEL=0.0D0
CALL WDIALOGGETDOUBLE(IDF_REAL7,SUBMODEL(5)) !## cellsize
IF(SUBMODEL(5).LE.0.0D0)SUBMODEL=0.0D0
CALL WDIALOGGETDOUBLE(IDF_REAL8,SUBMODEL(6)) !## buffer
SUBMODEL(6)=MAX(0.0D0,SUBMODEL(6))
CALL WDIALOGGETDOUBLE(IDF_REAL9,SUBMODEL(7)) !## buffercs
SUBMODEL(7)=MAX(0.0D0,SUBMODEL(7))
CALL WDIALOGGETCHECKBOX(IDF_CHECK2,INICE)
!## spatial dimension from idf
CASE (3)
CALL WDIALOGGETSTRING(IDF_STRING2,PBMAN%BNDFILE)
IF(TRIM(PBMAN%BNDFILE).NE.'')THEN
IF(IDFREAD(IDF,PBMAN%BNDFILE,0))THEN
SUBMODEL(1)=IDF%XMIN; SUBMODEL(2)=IDF%YMIN; SUBMODEL(3)=IDF%XMAX; SUBMODEL(4)=IDF%YMAX
SUBMODEL(5)=IDF%DX
ENDIF
ENDIF
!## mf6 - gen files
CASE (4)
!## compute network from gen file
PBMAN%IGENMF6=1; CALL WDIALOGGETSTRING(IDF_STRING3,PBMAN%GENFNAME)
IF(TRIM(PBMAN%GENFNAME).NE.'')THEN
DIR=TRIM(PREFVAL(1))//'\TMP'
CALL PMANAGER_GENERATEMFNETWORKS(PBMAN%GENFNAME,DIR,PBMAN%NSUBMODEL,0,0)
SUBMODEL(1)=SHP%XMIN; SUBMODEL(2)=SHP%YMIN; SUBMODEL(3)=SHP%XMAX; SUBMODEL(4)=SHP%YMAX
ENDIF
END SELECT
IF(SUM(SUBMODEL).NE.0.0D0)THEN
IF(PBMAN%IGENMF6.EQ.0)THEN
SELECT CASE (IWINDOW)
!## compute network
CASE (1,2)
IF(INICE.EQ.1)THEN
CALL UTL_IDFSNAPTONICEGRID(SUBMODEL(1),SUBMODEL(3),SUBMODEL(2),SUBMODEL(4),SUBMODEL(5),NCOL,NROW)
ELSE
CALL UTL_IDFSNAPTOGRID_LLC(SUBMODEL(1),SUBMODEL(3),SUBMODEL(2),SUBMODEL(4),SUBMODEL(5),SUBMODEL(5),NCOL,NROW,LLC=.TRUE.)
ENDIF
CASE DEFAULT
CALL UTL_IDFSNAPTOGRID_LLC(SUBMODEL(1),SUBMODEL(3),SUBMODEL(2),SUBMODEL(4),SUBMODEL(5),SUBMODEL(5),NCOL,NROW,LLC=.TRUE.)
END SELECT
ENDIF
!## draw new network
CALL PMANAGER_INITSIM_PLOT_SIMBOX()
!## define model
CALL WDIALOGPUTDOUBLE(IDF_REAL4,SUBMODEL(1),'(F15.3)') !## xmin
CALL WDIALOGPUTDOUBLE(IDF_REAL5,SUBMODEL(2),'(F15.3)') !## ymin
CALL WDIALOGPUTDOUBLE(IDF_REAL1,SUBMODEL(3),'(F15.3)') !## xmax
CALL WDIALOGPUTDOUBLE(IDF_REAL2,SUBMODEL(4),'(F15.3)') !## ymax
CALL WDIALOGPUTDOUBLE(IDF_REAL6,SUBMODEL(3)-SUBMODEL(1),'(F15.3)') !## xmax
CALL WDIALOGPUTDOUBLE(IDF_REAL3,SUBMODEL(4)-SUBMODEL(2),'(F15.3)') !## ymax
IF(PBMAN%IGENMF6.EQ.0)THEN
CALL WDIALOGFIELDSTATE(IDF_INTEGER1,0)
CALL WDIALOGFIELDSTATE(IDF_INTEGER2,0)
CALL WDIALOGPUTINTEGER(IDF_INTEGER1,NCOL)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2,NROW)
ELSE
CALL WDIALOGFIELDSTATE(IDF_INTEGER1,3)
CALL WDIALOGFIELDSTATE(IDF_INTEGER2,3)
ENDIF
PBMAN%XMIN=SUBMODEL(1)
PBMAN%YMIN=SUBMODEL(2)
PBMAN%XMAX=SUBMODEL(3)
PBMAN%YMAX=SUBMODEL(4)
PBMAN%CELLSIZE=SUBMODEL(5)
PBMAN%BUFFER=SUBMODEL(6)
PBMAN%BUFFERCS=SUBMODEL(7)
ELSE
CALL WDIALOGCLEARFIELD(IDF_REAL4); CALL WDIALOGCLEARFIELD(IDF_REAL5)
CALL WDIALOGCLEARFIELD(IDF_REAL1); CALL WDIALOGCLEARFIELD(IDF_REAL2)
CALL WDIALOGCLEARFIELD(IDF_INTEGER1); CALL WDIALOGCLEARFIELD(IDF_INTEGER2)
ENDIF
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_PLOT_NETWORK
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB4()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID,I,J
INTEGER,DIMENSION(25) :: DID
DATA DID/IDF_INTEGER2, IDF_INTEGER3,IDF_MENU2, IDF_INTEGER4,IDF_INTEGER5, IDF_MENU3 , &
IDF_INTEGER6, IDF_INTEGER7,IDF_INTEGER8, IDF_INTEGER9,IDF_INTEGER10,IDF_INTEGER11, &
IDF_INTEGER12,IDF_MENU4, ID_SIMCUSTOMIZE,IDF_CHECK2, IDF_GROUP2, IDF_GRID1, &
ID_OPEN ,ID_SAVE, IDF_LABEL3 ,IDF_INTEGER15,IDF_LABEL4, IDF_LABEL6, &
IDF_LABEL7/
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,J); J=ABS(J-1)
DO I=1,SIZE(DID); CALL WDIALOGFIELDSTATE(DID(I),J); ENDDO
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB4
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB5()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB5)
! CALL PMANAGER_INITSIM_GETISAVE()
CALL PMANAGER_INITSIM_PUTISAVE()
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB5
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB6_TAB1()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB1)
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB6_TAB1
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB6_TAB2()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB2)
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_FIELDS_TAB6_TAB2
!###======================================================================
LOGICAL FUNCTION PMANAGER_INITSIM_INITFIELDS(IBATCH,ITRANSIENT,ISTEADY)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IBATCH
INTEGER,INTENT(OUT) :: ITRANSIENT,ISTEADY
INTEGER :: ID,IDY,IYR,IMH,ITOPIC,IPER,I,J,K,MINJD,MAXJD,IDATE,IHR,IMT,ISC,IHMS,MINHMS,MAXHMS,ISTEP
PMANAGER_INITSIM_INITFIELDS=.FALSE.
!## initiate existence of packages
IF(.NOT.PMANAGER_GETPACKAGES(0,IBATCH))RETURN
ID=WINFODIALOG(CURRENTDIALOG)
!## use as unconfined
IF(.NOT.ASSOCIATED(PBMAN%UNCONFINED))THEN; ALLOCATE(PBMAN%UNCONFINED(1)); PBMAN%UNCONFINED(1)=0; ENDIF
!## initiate settings for iMOD GUI (all 'optional' in iMOD Batch)
IF(IBATCH.EQ.0)THEN
CALL IMODBATCH_RUNFILE_INITPBMAN()
PBMAN%CMDHIDE=PEST%CMDHIDE
PBMAN%NCPU=PEST%NCPU
PBMAN%NLINESEARCH=PEST%NLINESEARCH
PBMAN%IPESTP=PEST%IPESTP
IF(PBMAN%IPESTP.EQ.0)PBMAN%IPEST=1
!## check whether ipest package is active
IF(.NOT.TOPICS(TPST)%DEFINED)THEN
PBMAN%IPEST=0; PBMAN%IPESTP=0
ENDIF
ENDIF
!## set package settings bcf,lpf
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6)
I=0; IF(TOPICS(TKDW)%DEFINED)THEN
I=1; IF(PRJNLAY.GT.1)THEN
IF(.NOT.TOPICS(TVCW)%DEFINED)I=0
ENDIF
ENDIF
CALL WDIALOGFIELDSTATE(IDF_RADIO6,I); IF(I.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO6)
I=0; IF(TOPICS(TTOP)%DEFINED.AND. &
TOPICS(TBOT)%DEFINED.AND. &
TOPICS(TKVA)%DEFINED.AND. &
TOPICS(TKHV)%DEFINED)I=1
CALL WDIALOGFIELDSTATE(IDF_RADIO7,I); IF(I.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO7)
!## if lake or uzf package activated, make sure top/bot are active too
IF(TOPICS(TLAK)%DEFINED.OR.TOPICS(TUZF)%DEFINED)THEN
J=0; IF(TOPICS(TTOP)%DEFINED.AND.TOPICS(TBOT)%DEFINED)J=1
IF(J.EQ.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'For usage of the LAK or UZF package you need to'//CHAR(13)// &
'specify TOP and BOT packages as well','Warning'); RETURN
ENDIF
ENDIF
!## look for any boundary file (first) not equal to constant values
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL IDFNULLIFY(PRJIDF)
IF(.NOT.PMANAGER_INIT_SIMAREA(PRJIDF,IBATCH))THEN
CALL IDFDEALLOCATEX(PRJIDF); RETURN
ENDIF
IF(TRIM(PBMAN%BNDFILE).NE.'')THEN
CALL WDIALOGPUTSTRING(IDF_STRING2,PBMAN%BNDFILE); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3)
ELSE
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1); CALL WDIALOGPUTSTRING(IDF_STRING2,'')
ENDIF
CALL WDIALOGPUTSTRING(IDF_STRING3,'Enter GENFILE')
!## found any of the given IDF-files that could serve as simulation window
IF(PRJIDF%DX.GT.0.0D0)THEN
CALL WDIALOGPUTDOUBLE(IDF_REAL5,PRJIDF%DX,'(G12.7)')
ELSE
CALL WDIALOGPUTDOUBLE(IDF_REAL5,25.0D0,'(G12.7)')
ENDIF
CALL IDFDEALLOCATEX(PRJIDF)
IF(.NOT.PMANAGER_GETMAXLAYERS((/TTOP,TBOT,TBND,TSHD,TKDW,TKHV,TKVA,TVCW,TKVV,TSTO,TSPY/),IBATCH))RETURN
IF(IBATCH.EQ.0)THEN
ALLOCATE(PBMAN%ISAVE(TSHD)%ILAY(1)); PBMAN%ISAVE(TSHD)%ILAY=-1
ENDIF
!## fill menu with active packages
CALL PMANAGER_INITSIM_PACKAGES()
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
!## spatial setting
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
CALL WDIALOGPUTIMAGE(ID_OPEN1,ID_ICONOPEN,1)
CALL WDIALOGPUTIMAGE(ID_OPEN2,ID_ICONOPEN,1)
ISTEADY=0; ITRANSIENT=0; MINJD=10.0D07; MAXJD=-10.0D07; MINHMS=246060; MAXHMS=0.0D0
DO ITOPIC=1,MAXTOPICS
IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS))CYCLE
IF(.NOT.TOPICS(ITOPIC)%TIMDEP)CYCLE
DO IPER=1,SIZE(TOPICS(ITOPIC)%STRESS)
IF(TRIM(UTL_CAP(TOPICS(ITOPIC)%STRESS(IPER)%CDATE,'U')).EQ.'STEADY-STATE')THEN
ISTEADY=1
ELSE
IYR=TOPICS(ITOPIC)%STRESS(IPER)%IYR; IMH=TOPICS(ITOPIC)%STRESS(IPER)%IMH; IDY=TOPICS(ITOPIC)%STRESS(IPER)%IDY
IHR=TOPICS(ITOPIC)%STRESS(IPER)%IHR; IMT=TOPICS(ITOPIC)%STRESS(IPER)%IMT; ISC=TOPICS(ITOPIC)%STRESS(IPER)%ISC
!## date entered
IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN
ITRANSIENT=1
IDATE=JD(IYR,IMH,IDY); IHMS=HMSTOITIME(IHR,IMT,ISC)
IF(IDATE.LE.MINJD)THEN
MINJD=MIN(MINJD,IDATE); IF(IHMS.LT.MINHMS)MINHMS=IHMS
ENDIF
IF(IDATE.GE.MAXJD)THEN
MAXJD=MAX(MAXJD,IDATE); IF(IHMS.GT.MAXHMS)MAXHMS=IHMS
ENDIF
ELSE
!## probably period definition?
DO J=1,NPERIOD
IF(TRIM(UTL_CAP(TOPICS(ITOPIC)%STRESS(IPER)%CDATE,'U')).EQ.TRIM(UTL_CAP(PERIOD(J)%NAME,'U')))EXIT
ENDDO
!## see whether the current stress is within mentioned period
IF(J.LE.NPERIOD)THEN
ITRANSIENT=1
DO K=1,2
IYR=PERIOD(J)%IYR; IMH=PERIOD(J)%IMH; IDY=PERIOD(J)%IDY
IHR=PERIOD(J)%IHR; IMT=PERIOD(J)%IMT; ISC=PERIOD(J)%ISC
IDATE=JD(IYR,IMH,IDY); IHMS=HMSTOITIME(IHR,IMT,ISC)
IF(IDATE.LE.MINJD)THEN
MINJD=MIN(MINJD,IDATE); IF(IHMS.LT.MINHMS)MINHMS=IHMS
ENDIF
IF(IDATE.GE.MAXJD)THEN
MAXJD=MAX(MAXJD,IDATE); IF(IHMS.GT.MAXHMS)MAXHMS=IHMS
ENDIF
ENDDO
ELSE
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot convert date ['//TRIM(TOPICS(ITOPIC)%STRESS(IPER)%CDATE)//'] for'//CHAR(13)// &
'Topic '//TRIM(TOPICS(ITOPIC)%TNAME),'Warning')
RETURN
ENDIF
ENDIF
ENDIF
ENDDO
ENDDO
!## timestepping setting
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVEAS,1)
CALL WDIALOGPUTMENU(IDF_MENU4,TMENU1,SIZE(TMENU1),9)
!## no transient data found
IF(ITRANSIENT.EQ.0)THEN
IYR=2000; IMH=1; IDY=1; IHR=0; IMT=0; ISC=0
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
CALL WDIALOGPUTMENU(IDF_MENU2,CDATE,12,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2,IDY)
CALL WDIALOGPUTINTEGER(IDF_INTEGER3,IYR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER6,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER7,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER8,ISC)
CALL WDIALOGPUTMENU(IDF_MENU3,CDATE,12,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IDY)
CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IYR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER9,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER10,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER11,ISC)
!## transient data found
ELSE
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
IF(ISTEADY.EQ.0)THEN
CALL WDIALOGFIELDSTATE(IDF_RADIO1,0)
CALL WDIALOGFIELDSTATE(IDF_CHECK2,0)
PBMAN%ISS=1
ELSE
CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,1)
ENDIF
CALL UTL_GDATE(MINJD,IYR,IMH,IDY)
CALL WDIALOGPUTMENU(IDF_MENU2,CDATE,12,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2,IDY)
CALL WDIALOGPUTINTEGER(IDF_INTEGER3,IYR)
CALL ITIMETOHMS(MINHMS,IHR,IMT,ISC)
CALL WDIALOGPUTINTEGER(IDF_INTEGER6,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER7,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER8,ISC)
IF(PBMAN%SDATE.LE.0)PBMAN%SDATE=YMDHMSTOITIME(IYR,IMH,IDY,IHR,IMT,ISC)
CALL UTL_GDATE(MAXJD,IYR,IMH,IDY)
CALL WDIALOGPUTMENU(IDF_MENU3,CDATE,12,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IDY)
CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IYR)
CALL ITIMETOHMS(MAXHMS,IHR,IMT,ISC)
CALL WDIALOGPUTINTEGER(IDF_INTEGER9,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER10,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER11,ISC)
IF(PBMAN%EDATE.LE.0)PBMAN%EDATE=YMDHMSTOITIME(IYR,IMH,IDY,IHR,IMT,ISC)
ENDIF
!## get user defined time settings
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
CALL WDIALOGGETMENU(IDF_MENU4,I)
CALL PMANAGER_TIMESTEPS_GETISTEP(I,J,ISTEP)
CALL WDIALOGPUTINTEGER(IDF_INTEGER12,ISTEP)
CALL WDIALOGFIELDSTATE(IDF_INTEGER12,J)
IF(IBATCH.EQ.0)THEN
PBMAN%ISOLVE=1 ! Default in Batch is 0. Determines init. checkbox on ID_DSIMMANAGER_TAB1
!## come from radio5, goto radio1
CALL PMANAGER_INITSIM_FIELDS_TAB1(IDF_RADIO1,IDF_RADIO1,ITRANSIENT,ISTEADY)
CALL PMANAGER_INITSIM_FIELDS_TAB2()
CALL PMANAGER_INITSIM_FIELDS_TAB3()
CALL PMANAGER_INITSIM_FIELDS_TAB4()
ENDIF
CALL WDIALOGSELECT(ID)
PMANAGER_INITSIM_INITFIELDS=.TRUE.
END FUNCTION PMANAGER_INITSIM_INITFIELDS
!###======================================================================
LOGICAL FUNCTION PMANAGER_INITSIM_PUT_PBMAN()
!###======================================================================
IMPLICIT NONE
INTEGER :: I,IYR,ISC,IMT,IMH,IHR,IDY,TMP
PMANAGER_INITSIM_PUT_PBMAN=.FALSE.
!## settings for tab1
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB1)
!## define model configuration
SELECT CASE (PBMAN%IFORMAT)
!## runfile
CASE (1); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
!## mf2005
CASE (2); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
!## mf6
CASE (3); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3)
!## seawat
CASE (4); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO4)
!## mt3d
CASE (5); CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO5)
END SELECT
!## check box 'create input files only'
CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,ABS(PBMAN%ISOLVE-1))
!## settings for tab2 - spatial
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB3)
!## first idf
IF(PBMAN%IWINDOW.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
!## window
IF(PBMAN%IWINDOW.EQ.2)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
!## network idf
IF(PBMAN%IWINDOW.EQ.3)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3)
!## network igen (in case of MF6)
IF(PBMAN%IWINDOW.EQ.4)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO4)
CALL WDIALOGPUTDOUBLE(IDF_REAL4,PBMAN%XMIN,'(F15.3)') ! MPW = zoomwindow
CALL WDIALOGPUTDOUBLE(IDF_REAL5,PBMAN%YMIN,'(F15.3)')
CALL WDIALOGPUTDOUBLE(IDF_REAL1,PBMAN%XMAX,'(F15.3)')
CALL WDIALOGPUTDOUBLE(IDF_REAL2,PBMAN%YMAX,'(F15.3)')
CALL WDIALOGPUTDOUBLE(IDF_REAL6,PBMAN%XMAX-PBMAN%XMIN,'(F15.3)')
CALL WDIALOGPUTDOUBLE(IDF_REAL3,PBMAN%YMAX-PBMAN%YMIN,'(F15.3)')
WRITE(LINE,*) TRIM(RTOS(PBMAN%XMIN,'F',3))//','//TRIM(RTOS(PBMAN%YMIN,'F',3))//','//TRIM(RTOS(PBMAN%XMAX,'F',3))//','//TRIM(RTOS(PBMAN%YMAX,'F',3))
CALL WDIALOGPUTSTRING(IDF_STRING1,LINE)
CALL WDIALOGPUTDOUBLE(IDF_REAL10,PBMAN%CELLSIZE) !## cellsize (full extent idf)
CALL WDIALOGPUTDOUBLE(IDF_REAL7,PBMAN%CELLSIZE) !## cellsize (entered window)
CALL WDIALOGPUTDOUBLE(IDF_REAL8,PBMAN%BUFFER) !## buffer
IF(PBMAN%BUFFER.LE.0.0D0)PBMAN%BUFFERCS=0.0D0
CALL WDIALOGPUTDOUBLE(IDF_REAL9,PBMAN%BUFFERCS) !## buffer-cellsize
I=0; IF(PBMAN%BUFFER.GT.0.0D0)I=1; CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,I)
CALL WDIALOGPUTSTRING(IDF_STRING3,PBMAN%GENFNAME)
!## settings for tab4
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
!## take care of setting from imod-batch
IF(PBMAN%ISS.EQ.0)THEN
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1) !## steady-state
ELSE
CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2) !## transient
IF(LEN_TRIM(PBMAN%TIMFNAME).EQ.0)THEN
!## start date
CALL ITIMETOGDATE(PBMAN%SDATE,IYR,IMH,IDY,IHR,IMT,ISC)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2 ,IDY)
CALL WDIALOGPUTOPTION(IDF_MENU2 ,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER3 ,IYR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER6 ,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER7 ,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER8 ,ISC)
!## end date
CALL ITIMETOGDATE(PBMAN%EDATE,IYR,IMH,IDY,IHR,IMT,ISC)
CALL WDIALOGPUTINTEGER(IDF_INTEGER4 ,IDY)
CALL WDIALOGPUTOPTION(IDF_MENU3 ,IMH)
CALL WDIALOGPUTINTEGER(IDF_INTEGER5 ,IYR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER9 ,IHR)
CALL WDIALOGPUTINTEGER(IDF_INTEGER10,IMT)
CALL WDIALOGPUTINTEGER(IDF_INTEGER11,ISC)
CALL WDIALOGPUTINTEGER(IDF_INTEGER12,PBMAN%IDT)
CALL WDIALOGPUTOPTION(IDF_MENU4 ,PBMAN%ITT)
ENDIF
ENDIF
!## settings for tab5
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB5)
!## set output precision
CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,PBMAN%SSYSTEM)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,PBMAN%IDOUBLE)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,PBMAN%ISAVEENDDATE)
!## settings for tab6_tab1
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB1)
!## misc. settings MODFLOW
CALL WDIALOGPUTOPTION(IDF_MENU2,PBMAN%ICONSISTENCY+1)
!## modflow2005 does not allow thickness of zero
CALL WDIALOGPUTDOUBLE(IDF_DOUBLE1,MAX(0.0D0,PBMAN%MINTHICKNESS),'(F15.3)')
CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,PBMAN%ICONCHK)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,PBMAN%ICHKCHD)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,PBMAN%DWEL)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,PBMAN%DISG)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK5,PBMAN%DSFR)
CALL WDIALOGPUTDOUBLE(IDF_DOUBLE2,PBMAN%MINKD,'(F15.3)')
CALL WDIALOGPUTDOUBLE(IDF_DOUBLE3,PBMAN%MINC,'(F15.3)')
!## settings for tab6_tab2 iMOD-WQ
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB6_TAB2)
CALL WDIALOGPUTINTEGER(IDF_INTEGER1,PBMAN%BTN%NPROBS)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2,PBMAN%BTN%NPRMAS)
TMP=PBMAN%ADV%MIXELM+2 ; CALL WDIALOGPUTOPTION(IDF_MENU1,TMP)
TMP=PBMAN%ADV%NADVFD+1 ; CALL WDIALOGPUTOPTION(IDF_MENU2,TMP)
CALL WDIALOGPUTDOUBLE(IDF_DOUBLE1,PBMAN%ADV%PERCEL)
CALL WDIALOGPUTINTEGER(IDF_DOUBLE2,PBMAN%SSM%MXSS)
!## initial steady-state stress-period
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB4)
CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,PBMAN%ISTEADY)
PMANAGER_INITSIM_PUT_PBMAN=.TRUE.
END FUNCTION PMANAGER_INITSIM_PUT_PBMAN
!###======================================================================
LOGICAL FUNCTION PMANAGER_GETMAXLAYERS(TOPICS,IBATCH)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN),DIMENSION(:) :: TOPICS
INTEGER,INTENT(IN) :: IBATCH
INTEGER :: I,J
PMANAGER_GETMAXLAYERS=.FALSE.
!## put maximum number of layer in dialog
CALL PMANAGER_GETNFILES(TOPICS,PRJMXNLAY)
IF(PRJMXNLAY.LE.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No layers found for the current configuration','Error')
RETURN
ENDIF
!## define layers
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
!## number of active layers equal to maximum allowable layers
CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,1,PRJMXNLAY)
CALL WDIALOGPUTINTEGER(IDF_INTEGER1,PRJMXNLAY); PRJNLAY=PRJMXNLAY
!## maximum is 999 layers
IF(PRJMXNLAY.GT.WINFOGRID(IDF_GRID1,GRIDROWSMAX))THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'For this iMOD version, there is a maximum number of layers is '// &
TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX))),'Error')
RETURN
ENDIF
CALL WGRIDROWS(IDF_GRID1,PRJMXNLAY)
IF(ALLOCATED(LAYCON))THEN; IF(SIZE(LAYCON).LT.PRJMXNLAY)DEALLOCATE(LAYCON); ENDIF
IF(.NOT.ALLOCATED(LAYCON))THEN
ALLOCATE(LAYCON(PRJMXNLAY))
IF(IBATCH.EQ.0)THEN
LAYCON=1
ELSE
J=0
DO I=1,PRJMXNLAY
IF(I.LE.SIZE(PBMAN%UNCONFINED))J=J+1; LAYCON(I)=PBMAN%UNCONFINED(J)+1 !## 1/2 value for unconfinedness
ENDDO
ENDIF
ENDIF
!## fill in layers
CALL PMANAGERLAYERTYPES_PRJNLAY()
PMANAGER_GETMAXLAYERS=.TRUE.
END FUNCTION PMANAGER_GETMAXLAYERS
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_PACKAGES()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID,I,J,N
INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
CHARACTER(LEN=52),DIMENSION(:),ALLOCATABLE :: TMPNAME
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
!## activate what layers are read - by default read all
IF(.NOT.ASSOCIATED(PBMAN%ILAY))THEN
ALLOCATE(PBMAN%ILAY(PRJNLAY))
DO I=1,SIZE(PBMAN%ILAY); PBMAN%ILAY(I)=1; ENDDO
ENDIF
N=0; DO I=1,SIZE(TOPICS)
IF(ASSOCIATED(TOPICS(I)%STRESS))N=N+1
ENDDO
ALLOCATE(PCKLIST(N))
DO I=1,SIZE(PCKLIST)
ALLOCATE(PCKLIST(I)%CLAY(PRJMXNLAY))
ALLOCATE(PCKLIST(I)%ILAY(PRJMXNLAY))
DO J=1,PRJMXNLAY
WRITE(PCKLIST(I)%CLAY(J),'(A)') 'Layer '//TRIM(ITOS(J))
!## deactivate all
PCKLIST(I)%ILAY(J)=0
ENDDO
ENDDO
PCKLIST%PLIST=''; PCKLIST%IPLIST=0; PCKLIST%JPLIST=0; PCKLIST%KPLIST=0
N=0; DO I=1,SIZE(TOPICS)
IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
N=N+1; PCKLIST(N)%PLIST=TOPICS(I)%TNAME; PCKLIST(N)%IPLIST=TOPICS(I)%IACT_MODEL; PCKLIST(N)%JPLIST=I
!## add interpolation option
PCKLIST(N)%KPLIST=PBMAN%INT(I)
IF(ASSOCIATED(PBMAN%ISAVE(I)%ILAY))THEN
!## save layer save settings
IF(PBMAN%ISAVE(I)%ILAY(1).EQ.-1)THEN
!## activate all
DO J=1,PRJMXNLAY; PCKLIST(N)%ILAY(J)=1; ENDDO
ELSE
DO J=1,SIZE(PBMAN%ISAVE(I)%ILAY)
PCKLIST(N)%ILAY(PBMAN%ISAVE(I)%ILAY)=1
ENDDO
ENDIF
ELSE
!## deactivate all
DO J=1,PRJMXNLAY; PCKLIST(N)%ILAY(J)=0; ENDDO
ENDIF
ENDIF
ENDDO
!## fill in active packages
IF(N.GT.WINFOGRID(IDF_GRID2,GRIDROWSMAX))THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'For this iMOD version, there is a maximum number of modules/packages is '// &
TRIM(ITOS(WINFOGRID(IDF_GRID2,GRIDROWSMAX))),'Error')
RETURN
ENDIF
CALL WGRIDROWS(IDF_GRID2,N)
!## use tmparray to avoid temporary array in wgrid-functions
ALLOCATE(TMPINT(N),TMPNAME(N))
TMPINT=PCKLIST%IPLIST
CALL WGRIDPUTCHECKBOX(IDF_GRID2,1,TMPINT,N)
TMPNAME=PCKLIST%PLIST
CALL WGRIDPUTSTRING( IDF_GRID2,2,TMPNAME,N)
TMPINT=PCKLIST%KPLIST
CALL WGRIDPUTCHECKBOX(IDF_GRID2,3,TMPINT,N)
CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB5)
CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,N,1)
DEALLOCATE(TMPINT,TMPNAME)
CALL PMANAGER_INITSIM_PUTISAVE()
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGER_INITSIM_PACKAGES
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_GETISAVE()
!###======================================================================
IMPLICIT NONE
INTEGER :: I
CALL WDIALOGGETMENU(IDF_MENU1,I)
CALL WDIALOGGETMENU(IDF_MENU2,PCKLIST(I)%ILAY)
END SUBROUTINE PMANAGER_INITSIM_GETISAVE
!###======================================================================
SUBROUTINE PMANAGER_INITSIM_PUTISAVE()
!###======================================================================
IMPLICIT NONE
INTEGER :: I
CALL WDIALOGGETMENU(IDF_MENU1,I)
CALL WDIALOGPUTMENU(IDF_MENU2,PCKLIST(I)%CLAY,PRJNLAY,PCKLIST(I)%ILAY)
END SUBROUTINE PMANAGER_INITSIM_PUTISAVE
!###======================================================================
SUBROUTINE PMANAGER_GETNFILES(ITOPICS,MLAY,DEFINED)
!###======================================================================
IMPLICIT NONE
INTEGER,DIMENSION(:),INTENT(IN) :: ITOPICS
LOGICAL,INTENT(INOUT),OPTIONAL :: DEFINED
INTEGER,INTENT(OUT) :: MLAY
INTEGER :: II,I,J,IPER,ITOPIC,ILAY,IACT
INTEGER,POINTER,DIMENSION(:) :: ALAY=>NULL()
!## get maximal number of layers
IF(PRESENT(DEFINED))DEFINED=.FALSE.; MLAY=999; ALLOCATE(ALAY(MLAY)); ALAY=0
DO II=1,SIZE(ITOPICS)
ITOPIC=ITOPICS(II)
SELECT CASE (ITOPIC)
!## skip these
CASE (TCAP,TPST,TIES,TOBS,TPCG,TGCG,TVDF,TDSP,TRCT)
IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.1)THEN
IF(PRESENT(DEFINED))DEFINED=.TRUE.
ENDIF
CYCLE
END SELECT
!## overrule iact_model - if activated
IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.1)IACT=1
!## by default turn off
TOPICS(ITOPIC)%IACT_MODEL=0
IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS))CYCLE
IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))CYCLE
!## turn on again after passing
IF(IACT.EQ.1)TOPICS(ITOPIC)%IACT_MODEL=1
IF(PRESENT(DEFINED))DEFINED=.TRUE.
DO IPER=1,SIZE(TOPICS(ITOPIC)%STRESS)
DO I=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,1)
DO J=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
ILAY=TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,J)%ILAY
IF(ILAY.GT.SIZE(ALAY))THEN
WRITE(*,'(/A/)') 'CANNOT COME HERE'
WRITE(*,*) ILAY,SIZE(ALAY),ITOPIC,IPER,I,J
PAUSE
ENDIF
IF(ILAY.GT.0)ALAY(ILAY)=1
ENDDO
ENDDO
ENDDO
ENDDO
!## how many connected layers are defined
MLAY=0; DO ILAY=1,SIZE(ALAY); IF(ALAY(ILAY).EQ.0)EXIT; MLAY=MLAY+1; ENDDO
IF(ASSOCIATED(ALAY))DEALLOCATE(ALAY)
END SUBROUTINE PMANAGER_GETNFILES
!###======================================================================
SUBROUTINE PMANAGERLAYERTYPES_PRJNLAY_CONFIGALL()
!###======================================================================
IMPLICIT NONE
INTEGER :: ID,i
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
CALL WDIALOGGETINTEGER(IDF_INTEGER1,PRJNLAY)
CALL WDIALOGGETMENU(IDF_MENU3,I)
!## set all
LAYCON=I
CALL WGRIDPUTOPTION(IDF_GRID1,2,LAYCON,PRJNLAY)
IF(PRJNLAY.LT.PRJMXNLAY)CALL WGRIDPUTCELLOPTION(IDF_GRID1,2,PRJNLAY,4)
END SUBROUTINE PMANAGERLAYERTYPES_PRJNLAY_CONFIGALL
!###======================================================================
SUBROUTINE PMANAGERLAYERTYPES_PRJNLAY()
!###======================================================================
IMPLICIT NONE
INTEGER :: I,ID
!## laycon=1: 0
!## laycon=2: 1
!## laycon=3:-1
!## laycon=4: constant head
ID=WINFODIALOG(CURRENTDIALOG); CALL WDIALOGSELECT(ID_DSIMMANAGER_TAB2)
CALL WDIALOGGETINTEGER(IDF_INTEGER1,PRJNLAY)
CALL WGRIDROWS(IDF_GRID1,PRJNLAY)
DO I=1,PRJNLAY; CALL WGRIDPUTCELLSTRING(IDF_GRID1,1,I,'Layer '//TRIM(ITOS(I))); ENDDO
!## write boundary string lower layer
CALL WGRIDPUTOPTION(IDF_GRID1,2,LAYCON,PRJNLAY)
IF(PRJNLAY.LT.PRJMXNLAY)CALL WGRIDPUTCELLOPTION(IDF_GRID1,2,PRJNLAY,4)
CALL WDIALOGSELECT(ID)
END SUBROUTINE PMANAGERLAYERTYPES_PRJNLAY
!###======================================================================
INTEGER FUNCTION PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IPER,ITOPIC
INTEGER(KIND=8),INTENT(OUT) :: ITIME,JTIME
INTEGER(KIND=8) :: KTIME
INTEGER :: KPER
PMANAGER_GETCURRENTIPER=0
KTIME=INT(0,8); JTIME=INT(0,8); ITIME=INT(0,8)
!## get appropriate stress-period to store in runfile
IF(SIM(IPER)%DELT.GT.0.0D0)THEN !## transient
!## previous timestep
IF(IPER.GT.1)THEN
IF(SIM(IPER-1)%DELT.GT.0.0D0)THEN
KTIME=SIM(IPER-1)%IYR*10000000000+SIM(IPER-1)%IMH*100000000+SIM(IPER-1)%IDY*1000000+ &
SIM(IPER-1)%IHR*10000 +SIM(IPER-1)%IMT*100 +SIM(IPER-1)%ISC
ENDIF
ENDIF
!## current timestep
ITIME=SIM(IPER )%IYR*10000000000+SIM(IPER )%IMH*100000000+SIM(IPER )%IDY*1000000+ &
SIM(IPER )%IHR*10000 +SIM(IPER )%IMT*100 +SIM(IPER )%ISC
!## next timestep
JTIME=SIM(IPER+1)%IYR*10000000000+SIM(IPER+1)%IMH*100000000+SIM(IPER+1)%IDY*1000000+ &
SIM(IPER+1)%IHR*10000 +SIM(IPER+1)%IMT*100 +SIM(IPER+1)%ISC
ENDIF
KPER=PMANAGER_GETIPER(IPER,KTIME,ITIME,JTIME,TOPICS(ITOPIC)%STRESS)
PMANAGER_GETCURRENTIPER=KPER
END FUNCTION PMANAGER_GETCURRENTIPER
!###======================================================================
INTEGER FUNCTION PMANAGER_GETIPER(IPER,PTIME,STIME,ETIME,STRESS)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IPER
INTEGER(KIND=8),INTENT(IN) :: STIME,ETIME,PTIME
TYPE(STRESSOBJ),INTENT(IN),DIMENSION(:) :: STRESS
INTEGER :: I,J,ID,IYR
INTEGER(KIND=8) :: PCKTIME,MD
!## initially nothing found
PMANAGER_GETIPER=0
!## look for steady-state
IF(STIME.EQ.INT(0,8))THEN
DO I=1,SIZE(STRESS)
IF(TRIM(UTL_CAP(STRESS(I)%CDATE,'U')).EQ.'STEADY-STATE')THEN
PMANAGER_GETIPER=I; RETURN
ENDIF
ENDDO
ID=0 !## nothing found
!## transient
ELSE
!## get time-interval window
!## look for nearest package to current timestep
MD=10D14; ID=0
DO I=1,SIZE(STRESS)
!## skip steady-state
IF(TRIM(UTL_CAP(STRESS(I)%CDATE,'U')).EQ.'STEADY-STATE')CYCLE
!## check whether a period is available
DO J=1,NPERIOD
IF(TRIM(UTL_CAP(STRESS(I)%CDATE,'U')).EQ.TRIM(UTL_CAP(PERIOD(J)%NAME,'U')))EXIT
ENDDO
!## see whether the current stress is within mentioned period
IF(J.LE.NPERIOD)THEN
!## check each subsequent period for years to be closed to current time step
IYR=PERIOD(J)%IYR
DO
!## package time
PCKTIME=IYR*10000000000+ PERIOD(J)%IMH*100000000+PERIOD(J)%IDY*1000000+ &
PERIOD(J)%IHR*10000+PERIOD(J)%IMT*100+ PERIOD(J)%ISC
!## outside (appears to be later) current time-window
IF(PCKTIME.GE.ETIME)EXIT
!## defined at the same period as the current timestep - better than this it will not become, stop search
IF(STIME.EQ.PCKTIME)THEN; ID=I; EXIT; ENDIF
!## get closest defined before current timestep
IF(STIME.GT.PCKTIME)THEN
!## closer than what we had already
IF(STIME-PCKTIME.LE.MD)THEN; MD=STIME-PCKTIME; ID=-I; ENDIF
ENDIF
!## insert period next year
IYR=IYR+1
ENDDO
!## defined at the same period as the current timestep - better than this it will not become, stop search
IF(STIME.EQ.PCKTIME)EXIT
ELSE
!## package time
PCKTIME=STRESS(I)%IYR*10000000000+STRESS(I)%IMH*100000000+STRESS(I)%IDY*1000000+ &
STRESS(I)%IHR*10000 +STRESS(I)%IMT*100 +STRESS(I)%ISC
!## outside (appears to be later) current time-window - try next
IF(PCKTIME.GE.ETIME)CYCLE
!## defined at the same period as the current timestep - better than this it will not become, stop search
IF(STIME.EQ.PCKTIME)THEN; ID=I; EXIT; ENDIF
!## get closest defined before current timestep
IF(STIME.GT.PCKTIME)THEN
!## closer than what we had already
IF(STIME-PCKTIME.LE.MD)THEN; MD=STIME-PCKTIME; ID=-I; ENDIF
ENDIF
ENDIF
ENDDO
ENDIF
!## nothing found
IF(ID.EQ.0)THEN
!## check steady-state period
DO I=1,SIZE(STRESS)
!## skip steady-state
IF(TRIM(UTL_CAP(STRESS(I)%CDATE,'U')).EQ.'STEADY-STATE')ID=I
ENDDO
!## apply minus 1
IF(IPER.GT.1)ID=-1*ID
PMANAGER_GETIPER=ID !0
!## use previous input
ELSEIF(ID.LT.0)THEN
!## no matter what; cannot use -1 for first timestep
IF(IPER.EQ.1)THEN
PMANAGER_GETIPER=ABS(ID)
ELSE
!## no matter what; cannot use -1 for first timestep after steady-state
IF(SIM(IPER-1)%DELT.EQ.0.0D0)THEN
PMANAGER_GETIPER=ABS(ID)
ELSE
!## check whether date is after last time-step (ktime)
IF(STIME-MD.GT.PTIME)THEN
PMANAGER_GETIPER=ABS(ID)
ELSE
PMANAGER_GETIPER=ID
ENDIF
ENDIF
ENDIF
!## number of systems for current stress period
ELSE
PMANAGER_GETIPER=ID
ENDIF
END FUNCTION PMANAGER_GETIPER
!#####=================================================================
INTEGER FUNCTION PMANAGER_FIND_KEYWORD(KEYLINE)
!#####=================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: KEYLINE
INTEGER :: I,J
CHARACTER(LEN=3) :: CKEY
PMANAGER_FIND_KEYWORD=0
I=INDEX(KEYLINE,'('); J=INDEX(KEYLINE,')')
IF(I.EQ.0.OR.J.EQ.0)RETURN; IF(J-I.NE.4)RETURN
CKEY=KEYLINE(I+1:J-1); CKEY=UTL_CAP(CKEY,'U')
DO I=1,MAXTOPICS !SIZE(CMOD)
IF(CKEY.EQ.TOPICS(I)%CMOD)THEN; PMANAGER_FIND_KEYWORD=I; RETURN; ENDIF
END DO
END FUNCTION PMANAGER_FIND_KEYWORD
!###======================================================================
LOGICAL FUNCTION PMANAGER_GETKEYS(IU)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IU
INTEGER :: I,J,IOS
PMANAGER_GETKEYS=.FALSE.
DO I=1,SIZE(TOPICS); CALL PMANAGER_DEALLOCATE(I); ENDDO; CALL PMANAGER_DEALLOCATE_PEST()
READ(IU,*,IOSTAT=IOS); IF(IOS.NE.0)RETURN
READ(IU,*,IOSTAT=IOS) PRJNLAY,PRJNLAY,PRJNPER,I,I,I,I,PEST%IIPF; IF(IOS.NE.0)RETURN
IF(PEST%IIPF.NE.0)THEN
ALLOCATE(PEST%MEASURES(ABS(PEST%IIPF)))
PEST%IIPF=MIN(PEST%IIPF,0); IF(PEST%IIPF.LT.0)PEST%IIPF=1
DO I=1,SIZE(PEST%MEASURES)
READ(IU,'(A256)') LINE
READ(LINE,*) PEST%MEASURES(I)%IPFNAME,PEST%MEASURES(I)%IPFTYPE,PEST%MEASURES(I)%IXCOL, &
PEST%MEASURES(I)%IYCOL ,PEST%MEASURES(I)%ILCOL ,PEST%MEASURES(I)%IMCOL,PEST%MEASURES(I)%IVCOL
ENDDO
ENDIF
!## skip common settings
READ(IU,*)
!## read pcg solvers settings
READ(IU,*) PCG%NOUTER,PCG%NINNER,PCG%HCLOSE,PCG%RCLOSE,PCG%RELAX
ALLOCATE(TOPICS(TPCG)%STRESS(1)); ALLOCATE(TOPICS(TPCG)%STRESS(1)%FILES(1,1)); TOPICS(TPCG)%STRESS(1)%FILES%FNAME=''
TOPICS(TPCG)%IACT=1; TOPICS(TPCG)%IACT_MODEL=1
PCG%NPCOND=1
PCG%IPRPCG=1
PCG%MUTPCG=0
PCG%DAMPPCG=1.0D0
PCG%DAMPPCGT=1.0D0
!PCG%IMERGE=0
!PCG%PARTOPT=0
!PCG%NCORES=1
!## find available keys
J=0; DO
READ(IU,'(A256)') LINE; LINE=UTL_CAP(LINE,'U')
I=PMANAGER_FIND_KEYWORD(LINE)
IF(I.GT.0)THEN
TOPICS(I)%IACT=1; TOPICS(I)%IACT_MODEL=1; J=J+1
ELSE
IF(UTL_CAP(LINE,'U').EQ.'MODULES FOR EACH LAYER')EXIT
! IF(J.GT.0)EXIT
ENDIF
ENDDO
PMANAGER_GETKEYS=.TRUE.
END FUNCTION PMANAGER_GETKEYS
!###======================================================================
LOGICAL FUNCTION PMANAGER_GETFILES(IU,ITOPIC)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IU
INTEGER,INTENT(OUT) :: ITOPIC
INTEGER :: I,II,IOS,IPER,KPER,NSYS,ISYS,MSYS
CHARACTER(LEN=52) :: CDATE,C
REAL(KIND=DP_KIND) :: DELT,CNST
PMANAGER_GETFILES=.FALSE.
!## find available files for different keys
CDATE=''; IARMWP=0
DO
READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT; LINE=UTL_CAP(LINE,'U')
!## try to read timestamp
READ(LINE,*,IOSTAT=IOS) KPER,DELT,C,I; IF(IOS.EQ.0)CDATE=C
ITOPIC=PMANAGER_FIND_KEYWORD(LINE)
IF(ITOPIC.GT.0)THEN
IF(TOPICS(ITOPIC)%IACT.EQ.1)THEN
READ(LINE,*,IOSTAT=IOS) NSYS; IF(IOS.NE.0)RETURN; IF(NSYS.LE.0)CYCLE
!## reduce number of system to 1 for metaswap
IF(ITOPIC.EQ.TCAP)THEN
MSYS=NSYS; NSYS=1
ENDIF
!## pst module
IF(ITOPIC.EQ.TPST)THEN
!## create new system
IPER=0; CALL PMANAGER_STRESSES(ITOPIC,IPER)
ISYS=0; CALL PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)
CALL PMANAGER_LOADPST(IU,NSYS,1); TOPICS(ITOPIC)%IACT_MODEL=1; CYCLE
ENDIF
!## ies module
IF(ITOPIC.EQ.TIES)THEN
!## create new system
IPER=0; CALL PMANAGER_STRESSES(ITOPIC,IPER)
ISYS=0; CALL PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)
IF(PMANAGER_LOADIES(IU,NSYS))TOPICS(ITOPIC)%IACT_MODEL=1; CYCLE
ENDIF
!## create stress-period
IPER=0; CALL PMANAGER_STRESSES(ITOPIC,IPER)
!## create systems
ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES(TOPICS(ITOPIC)%NSUBTOPICS,NSYS))
TOPICS(ITOPIC)%STRESS(IPER)%FILES%FNAME=''
TOPICS(ITOPIC)%STRESS(IPER)%IYR=0; TOPICS(ITOPIC)%STRESS(IPER)%IMH=0; TOPICS(ITOPIC)%STRESS(IPER)%IDY=0
TOPICS(ITOPIC)%STRESS(IPER)%IHR=0; TOPICS(ITOPIC)%STRESS(IPER)%IMT=0; TOPICS(ITOPIC)%STRESS(IPER)%ISC=0
IF(TOPICS(ITOPIC)%TIMDEP)THEN
TOPICS(ITOPIC)%STRESS(IPER)%CDATE=CDATE
READ(CDATE,'(I4,5I2)',IOSTAT=IOS) TOPICS(ITOPIC)%STRESS(IPER)%IYR,TOPICS(ITOPIC)%STRESS(IPER)%IMH,TOPICS(ITOPIC)%STRESS(IPER)%IDY, &
TOPICS(ITOPIC)%STRESS(IPER)%IHR,TOPICS(ITOPIC)%STRESS(IPER)%IMT,TOPICS(ITOPIC)%STRESS(IPER)%ISC
ENDIF
I=0; DO II=1,TOPICS(ITOPIC)%NSUBTOPICS
I=I+1
!## stop reading
IF(I.NE.II.AND.II.EQ.TOPICS(ITOPIC)%NSUBTOPICS)EXIT
DO ISYS=1,NSYS
SELECT CASE (ITOPIC)
CASE (TCAP,TPWT) !## msp,pwt
READ(IU,*,IOSTAT=IOS) TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FCT, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IMP, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ILAY=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IACT=1
READ(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME,*,IOSTAT=IOS) CNST
IF(IOS.EQ.0)THEN
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST =CNST
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME=''
ELSE
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=2
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST =-999.99
ENDIF
!## found ipf for artificial recharge
IF(ITOPIC.EQ.TCAP.AND.I.EQ.8.AND.TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST.EQ.2)THEN
IF(INDEX(UTL_CAP(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME,'U'),'.IPF').GT.0)THEN
TOPICS(TCAP)%SNAME(7) ='Recharge-ID (IDF)'
TOPICS(TCAP)%SNAME(8) ='Extraction (IPF)'
TOPICS(TCAP)%SNAME(9) =''
I=I+1; IARMWP=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME=''
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FCT=1.0D0
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IMP=0.0D0
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST=-999.99
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ILAY=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IACT=1
ELSE
TOPICS(TCAP)%SNAME(7) ='Artificial discharge (IDF)'
TOPICS(TCAP)%SNAME(8) ='Artificial layer (IDF)'
TOPICS(TCAP)%SNAME(9) ='Artificial location (IDF)'
ENDIF
ENDIF
CASE (TISG) !## isg
READ(IU,*,IOSTAT=IOS) TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ILAY, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FCT, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IMP, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=2
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST =-999.99
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IACT =1
CASE DEFAULT
READ(IU,*,IOSTAT=IOS) TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ILAY, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FCT, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IMP, &
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME
IF(IOS.NE.0)RETURN
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IACT=1
READ(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME,*,IOSTAT=IOS) CNST
IF(IOS.EQ.0)THEN
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=1
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST =CNST
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME=''
ELSE
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ICNST=2
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%CNST =-999.99
ENDIF
END SELECT
IF(TRIM(PREFVAL(5)).NE.'')THEN
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME=UTL_SUBST(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME,TRIM(REPLACESTRING),PREFVAL(5))
ENDIF
TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%ALIAS= &
UTL_CAP(TRIM(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME(INDEX(TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME,'\',.TRUE.)+1:)),'L')
ENDDO
ENDDO
!## read in the inp files
IF(ITOPIC.EQ.TCAP)THEN
MSYS=MSYS-TOPICS(ITOPIC)%NSUBTOPICS+IARMWP
ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES(MSYS))
DO ISYS=1,MSYS
READ(IU,'(A)',IOSTAT=IOS) TOPICS(ITOPIC)%STRESS(IPER)%INPFILES(ISYS)
TOPICS(ITOPIC)%STRESS(IPER)%INPFILES(ISYS)=ADJUSTL(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES(ISYS))
ENDDO
ENDIF
ENDIF
ENDIF
ENDDO
PMANAGER_GETFILES=.TRUE.
END FUNCTION PMANAGER_GETFILES
!###======================================================================
SUBROUTINE PMANAGER_LOADPST(IU,NPARAM,IOPTION)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IU,NPARAM,IOPTION
INTEGER :: I,J,IOS,N,M
IF(IOPTION.EQ.0)THEN
READ(IU,*) PEST%IIPF
IF(PEST%IIPF.NE.0)THEN
ALLOCATE(PEST%MEASURES(ABS(PEST%IIPF)))
PEST%IIPF=MIN(PEST%IIPF,0); IF(PEST%IIPF.LT.0)PEST%IIPF=1
DO I=1,SIZE(PEST%MEASURES)
READ(IU,'(A256)') LINE
READ(LINE,*,IOSTAT=IOS) PEST%MEASURES(I)%IPFNAME,PEST%MEASURES(I)%IPFTYPE,PEST%MEASURES(I)%IXCOL, &
PEST%MEASURES(I)%IYCOL ,PEST%MEASURES(I)%ILCOL ,PEST%MEASURES(I)%IMCOL,PEST%MEASURES(I)%IVCOL, &
PEST%MEASURES(I)%IDCOL
IF(IOS.NE.0)THEN
PEST%MEASURES(I)%IDCOL=0
READ(LINE,*) PEST%MEASURES(I)%IPFNAME,PEST%MEASURES(I)%IPFTYPE,PEST%MEASURES(I)%IXCOL, &
PEST%MEASURES(I)%IYCOL ,PEST%MEASURES(I)%ILCOL ,PEST%MEASURES(I)%IMCOL,PEST%MEASURES(I)%IVCOL
ENDIF
IF(TRIM(PREFVAL(5)).NE.'')THEN
PEST%MEASURES(I)%IPFNAME=UTL_SUBST(PEST%MEASURES(I)%IPFNAME,TRIM(REPLACESTRING),PREFVAL(5))
ENDIF
ENDDO
ENDIF
ENDIF
READ(IU,'(A256)') LINE
READ(LINE,*,IOSTAT=IOS) PEST%PE_MXITER,PEST%PE_STOP,PEST%PE_SENS,N,M,PEST%PE_TARGET(1),PEST%PE_TARGET(2),PEST%PE_SCALING, &
PEST%PE_PADJ,PEST%PE_DRES,PEST%PE_KTYPE,PEST%PE_KRANGE,PEST%PE_REGULARISATION
IF(IOS.NE.0)THEN
!## apply default kriging range
PEST%PE_REGULARISATION=0
READ(LINE,*,IOSTAT=IOS) PEST%PE_MXITER,PEST%PE_STOP,PEST%PE_SENS,N,M,PEST%PE_TARGET(1),PEST%PE_TARGET(2),PEST%PE_SCALING, &
PEST%PE_PADJ,PEST%PE_DRES,PEST%PE_KTYPE,PEST%PE_KRANGE
IF(IOS.NE.0)THEN
PEST%PE_KTYPE=1; PEST%PE_KRANGE=10000.0D0
READ(LINE,*,IOSTAT=IOS) PEST%PE_MXITER,PEST%PE_STOP,PEST%PE_SENS,N,M,PEST%PE_TARGET(1),PEST%PE_TARGET(2),PEST%PE_SCALING, &
PEST%PE_PADJ,PEST%PE_DRES
IF(IOS.NE.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading runfile in the PST section with the parameter definitions.','Error')
RETURN
ENDIF
ENDIF
ENDIF
IF(PEST%PE_KTYPE.LE.0)THEN
READ(IU,'(A)') PEST%PPBNDIDF
IF(TRIM(PREFVAL(5)).NE.'')THEN
PEST%PPBNDIDF=UTL_SUBST(PEST%PPBNDIDF,TRIM(REPLACESTRING),PREFVAL(5))
ENDIF
ENDIF
PEST%PE_SCALING=PEST%PE_SCALING+1
!## periods defined
IF(N.GT.0)THEN
ALLOCATE(PEST%S_PERIOD(N),PEST%E_PERIOD(N))
PEST%S_PERIOD='0'; PEST%E_PERIOD='0'
DO I=1,SIZE(PEST%S_PERIOD)
READ(IU,'(A256)') LINE
READ(LINE,*) PEST%S_PERIOD(I),PEST%E_PERIOD(I)
ENDDO
ENDIF
!## batchfiles defined
IF(M.GT.0)THEN
ALLOCATE(PEST%B_FRACTION(M),PEST%B_BATCHFILE(M),PEST%B_OUTFILE(M))
PEST%B_FRACTION=1.0D0; PEST%B_BATCHFILE=''; PEST%B_OUTFILE=''
DO I=1,SIZE(PEST%B_FRACTION)
READ(IU,'(A256)') LINE
READ(LINE,*,IOSTAT=IOS) PEST%B_FRACTION(I),PEST%B_BATCHFILE(I),PEST%B_OUTFILE(I)
IF(TRIM(PREFVAL(5)).NE.'')THEN
PEST%B_BATCHFILE(I)=UTL_SUBST(PEST%B_BATCHFILE(I),TRIM(REPLACESTRING),PREFVAL(5))
PEST%B_OUTFILE(I) =UTL_SUBST(PEST%B_OUTFILE(I), TRIM(REPLACESTRING),PREFVAL(5))
ENDIF
ENDDO
ENDIF
IF(NPARAM.GT.0)THEN
ALLOCATE(PEST%PARAM(NPARAM))
DO I=1,SIZE(PEST%PARAM)
READ(IU,'(A256)') LINE
READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE,PEST%PARAM(I)%PIGROUP,PEST%PARAM(I)%PLOG,PEST%PARAM(I)%ACRONYM,PEST%PARAM(I)%PPRIOR
IF(IOS.NE.0)THEN
PEST%PARAM(I)%PPRIOR=PEST%PARAM(I)%PINI
READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE,PEST%PARAM(I)%PIGROUP,PEST%PARAM(I)%PLOG,PEST%PARAM(I)%ACRONYM
IF(IOS.NE.0)THEN
PEST%PARAM(I)%ACRONYM=''
READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE,PEST%PARAM(I)%PIGROUP,PEST%PARAM(I)%PLOG
PEST%PARAM(I)%PPARAM=UTL_CAP(PEST%PARAM(I)%PPARAM,'U')
IF(IOS.NE.0)THEN
SELECT CASE (PEST%PARAM(I)%PPARAM)
!## recharge/anisotropy/stages angle non log transformed
CASE ('RE','AH','RL','RB','IL','IB','DL')
PEST%PARAM(I)%PLOG=0
CASE DEFAULT
PEST%PARAM(I)%PLOG=1
END SELECT
READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE,PEST%PARAM(I)%PIGROUP
IF(IOS.NE.0)THEN
PEST%PARAM(I)%PIGROUP=I
READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE
IF(IOS.NE.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading runfile in the PST section with the parameter definitions.','Error')
RETURN
ENDIF
ENDIF
ENDIF
ENDIF
!## set an acronym always - to be sure that size of acronyme is not exceeded
IF(LEN_TRIM(PEST%PARAM(I)%ACRONYM).EQ.0)THEN
WRITE(PEST%PARAM(I)%ACRONYM,'(A2,2I5.5,I3.3)') ADJUSTL(PEST%PARAM(I)%PPARAM),PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PIGROUP
ENDIF
ENDIF
!## fill in iparam
DO J=1,SIZE(PARAM); IF(PEST%PARAM(I)%PPARAM.EQ.PARAM(J))EXIT; ENDDO
PEST%PARAM(I)%IPARAM=J
ENDDO
ENDIF
READ(IU,*) I
IF(I.GT.0)THEN
ALLOCATE(PEST%IDFFILES(I))
DO I=1,SIZE(PEST%IDFFILES)
READ(IU,'(A256)') LINE
READ(LINE,*) PEST%IDFFILES(I)
IF(TRIM(PREFVAL(5)).NE.'')THEN
PEST%IDFFILES(I)=UTL_SUBST(PEST%IDFFILES(I),TRIM(REPLACESTRING),PREFVAL(5))
ENDIF
ENDDO
ENDIF
END SUBROUTINE PMANAGER_LOADPST
!###======================================================================
SUBROUTINE PMANAGER_SAVEIES(IU)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IU
INTEGER :: I,N
IF(ASSOCIATED(PEST%MEASURES))THEN
I=SIZE(PEST%MEASURES)
IF(PEST%IIPF.EQ.1)I=-1*I
LINE=TRIM(ITOS(I))
WRITE(IU,'(A)') TRIM(LINE)
DO I=1,SIZE(PEST%MEASURES)
LINE='IPF'//TRIM(ITOS(I))//'='//CHAR(39)//TRIM(PEST%MEASURES(I)%IPFNAME)//CHAR(39); WRITE(IU,'(A)') TRIM(LINE)
LINE='IPFT'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IPFTYPE)); WRITE(IU,'(A)') TRIM(LINE)
LINE='XCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IXCOL)); WRITE(IU,'(A)') TRIM(LINE)
LINE='YCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IYCOL)); WRITE(IU,'(A)') TRIM(LINE)
LINE='LCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%ILCOL)); WRITE(IU,'(A)') TRIM(LINE)
LINE='MCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IMCOL)); WRITE(IU,'(A)') TRIM(LINE)
LINE='VCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IVCOL)); WRITE(IU,'(A)') TRIM(LINE)
LINE='DCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(PEST%MEASURES(I)%IDCOL)); WRITE(IU,'(A)') TRIM(LINE)
ENDDO
ENDIF
!
!IF(IOPTION.EQ.2)THEN
! LINE=TRIM(ITOS(SIZE(PEST%PARAM))); WRITE(IU,'(A)') TRIM(LINE)
!ENDIF
!
N=0; IF(ASSOCIATED(PEST%S_PERIOD)) N=SIZE(PEST%S_PERIOD)
LINE='NPERIOD='//TRIM(ITOS(N)); WRITE(IU,'(A)') TRIM(LINE)
DO I=1,N
LINE='SPERIOD'//TRIM(ITOS(I))//'='//TRIM(PEST%S_PERIOD(I)); WRITE(IU,'(A)') TRIM(LINE)
LINE='EPERIOD'//TRIM(ITOS(I))//'='//TRIM(PEST%E_PERIOD(I)); WRITE(IU,'(A)') TRIM(LINE)
ENDDO
N=0; IF(ASSOCIATED(PEST%B_FRACTION))N=SIZE(PEST%B_FRACTION)
LINE='NBATCH='//TRIM(ITOS(N)); WRITE(IU,'(A)') TRIM(LINE)
DO I=1,N
LINE='BFRACTION'//TRIM(ITOS(I))//'='//TRIM(RTOS(PEST%B_FRACTION(I),'F',7)); WRITE(IU,'(A)') TRIM(LINE)
LINE='BINFILE'//TRIM(ITOS(I))//'='//TRIM(PEST%B_BATCHFILE(I)); WRITE(IU,'(A)') TRIM(LINE)
LINE='BOUTFILE'//TRIM(ITOS(I))//'='//TRIM(PEST%B_OUTFILE(I)); WRITE(IU,'(A)') TRIM(LINE)
ENDDO
LINE='MXITER='//TRIM(ITOS(PEST%PE_MXITER)); WRITE(IU,'(A)') TRIM(LINE)
LINE='MINREDOBJF'//TRIM(RTOS(PEST%PE_STOP,'F',7)); WRITE(IU,'(A)') TRIM(LINE)
LINE='MINUPDATE'//TRIM(RTOS(PEST%PE_PADJ,'F',7)); WRITE(IU,'(A)') TRIM(LINE)
!
!I=PEST%PE_MXITER; IF(IITER.EQ.-1.AND.PBMAN%IPESTP.EQ.1)I=-1
!LINE=TRIM(ITOS(I)) //','//TRIM(RTOS(PEST%PE_STOP,'G',7)) //','// &
! TRIM(RTOS(PEST%PE_SENS,'G',7)) //','//TRIM(ITOS(N)) //','// &
! TRIM(ITOS(M)) //','//TRIM(RTOS(PEST%PE_TARGET(1),'G',7))//','// &
! TRIM(RTOS(PEST%PE_TARGET(2),'G',7))//','//TRIM(ITOS(PEST%PE_SCALING-1)) //','// &
! TRIM(RTOS(PEST%PE_PADJ,'G',7)) //','//TRIM(RTOS(PEST%PE_DRES,'G',7)) //','// &
! TRIM(ITOS(PEST%PE_KTYPE)) //','//TRIM(RTOS(PEST%PE_KRANGE,'G',7)) //','// &
! TRIM(ITOS(PEST%PE_REGULARISATION))
!
!WRITE(IU,'(A)') TRIM(LINE)
END SUBROUTINE PMANAGER_SAVEIES
!###======================================================================
LOGICAL FUNCTION PMANAGER_LOADIES(IU,NPARAM)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IU,NPARAM
INTEGER :: I,J,N
PMANAGER_LOADIES=.FALSE.
!## prj file
IF(.NOT.UTL_READINITFILE('NOBS',LINE,IU,0))RETURN; READ(LINE,*) PEST%IIPF
IF(PEST%IIPF.EQ.0)STOP 'ERROR NOBS NEED TO <> 0'
ALLOCATE(PEST%MEASURES(ABS(PEST%IIPF)))
PEST%IIPF=MIN(PEST%IIPF,0); IF(PEST%IIPF.LT.0)PEST%IIPF=1
DO I=1,SIZE(PEST%MEASURES)
IF(.NOT.UTL_READINITFILE('IPF'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IPFNAME
IF(.NOT.UTL_READINITFILE('IPFT'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IPFTYPE
IF(.NOT.UTL_READINITFILE('XCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IXCOL
IF(.NOT.UTL_READINITFILE('YCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IYCOL
IF(.NOT.UTL_READINITFILE('LCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%ILCOL
IF(.NOT.UTL_READINITFILE('MCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IMCOL
IF(.NOT.UTL_READINITFILE('VCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IVCOL
IF(.NOT.UTL_READINITFILE('DCOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%MEASURES(I)%IDCOL
ENDDO
!## periods defined
IF(.NOT.UTL_READINITFILE('NPERIODS',LINE,IU,0))RETURN; READ(LINE,*) N
IF(N.GT.0)THEN
ALLOCATE(PEST%S_PERIOD(N),PEST%E_PERIOD(N)); PEST%S_PERIOD='0'; PEST%E_PERIOD='0'
DO I=1,SIZE(PEST%S_PERIOD)
IF(.NOT.UTL_READINITFILE('SPERIOD'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%S_PERIOD(I)
IF(.NOT.UTL_READINITFILE('EPERIOD'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%E_PERIOD(I)
ENDDO
ENDIF
!## batchfiles defined
IF(.NOT.UTL_READINITFILE('NBATCH',LINE,IU,0))RETURN; READ(LINE,*) N
IF(N.GT.0)THEN
ALLOCATE(PEST%B_FRACTION(N),PEST%B_BATCHFILE(N),PEST%B_OUTFILE(N))
PEST%B_FRACTION=1.0D0; PEST%B_BATCHFILE=''; PEST%B_OUTFILE=''
DO I=1,SIZE(PEST%B_FRACTION)
IF(.NOT.UTL_READINITFILE('BFRACTION'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%B_FRACTION(I)
IF(.NOT.UTL_READINITFILE('BINFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%B_BATCHFILE(I)
IF(.NOT.UTL_READINITFILE('BOUTFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%B_OUTFILE(I)
ENDDO
ENDIF
IF(.NOT.UTL_READINITFILE('MXITER',LINE,IU,0))RETURN; READ(LINE,*) PEST%PE_MXITER
IF(.NOT.UTL_READINITFILE('MINREDOBJF',LINE,IU,0))RETURN; READ(LINE,*) PEST%PE_STOP
IF(.NOT.UTL_READINITFILE('MINUPDATE',LINE,IU,0))RETURN; READ(LINE,*) PEST%PE_PADJ
IF(.NOT.UTL_READINITFILE('NREALS',LINE,IU,0))RETURN; READ(LINE,*) PEST%NREALS
IF(.NOT.UTL_READPOINTER_REAL(IU,N,PBMAN%LAMBDA_TEST,'LAMBDA',0))RETURN
!## all parameters need to be ran per simulation
ALLOCATE(PEST%PARAM(NPARAM))
DO I=1,SIZE(PEST%PARAM)
IF(.NOT.UTL_READINITFILE('TYPE_P'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%PARAM(I)%PPARAM
IF(.NOT.UTL_READPOINTER(IU,N,PEST%PARAM(I)%ILS,'ILS_P'//TRIM(ITOS(I)),0))RETURN
PEST%PARAM(I)%ICOVFNAME=''
IF(UTL_READINITFILE('ICOV_P'//TRIM(ITOS(I)),LINE,IU,1))THEN
READ(LINE,*) PEST%PARAM(I)%ICOVFNAME
ELSE
IF(.NOT.UTL_READINITFILE('MINVAL_P'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%PARAM(I)%PMIN
IF(.NOT.UTL_READINITFILE('MAXVAL_P'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%PARAM(I)%PMAX
IF(.NOT.UTL_READINITFILE('RANGE_P'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%PARAM(I)%PARRANGE
ENDIF
ALLOCATE(PEST%PARAM(I)%REALSFNAME(PEST%NREALS)); PEST%PARAM(I)%REALSFNAME=''
IF(.NOT.UTL_READINITFILE('CREATEENSEMBLES',LINE,IU,0))RETURN; READ(LINE,*) PEST%ICREATEENSEMBLES
IF(PEST%ICREATEENSEMBLES.EQ.0)THEN
DO J=1,PEST%NREALS
IF(.NOT.UTL_READINITFILE('REALS_R'//TRIM(ITOS(J))//'_P'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) PEST%PARAM(I)%REALSFNAME(J)
ENDDO
ENDIF
ENDDO
PEST%PE_TARGET(1)=1.0D0; PEST%PE_TARGET(2)=0.0D0; PEST%PE_DRES=0.0D0
! READ(LINE,*,IOSTAT=IOS) PEST%PARAM(I)%PACT,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS,PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PINI,PEST%PARAM(I)%PDELTA, &
! PEST%PARAM(I)%PMIN,PEST%PARAM(I)%PMAX,PEST%PARAM(I)%PINCREASE,PEST%PARAM(I)%PIGROUP,PEST%PARAM(I)%PLOG,PEST%PARAM(I)%ACRONYM,PEST%PARAM(I)%PPRIOR
! SELECT CASE (PEST%PARAM(I)%PPARAM)
! !## recharge/anisotropy/stages angle non log transformed
! CASE ('RE','AH','RL','RB','IL','IB','DL')
! PEST%PARAM(I)%PLOG=0
! CASE DEFAULT
! PEST%PARAM(I)%PLOG=1
! END SELECT
PMANAGER_LOADIES=.TRUE.
!
!READ(IU,'(A256)') LINE
!READ(LINE,*,IOSTAT=IOS) PEST%PE_MXITER,PEST%PE_STOP,PEST%PE_SENS,N,M,PEST%PE_TARGET(1),PEST%PE_TARGET(2),PEST%PE_SCALING, &
END FUNCTION PMANAGER_LOADIES
!###======================================================================
SUBROUTINE PMANAGER_STRESSES(ITOPIC,IPER)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ITOPIC
INTEGER,INTENT(INOUT) :: IPER
INTEGER :: N,I,J,K
IF(IPER.GT.0)RETURN
IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
!## only increase for timedependent information
IF(TOPICS(ITOPIC)%TIMDEP)THEN
!## make copy of current memory
N=SIZE(TOPICS(ITOPIC)%STRESS)
NULLIFY(TOPICS(ITOPIC)%STRESS_TMP)
ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(N+1))
DO I=1,N
J=SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,1)
K=SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,2)
NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES)
NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(I)%INPFILES)
ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(I)%FILES(J,K))
TOPICS(ITOPIC)%STRESS_TMP(I)%FILES%FNAME=''
TOPICS(ITOPIC)%STRESS_TMP(I)%FILES=TOPICS(ITOPIC)%STRESS(I)%FILES
TOPICS(ITOPIC)%STRESS_TMP(I)%CDATE=TOPICS(ITOPIC)%STRESS(I)%CDATE
TOPICS(ITOPIC)%STRESS_TMP(I)%IYR=TOPICS(ITOPIC)%STRESS(I)%IYR
TOPICS(ITOPIC)%STRESS_TMP(I)%IMH=TOPICS(ITOPIC)%STRESS(I)%IMH
TOPICS(ITOPIC)%STRESS_TMP(I)%IDY=TOPICS(ITOPIC)%STRESS(I)%IDY
TOPICS(ITOPIC)%STRESS_TMP(I)%IHR=TOPICS(ITOPIC)%STRESS(I)%IHR
TOPICS(ITOPIC)%STRESS_TMP(I)%IMT=TOPICS(ITOPIC)%STRESS(I)%IMT
TOPICS(ITOPIC)%STRESS_TMP(I)%ISC=TOPICS(ITOPIC)%STRESS(I)%ISC
DEALLOCATE(TOPICS(ITOPIC)%STRESS(I)%FILES)
ENDDO
TOPICS(ITOPIC)%STRESS=>TOPICS(ITOPIC)%STRESS_TMP
IPER=N+1
ELSE
IPER=1
ENDIF
ELSE
ALLOCATE(TOPICS(ITOPIC)%STRESS(1))
NULLIFY(TOPICS(ITOPIC)%STRESS(1)%FILES)
TOPICS(ITOPIC)%IACT =1
TOPICS(ITOPIC)%IACT_MODEL=1
IPER=1
ENDIF
END SUBROUTINE PMANAGER_STRESSES
!###======================================================================
SUBROUTINE PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ITOPIC,IPER
INTEGER,INTENT(INOUT) :: ISYS
INTEGER :: N,M
!## create new system
IF(ISYS.GT.0)RETURN
IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(IPER)%FILES))THEN
!## make copy of current memory
M=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,1)
N=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
NULLIFY(TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP)
ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(M,N+1))
TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(1:M,1:N)=TOPICS(ITOPIC)%STRESS(IPER)%FILES(1:M,1:N)
DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES)
TOPICS(ITOPIC)%STRESS(IPER)%FILES=>TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP
ISYS=N+1
ELSE
N=TOPICS(ITOPIC)%NSUBTOPICS
ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES(N,1)); TOPICS(ITOPIC)%STRESS(IPER)%FILES%FNAME=''
ISYS=1
ENDIF
END SUBROUTINE PMANAGER_SYSTEMS
!###====================================================================
LOGICAL FUNCTION PMANAGER_SAVEMF2005_COARSEGRID(IDF,X1,Y1,X2,Y2,BUFFERCS)
!###====================================================================
IMPLICIT NONE
TYPE(IDFOBJ),INTENT(INOUT) :: IDF
REAL(KIND=DP_KIND),INTENT(IN) :: BUFFERCS,X1,Y1,X2,Y2
REAL(KIND=DP_KIND),PARAMETER :: INC=1.0D0 !## minimal scaling in interest
REAL(KIND=DP_KIND),PARAMETER :: FINCR=0.02D0
REAL(KIND=DP_KIND),PARAMETER :: POWR=0.3D0 !
INTEGER :: NOMAXCELL !## maximal # cells in the end
INTEGER,PARAMETER :: NOMINCELL=1 !## minimal # cells in the centre
LOGICAL,PARAMETER :: LCLIP=.TRUE. !## along edge small cells
INTEGER :: IC1,IC2,IR1,IR2,ORGNCOL,ORGNROW,OC1,OC2,OR1,OR2,I
INTEGER,ALLOCATABLE,DIMENSION(:) :: PDELR,PDELC
REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: DX,DY
PMANAGER_SAVEMF2005_COARSEGRID=.FALSE.
NOMAXCELL=INT(BUFFERCS/IDF%DX)
IC1=INT((X1-IDF%XMIN)/IDF%DX)+1
IC2=INT((X2-IDF%XMIN)/IDF%DX)+1
IR1=INT((IDF%YMAX-Y1)/IDF%DY)+1
IR2=INT((IDF%YMAX-Y2)/IDF%DY)+1
ORGNCOL=IDF%NCOL
ORGNROW=IDF%NROW
ALLOCATE(PDELR(IDF%NCOL),PDELC(IDF%NROW))
CALL UTL_MODELLHS1(PDELR,ORGNCOL,IDF%NCOL,IC1,IC2,OC1,OC2,INC,FINCR,POWR,NOMINCELL,NOMAXCELL,LCLIP)
CALL UTL_MODELLHS1(PDELC,ORGNROW,IDF%NROW,IR1,IR2,OR1,OR2,INC,FINCR,POWR,NOMINCELL,NOMAXCELL,LCLIP)
IDF%IEQ=1; IF(.NOT.IDFALLOCATESXY(IDF))RETURN
ALLOCATE(DX(IDF%NCOL),DY(IDF%NROW))
CALL PMANAGER_SAVEMF2005_COARSEGRID_RESULT(PDELR,DX,IDF%NCOL,ORGNCOL,IDF%DX)
CALL PMANAGER_SAVEMF2005_COARSEGRID_RESULT(PDELC,DY,IDF%NROW,ORGNROW,IDF%DY)
IDF%SX(0)=IDF%XMIN
DO I=1,IDF%NCOL; IDF%SX(I)=IDF%SX(I-1)+DX(I); ENDDO
IDF%SY(0)=IDF%YMAX
DO I=1,IDF%NROW; IDF%SY(I)=IDF%SY(I-1)-DY(I); ENDDO
DEALLOCATE(DX,DY)
PMANAGER_SAVEMF2005_COARSEGRID=.TRUE.
END FUNCTION PMANAGER_SAVEMF2005_COARSEGRID
!###====================================================================
SUBROUTINE PMANAGER_SAVEMF2005_COARSEGRID_RESULT(IX,DX,NX,NXORG,SIMCSIZE)
!###====================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: NX,NXORG
REAL(KIND=DP_KIND),INTENT(IN) :: SIMCSIZE
REAL(KIND=DP_KIND),INTENT(OUT),DIMENSION(NX) :: DX
INTEGER,INTENT(IN),DIMENSION(NXORG) :: IX
INTEGER :: I,J,K
J=1
K=1
DO I=2,NXORG
IF(IX(I).NE.IX(I-1))THEN
DX(K)=SIMCSIZE*REAL(J)
K=K+1
J=1
ELSE
J=J+1
ENDIF
END DO
DX(K)=SIMCSIZE*REAL(J)
END SUBROUTINE PMANAGER_SAVEMF2005_COARSEGRID_RESULT
!###======================================================================
LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK_GETMINMAX(X,NCOL,NROW,XB,MINV,MAXV,IFBND)
!###======================================================================
IMPLICIT NONE
REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(NCOL,NROW) :: X,XB
INTEGER,INTENT(IN) :: NROW,NCOL,IFBND
INTEGER :: IROW,ICOL,I
REAL(KIND=DP_KIND),INTENT(OUT) :: MINV,MAXV
PMANAGER_SAVEMF2005_PCK_GETMINMAX=.FALSE.
!## no matter what - save the data in an ARR-file
IF(IFBND.EQ.-1)THEN
!## set dummy values to ensure a save into ARR-files
MINV=-1.0D0; MAXV=1.0D0
ELSE
MINV=HUGE(1.0D0); MAXV=-HUGE(1.0D0); I=0
DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
!## skip nodata points
IF(X(ICOL,IROW).EQ.HNOFLOW)CYCLE
!## check on active nodes only
IF(IFBND.EQ.1)THEN
IF(XB(ICOL,IROW).NE.0.0D0)THEN
MINV=MIN(MINV,X(ICOL,IROW))
MAXV=MAX(MAXV,X(ICOL,IROW))
I =I+1
ENDIF
ELSE
MINV=MIN(MINV,X(ICOL,IROW))
MAXV=MAX(MAXV,X(ICOL,IROW))
I =I+1
ENDIF
ENDDO; ENDDO
IF(I.LE.0)THEN
MINV=HNOFLOW; MAXV=MINV
ENDIF
ENDIF
PMANAGER_SAVEMF2005_PCK_GETMINMAX=.TRUE.
END FUNCTION PMANAGER_SAVEMF2005_PCK_GETMINMAX
!###======================================================================
SUBROUTINE PMANAGER_SAVEMF2005_ALLOCATEPCK(N)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: N
INTEGER :: I
IF(ALLOCATED(PCK))CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK()
ALLOCATE(PCK(N))
DO I=1,N
CALL IDFNULLIFY(PCK(I))
CALL IDFCOPY(BND(1),PCK(I))
ENDDO
END SUBROUTINE PMANAGER_SAVEMF2005_ALLOCATEPCK
!###======================================================================
SUBROUTINE PMANAGER_SAVEMF2005_DEALLOCATEPCK()
!###======================================================================
IMPLICIT NONE
INTEGER:: N,I
IF(.NOT.ALLOCATED(PCK))RETURN
N=SIZE(PCK)
DO I=1,N; CALL IDFDEALLOCATEX(PCK(I)); ENDDO
DEALLOCATE(PCK)
END SUBROUTINE PMANAGER_SAVEMF2005_DEALLOCATEPCK
!###======================================================================
SUBROUTINE PMANAGER_ALLOCATE()
!###======================================================================
IMPLICIT NONE
INTEGER :: I,N,M
DO I=1,SIZE(TOPICS)
IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
N=SIZE(TOPICS(I)%STRESS)
M=TOPICS(I)%NSUBTOPICS
IF(ASSOCIATED(TOPICS(I)%IDT))DEALLOCATE(TOPICS(I)%IDT)
IF(ASSOCIATED(TOPICS(I)%ISD))DEALLOCATE(TOPICS(I)%ISD)
ALLOCATE(TOPICS(I)%IDT(N))
ALLOCATE(TOPICS(I)%ISD(N,M))
TOPICS(I)%IDT=0; TOPICS(I)%ISD=0
ENDIF
ENDDO
END SUBROUTINE PMANAGER_ALLOCATE
!###======================================================================
SUBROUTINE PMANAGER_DEALLOCATE(I)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: I
INTEGER :: J
IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
DO J=1,SIZE(TOPICS(I)%STRESS)
IF(ASSOCIATED(TOPICS(I)%STRESS(J)%FILES))DEALLOCATE(TOPICS(I)%STRESS(J)%FILES)
IF(ASSOCIATED(TOPICS(I)%STRESS(J)%INPFILES))DEALLOCATE(TOPICS(I)%STRESS(J)%INPFILES)
ENDDO
DEALLOCATE(TOPICS(I)%STRESS)
ENDIF
IF(ASSOCIATED(TOPICS(I)%IDT))DEALLOCATE(TOPICS(I)%IDT)
IF(ASSOCIATED(TOPICS(I)%ISD))DEALLOCATE(TOPICS(I)%ISD)
NULLIFY(TOPICS(I)%STRESS); NULLIFY(TOPICS(I)%IDT); NULLIFY(TOPICS(I)%ISD)
TOPICS(I)%IACT_MODEL=0
END SUBROUTINE PMANAGER_DEALLOCATE
!#####=================================================================
SUBROUTINE PMANAGER_DEALLOCATE_PEST()
!#####=================================================================
IMPLICIT NONE
INTEGER :: I
IF(ASSOCIATED(PEST%PARAM))THEN
DO I=1,SIZE(PEST%PARAM)
IF(ASSOCIATED(PEST%PARAM(I)%ALPHA_HISTORY)) DEALLOCATE(PEST%PARAM(I)%ALPHA_HISTORY)
IF(ASSOCIATED(PEST%PARAM(I)%GALPHA)) DEALLOCATE(PEST%PARAM(I)%GALPHA)
IF(ASSOCIATED(PEST%PARAM(I)%LALPHA)) DEALLOCATE(PEST%PARAM(I)%LALPHA)
ENDDO
DEALLOCATE(PEST%PARAM)
ENDIF
IF(ASSOCIATED(PEST%S_PERIOD)) DEALLOCATE(PEST%S_PERIOD)
IF(ASSOCIATED(PEST%E_PERIOD)) DEALLOCATE(PEST%E_PERIOD)
IF(ASSOCIATED(PEST%B_FRACTION)) DEALLOCATE(PEST%B_FRACTION)
IF(ASSOCIATED(PEST%B_BATCHFILE))DEALLOCATE(PEST%B_BATCHFILE)
IF(ASSOCIATED(PEST%B_OUTFILE)) DEALLOCATE(PEST%B_OUTFILE)
IF(ASSOCIATED(PEST%IDFFILES)) DEALLOCATE(PEST%IDFFILES)
IF(ASSOCIATED(PEST%MEASURES)) DEALLOCATE(PEST%MEASURES)
END SUBROUTINE PMANAGER_DEALLOCATE_PEST
!###======================================================================
SUBROUTINE PMANAGER_UTL_SHOW(ICODE)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ICODE
CALL WINDOWSELECT(0)
IF(WMENUGETSTATE(ID_PMANAGER,2).EQ.1)THEN
IF(ICODE.EQ.0)THEN; CALL PMANAGER_UTL_CLOSE(); RETURN; ENDIF
ENDIF
CALL WMENUSETSTATE(ID_PMANAGER,2,1)
CALL WDIALOGSELECT(ID_DPMANAGER); CALL UTL_DIALOGSHOW(0,65,0,2)
END SUBROUTINE PMANAGER_UTL_SHOW
!###======================================================================
SUBROUTINE PMANAGER_UTL_INIT()
!###======================================================================
IMPLICIT NONE
INTEGER :: I
CHARACTER(LEN=69),DIMENSION(:),ALLOCATABLE :: TMPNAME
TOPICS%TNAME=''
TOPICS(TCAP)%TNAME='(CAP) MetaSwap'
TOPICS(TTOP)%TNAME='(TOP) Top Elevation'
TOPICS(TBOT)%TNAME='(BOT) Bottom Elevation'
TOPICS(TTHK)%TNAME='(THK) Thickness'
TOPICS(TBND)%TNAME='(BND) Boundary Condition'
TOPICS(TSHD)%TNAME='(SHD) Starting Heads'
TOPICS(TKDW)%TNAME='(KDW) Transmissivity'
TOPICS(TKHV)%TNAME='(KHV) Horizontal Permeability'
TOPICS(TKVA)%TNAME='(KVA) Vertical Anisotropy'
TOPICS(TVCW)%TNAME='(VCW) Vertical Resistance'
TOPICS(TKVV)%TNAME='(KVV) Vertical Permeability'
TOPICS(TSTO)%TNAME='(STO) Confined Storage Coefficient'
TOPICS(TSPY)%TNAME='(SPY) Specific Yield'
TOPICS(TPWT)%TNAME='(PWT) Perched Water Table'
TOPICS(TANI)%TNAME='(ANI) Anisotropy'
TOPICS(THFB)%TNAME='(HFB) Horizontal Flow Barrier'
TOPICS(TIBS)%TNAME='(IBS) Interbed Storage'
TOPICS(TSFT)%TNAME='(SFT) StreamFlow Thickness'
TOPICS(TUZF)%TNAME='(UZF) Unsaturated Zone Flow Package'
TOPICS(TMNW)%TNAME='(MNW) Multi Node Well Package'
TOPICS(TPST)%TNAME='(PST) Parameter Estimation'
TOPICS(TWEL)%TNAME='(WEL) Wells'
TOPICS(TDRN)%TNAME='(DRN) Drainage'
TOPICS(TRIV)%TNAME='(RIV) Rivers'
TOPICS(TEVT)%TNAME='(EVT) Evapotranspiration'
TOPICS(TGHB)%TNAME='(GHB) General Head Boundary'
TOPICS(TRCH)%TNAME='(RCH) Recharge'
TOPICS(TOLF)%TNAME='(OLF) Overland Flow'
TOPICS(TCHD)%TNAME='(CHD) Constant Head Boundary'
TOPICS(TISG)%TNAME='(ISG) iMOD Segment Rivers'
TOPICS(TSFR)%TNAME='(SFR) Stream Flow Routing'
TOPICS(TFHB)%TNAME='(FHB) Flow and Head Boundary'
TOPICS(TLAK)%TNAME='(LAK) Lake Package'
TOPICS(TPCG)%TNAME='(PCG) Precondition Conjugate-Gradient'
TOPICS(TGCG)%TNAME='(GCG) Generalized Conjugate-Gradient'
TOPICS(TVDF)%TNAME='(VDF) Variable-Density Flow Settings'
TOPICS(TFDE)%TNAME='(FDE) Fluid Density'
TOPICS(TCBI)%TNAME='(CBI) Concentration Boundary Indicator'
TOPICS(TSCO)%TNAME='(SCO) Starting Concentration'
!TOPICS(TADV)%TNAME='(ADV) Advection Package'
TOPICS(TDSP)%TNAME='(DSP) Dispersivity '
TOPICS(TTVC)%TNAME='(TVC) Time Varying Constant Concentration'
TOPICS(TPOR)%TNAME='(POR) Porosity'
TOPICS(TOBS)%TNAME='(OBS) Observation'
TOPICS(THOB)%TNAME='(HOB) Bulk density of the porous medium'
TOPICS(TPID)%TNAME='(PID) Porosity of the immobile domain'
TOPICS(TICS)%TNAME='(ICS) Initial concentration of the sorbed or immobile liquid phase'
TOPICS(TFSC)%TNAME='(FSC) First Sorption constant'
TOPICS(TSSC)%TNAME='(SSC) Second Sorption constant'
TOPICS(TFOD)%TNAME='(FOD) First order rate reaction dissolved hase'
TOPICS(TFOS)%TNAME='(FOS) First order rate reaction for the sorbed phase'
TOPICS(TRCT)%TNAME='(RCT) Chemical Reaction Package'
TOPICS(TCON)%TNAME='(CON) Chloride Concentration'
TOPICS(TIES)%TNAME='(IES) Iterative Ensemble Smoother'
TOPICS(TCAP)%NSUBTOPICS=22 !CAP
TOPICS(TTOP)%NSUBTOPICS=1 !TOP
TOPICS(TBOT)%NSUBTOPICS=1 !BOT
TOPICS(TTHK)%NSUBTOPICS=1 !THK
TOPICS(TBND)%NSUBTOPICS=1 !BND
TOPICS(TSHD)%NSUBTOPICS=1 !SHD
TOPICS(TKDW)%NSUBTOPICS=1 !KDW
TOPICS(TKHV)%NSUBTOPICS=1 !KHV
TOPICS(TKVA)%NSUBTOPICS=1 !KHA
TOPICS(TVCW)%NSUBTOPICS=1 !VCW
TOPICS(TKVV)%NSUBTOPICS=1 !KVV
TOPICS(TSTO)%NSUBTOPICS=1 !STO
TOPICS(TSPY)%NSUBTOPICS=1 !SSC
TOPICS(TPWT)%NSUBTOPICS=6 !PWT
TOPICS(TANI)%NSUBTOPICS=2 !ANI
TOPICS(THFB)%NSUBTOPICS=1 !HFB
TOPICS(TIBS)%NSUBTOPICS=4 !IBS
TOPICS(TSFT)%NSUBTOPICS=2 !SFT
TOPICS(TUZF)%NSUBTOPICS=8 !UZF
TOPICS(TMNW)%NSUBTOPICS=1 !MNW
TOPICS(TPST)%NSUBTOPICS=1 !PST
TOPICS(TWEL)%NSUBTOPICS=1 !WEL
TOPICS(TDRN)%NSUBTOPICS=2 !DRN
TOPICS(TRIV)%NSUBTOPICS=4 !RIV
TOPICS(TEVT)%NSUBTOPICS=3 !EVT
TOPICS(TGHB)%NSUBTOPICS=2 !GHB
TOPICS(TRCH)%NSUBTOPICS=1 !RCH
TOPICS(TOLF)%NSUBTOPICS=1 !OLF
TOPICS(TCHD)%NSUBTOPICS=1 !CHD
TOPICS(TISG)%NSUBTOPICS=1 !ISG
TOPICS(TSFR)%NSUBTOPICS=1 !SFR
TOPICS(TFHB)%NSUBTOPICS=2 !FHB
TOPICS(TLAK)%NSUBTOPICS=10 !LAK
TOPICS(TPCG)%NSUBTOPICS=1 !PCG
TOPICS(TGCG)%NSUBTOPICS=1 !GCG
TOPICS(TVDF)%NSUBTOPICS=1 !VDF
TOPICS(TFDE)%NSUBTOPICS=1 !FDE
TOPICS(TCBI)%NSUBTOPICS=1 !CBI
TOPICS(TSCO)%NSUBTOPICS=0 !SCO - initial no subtopics
!TOPICS(TADV)%NSUBTOPICS=1 !ADV
TOPICS(TDSP)%NSUBTOPICS=4 !DSP
TOPICS(TTVC)%NSUBTOPICS=0 !TVC - initial no subtopics
TOPICS(TPOR)%NSUBTOPICS=1 !POR
TOPICS(TOBS)%NSUBTOPICS=1 !OBS
TOPICS(THOB)%NSUBTOPICS=1 !HOB
TOPICS(TPID)%NSUBTOPICS=1 !PID
TOPICS(TICS)%NSUBTOPICS=0 !ICS - initial no subtopics
TOPICS(TFSC)%NSUBTOPICS=0 !FSC - initial no subtopics
TOPICS(TSSC)%NSUBTOPICS=0 !SSC - initial no subtopics
TOPICS(TFOD)%NSUBTOPICS=0 !FOD - initial no subtopics
TOPICS(TFOS)%NSUBTOPICS=0 !FOS - initial no subtopics
TOPICS(TRCT)%NSUBTOPICS=1 !RCT
TOPICS(TCON)%NSUBTOPICS=1 !CON
TOPICS(TIES)%NSUBTOPICS=1 !IES
TOPICS(TCAP)%TIMDEP=.FALSE. !CAP
TOPICS(TTOP)%TIMDEP=.FALSE. !TOP
TOPICS(TBOT)%TIMDEP=.FALSE. !BOT
TOPICS(TTHK)%TIMDEP=.FALSE. !THK
TOPICS(TBND)%TIMDEP=.FALSE. !BND
TOPICS(TSHD)%TIMDEP=.FALSE. !SHD
TOPICS(TKDW)%TIMDEP=.FALSE. !KDW
TOPICS(TKHV)%TIMDEP=.FALSE. !KHV
TOPICS(TKVA)%TIMDEP=.FALSE. !KVA
TOPICS(TVCW)%TIMDEP=.FALSE. !VCW
TOPICS(TKVV)%TIMDEP=.FALSE. !KVV
TOPICS(TSTO)%TIMDEP=.FALSE. !STO
TOPICS(TSPY)%TIMDEP=.FALSE. !SSC
TOPICS(TPWT)%TIMDEP=.FALSE. !PWT
TOPICS(TANI)%TIMDEP=.FALSE. !ANI
TOPICS(THFB)%TIMDEP=.FALSE. !HFB
TOPICS(TIBS)%TIMDEP=.FALSE. !IBS
TOPICS(TSFT)%TIMDEP=.FALSE. !SFT
TOPICS(TUZF)%TIMDEP=.TRUE. !UZF
TOPICS(TMNW)%TIMDEP=.TRUE. !MNW
TOPICS(TPST)%TIMDEP=.FALSE. !PST
TOPICS(TWEL)%TIMDEP=.TRUE. !WEL
TOPICS(TDRN)%TIMDEP=.TRUE. !DRN
TOPICS(TRIV)%TIMDEP=.TRUE. !RIV
TOPICS(TEVT)%TIMDEP=.TRUE. !EVT
TOPICS(TGHB)%TIMDEP=.TRUE. !GHB
TOPICS(TRCH)%TIMDEP=.TRUE. !RCH
TOPICS(TOLF)%TIMDEP=.TRUE. !OLF
TOPICS(TCHD)%TIMDEP=.TRUE. !CHD
TOPICS(TISG)%TIMDEP=.TRUE. !ISG
TOPICS(TSFR)%TIMDEP=.TRUE. !SFR
TOPICS(TFHB)%TIMDEP=.TRUE. !FHB
TOPICS(TLAK)%TIMDEP=.TRUE. !LAK
TOPICS(TPCG)%TIMDEP=.FALSE. !PCG
TOPICS(TGCG)%TIMDEP=.FALSE. !GCG
TOPICS(TVDF)%TIMDEP=.FALSE. !VDF
TOPICS(TFDE)%TIMDEP=.TRUE. !FDE
TOPICS(TCBI)%TIMDEP=.FALSE. !CBI
TOPICS(TSCO)%TIMDEP=.FALSE. !SCO
! TOPICS(TADV)%TIMDEP=.FALSE. !ADV
TOPICS(TDSP)%TIMDEP=.FALSE. !DSP
TOPICS(TTVC)%TIMDEP=.TRUE. !TVC
TOPICS(TPOR)%TIMDEP=.FALSE. !POR
TOPICS(TOBS)%TIMDEP=.TRUE. !OBS
TOPICS(THOB)%TIMDEP=.FALSE. !HOB
TOPICS(TPID)%TIMDEP=.FALSE. !PID
TOPICS(TICS)%TIMDEP=.FALSE. !ICS
TOPICS(TFSC)%TIMDEP=.FALSE. !FSC
TOPICS(TSSC)%TIMDEP=.FALSE. !SSC
TOPICS(TFOD)%TIMDEP=.FALSE. !FOD
TOPICS(TFOS)%TIMDEP=.FALSE. !FOS
TOPICS(TRCT)%TIMDEP=.FALSE. !RCT
TOPICS(TCON)%TIMDEP=.FALSE. !CON
TOPICS(TIES)%TIMDEP=.FALSE. !IES
!## option to add species
TOPICS%LSPECIES=.FALSE.
DO I=1,MAXTOPICS
SELECT CASE (I)
!## no species for drn,tolf
CASE (TDRN,TOLF,TISG,TSFT,TUZF,TEVT) !,TRCH)
TOPICS(I)%LSPECIES=.FALSE.
!## species for tsco,tics,tfsc,tssc,tfod,tfos
CASE (TSCO,TICS,TFSC,TSSC,TFOD,TFOS)
TOPICS(I)%LSPECIES=.TRUE.
CASE DEFAULT
IF(TOPICS(I)%TIMDEP)TOPICS(I)%LSPECIES=.TRUE.
END SELECT
ENDDO
DO I=1,MAXTOPICS; TOPICS(I)%SNAME=''; ENDDO
TOPICS(TCAP)%SNAME(1) ='(BND) Boundary (IDF)'
TOPICS(TCAP)%SNAME(2) ='(LUS) Landuse (IDF)'
TOPICS(TCAP)%SNAME(3) ='(RTZ) Rootzone (IDF)'
TOPICS(TCAP)%SNAME(4) ='(SLT) Soiltype (IDF)'
TOPICS(TCAP)%SNAME(5) ='(MST) Meteostation (IDF)'
TOPICS(TCAP)%SNAME(6) ='(SFL) Surfacelevel (IDF)'
TOPICS(TCAP)%SNAME(7) ='(ARQ) Artificial discharge (IDF)'
TOPICS(TCAP)%SNAME(8) ='(ARL) Artificial layer (IDF)'
TOPICS(TCAP)%SNAME(9) ='(ARL) Artificial location (IPF)'
TOPICS(TCAP)%SNAME(10)='(WRA) Wetted Rural Area (IDF)'
TOPICS(TCAP)%SNAME(11)='(WUA) Wetted Urban Area (IDF)'
TOPICS(TCAP)%SNAME(12)='(PUA) Pondingdepth Urban Area (IDF)'
TOPICS(TCAP)%SNAME(13)='(PRA) Pondingdepth Rural Area (IDF)'
TOPICS(TCAP)%SNAME(14)='(RUA) Runoff Resistance Urban Area (IDF)'
TOPICS(TCAP)%SNAME(15)='(RRA) Runoff Resistance Rural Area (IDF)'
TOPICS(TCAP)%SNAME(16)='(RUA) Runon Resistance Urban Area (IDF)'
TOPICS(TCAP)%SNAME(17)='(RRA) Runon Resistance Rural Area (IDF)'
TOPICS(TCAP)%SNAME(18)='(IUA) Infiltration Capacity Urban Area (IDF)'
TOPICS(TCAP)%SNAME(19)='(IRA) Infiltration Capacity Rural Area (IDF)'
TOPICS(TCAP)%SNAME(20)='(PWD) Purgewater Depth (IDF)'
TOPICS(TCAP)%SNAME(21)='(SMF) Soil Moisture Factor (IDF)'
TOPICS(TCAP)%SNAME(22)='(SPF) Soil Permeability Factor (IDF)'
TOPICS(TTOP)%SNAME(1) ='(TOP) Top of Modellayer (IDF)'
TOPICS(TBOT)%SNAME(1) ='(BOT) Bottom of Modellayer (IDF)'
TOPICS(TTHK)%SNAME(1) ='(THK) Thickness (IDF)'
TOPICS(TBND)%SNAME(1) ='(BND) Boundary Settings (IDF)'
TOPICS(TSHD)%SNAME(1) ='(SHD) Starting Heads (IDF)'
TOPICS(TKDW)%SNAME(1) ='(KDW) COnductance (IDF)'
TOPICS(TKHV)%SNAME(1) ='(KHV) Horizontal Permeability (IDF)'
TOPICS(TKVA)%SNAME(1) ='(KVA) Vertical Anisotropy (IDF)'
TOPICS(TVCW)%SNAME(1) ='(VCW) Vertical Resistance (IDF)'
TOPICS(TKVV)%SNAME(1) ='(KVV) Vertical Permeability (IDF)'
TOPICS(TSTO)%SNAME(1) ='(STO) Storage Coefficient (IDF)'
TOPICS(TSPY)%SNAME(1) ='(SSY) Specific Yield / Confined Storage Coef. (IDF)'
TOPICS(TPWT)%SNAME(1) ='(LAY) Layer Identification (IDF)'
TOPICS(TPWT)%SNAME(2) ='(STO) Phreatic Storage Coefficient (IDF)'
TOPICS(TPWT)%SNAME(3) ='(TA1) Top of Aquifer above PWT-layer (IDF)'
TOPICS(TPWT)%SNAME(4) ='(TAQ) Top of Aquitard PWT-layer (IDF)'
TOPICS(TPWT)%SNAME(5) ='(TA2) Top of Aquifer beneath PWT-layer (IDF)'
TOPICS(TPWT)%SNAME(6) ='(VCP) Vertical Resistance of PWT-clay (IDF)'
TOPICS(TANI)%SNAME(1) ='(FCT) Factor (IDF)'
TOPICS(TANI)%SNAME(2) ='(ANG) Angle (IDF)'
TOPICS(THFB)%SNAME(1) ='(HFB) Horizontal Barrier Flow (GEN)'
TOPICS(TIBS)%SNAME(1) ='(PCH) Preconsolidation Head (IDF)'
TOPICS(TIBS)%SNAME(2) ='(ESC) Elastic Storage Coefficient (IDF)'
TOPICS(TIBS)%SNAME(3) ='(ISC) Inelastic Storage Coefficient (IDF)'
TOPICS(TIBS)%SNAME(4) ='(SCP) Starting Compaction (IDF)'
TOPICS(TSFT)%SNAME(1) ='(SFT) Stream Flow Thickness (IDF)'
TOPICS(TSFT)%SNAME(2) ='(PER) Permeability (IDF)'
TOPICS(TUZF)%SNAME(1) ='(AEA) Areal Extent of Active Model (IDF)'
! TOPICS(TUZF)%SNAME(2) ='Overland Flow to SFR (>0) / LAK (<0) (IDF)'
! TOPICS(TUZF)%SNAME(2) ='Saturated Vertical Conductivity (IDF)'
TOPICS(TUZF)%SNAME(2) ='(BCE) Brooks-Corey Epsilon (IDF)'
TOPICS(TUZF)%SNAME(3) ='(SWC) Saturated Water Content of Unsat. Zone (IDF)'
TOPICS(TUZF)%SNAME(4) ='(IWC) Initial Water Content (IDF)'
TOPICS(TUZF)%SNAME(5) ='(INF) Infiltration Rates at Land Surface (IDF)'
TOPICS(TUZF)%SNAME(6) ='(EVA) Evaporation Demands (IDF)'
TOPICS(TUZF)%SNAME(7) ='(EXD) Extinction Depth (IDF)'
TOPICS(TUZF)%SNAME(8) ='(EWC) Extinction Water Content (IDF)'
TOPICS(TMNW)%SNAME(1) ='(WRL) Well Rate and Well Loss (IPF)'
TOPICS(TPST)%SNAME(1) ='(PAR) Parameters Estimation (-)'
TOPICS(TWEL)%SNAME(1) ='(WRA) Well Rate (IPF)'
TOPICS(TDRN)%SNAME(1) ='(CON) Conductance (IDF)'
TOPICS(TDRN)%SNAME(2) ='(DEL) Drainage Level (IDF)'
TOPICS(TRIV)%SNAME(1) ='(CON) Conductance (IDF)'
TOPICS(TRIV)%SNAME(2) ='(RST) River Stage (IDF)'
TOPICS(TRIV)%SNAME(3) ='(RBT) River Bottom (IDF)'
TOPICS(TRIV)%SNAME(4) ='(RIF) Infiltration Factor (IDF)'
TOPICS(TEVT)%SNAME(1) ='(EVA) Evapotranspiration Rate (IDF)'
TOPICS(TEVT)%SNAME(2) ='(SUR) Surface Level (IDF)'
TOPICS(TEVT)%SNAME(3) ='(EXD) Extinction Depth (IDF)'
TOPICS(TGHB)%SNAME(1) ='(CON) Conductance (IDF)'
TOPICS(TGHB)%SNAME(2) ='(LVL) Reference Level (IDF)'
TOPICS(TRCH)%SNAME(1) ='(RCH) Recharge Rate (IDF)'
TOPICS(TOLF)%SNAME(1) ='(LVL) Overland Flow Level (IDF)'
TOPICS(TCHD)%SNAME(1) ='(CHD) Constant Head (IDF)'
TOPICS(TISG)%SNAME(1) ='(ISG) Segment River (ISG)'
TOPICS(TSFR)%SNAME(1) ='(ISG) Stream Flow River (ISG)'
TOPICS(TFHB)%SNAME(1) ='(FHB) Specified Flow (IDF)'
TOPICS(TFHB)%SNAME(2) ='(FHB) Specified Head (IDF)'
TOPICS(TLAK)%SNAME(1) ='(LID) Lake Identifications (IDF)'
TOPICS(TLAK)%SNAME(2) ='(LBA) Lake Bathymetry (IDF)'
TOPICS(TLAK)%SNAME(3) ='(INI) Initial Lake Levels (IDF)'
TOPICS(TLAK)%SNAME(4) ='(MIN) Minimal Lake Levels (IDF)'
TOPICS(TLAK)%SNAME(5) ='(MAX) Maximal Lake Levels (IDF)'
TOPICS(TLAK)%SNAME(6) ='(LRE) Lakebed Resistance (IDF)'
TOPICS(TLAK)%SNAME(7) ='(LPR) Precipitation at surface Lake (IDF)'
TOPICS(TLAK)%SNAME(8) ='(LEV) Evaporation at surface Lake (IDF)'
TOPICS(TLAK)%SNAME(9) ='(LOR) Overland runoff (IDF)'
TOPICS(TLAK)%SNAME(10)='(LWD) Lake Withdrawall (IDF)'
TOPICS(TPCG)%SNAME(1) ='(PCG) Parameters PCG method (-)'
TOPICS(TGCG)%SNAME(1) ='(GCG) Parameters GCG method (-)'
TOPICS(TVDF)%SNAME(1) ='(VDF) Parameters VDF package (-)'
TOPICS(TFDE)%SNAME(1) ='(FDE) Fluid Density (IDF)'
TOPICS(TCBI)%SNAME(1) ='(CBI) Concentration Boundary Indicator (IDF)'
! TOPICS(TADV)%SNAME(1) ='(ADV) Parameters ADV package (-)'
TOPICS(TDSP)%SNAME(1) ='(DSP) Longitudinal Dispesivity (IDF)'
TOPICS(TDSP)%SNAME(2) ='(DSP) Ratio of Horizontal Transverse Dispersivity (IDF)'
TOPICS(TDSP)%SNAME(3) ='(DSP) Ratio of Vertical Transverse Dispersivity (IDF)'
TOPICS(TDSP)%SNAME(4) ='(DSP) Effective Molecular Diffusion Coefficient (IDF)'
TOPICS(TPOR)%SNAME(1) ='(POR) Porosity POR (IDF)'
TOPICS(TOBS)%SNAME(1) ='(OBS) Observation (IPF)'
TOPICS(THOB)%SNAME(1) ='(HOB) Bulk density of the porous medium (IDF)'
TOPICS(TPID)%SNAME(1) ='(PID) Porosity of the immobile domain (IDF)'
TOPICS(TICS)%SNAME(1) =''!(ICS) Initial concentration of the sorbed or immobile liquid phase (IDF)'
TOPICS(TFSC)%SNAME(1) =''!(FSC) First Sorption constant (IDF)'
TOPICS(TSSC)%SNAME(1) =''!(SSC) Second Sorption constant (IDF)'
TOPICS(TFOD)%SNAME(1) =''!(FOD) First order rate reaction dissolved hase (IDF)'
TOPICS(TFOS)%SNAME(1) =''!(FOS) First order rate reaction for the sorbed phase (IDF)'
TOPICS(TRCT)%SNAME(1) ='(RCT) Chemical Reaction Package'
TOPICS(TCON)%SNAME(1) ='(CON) Chloride Concentration Package'
TOPICS(TIES)%SNAME(1) ='(IES) Iterative Ensemble Smoother'
DO I=1,MAXTOPICS; TOPICS(I)%CMOD=TOPICS(I)%TNAME(2:4); ENDDO
CALL WDIALOGLOAD(ID_DPMANAGER)
CALL WDIALOGPUTIMAGE(ID_CLEAN,ID_ICONNEW,1)
CALL WDIALOGTOOLTIP(ID_CLEAN,'Refresh. Remove all definitions')
CALL WDIALOGPUTIMAGE(ID_DELETE,ID_ICONDELETE,1)
CALL WDIALOGTOOLTIP(ID_DELETE,'Delete the selected Topic')
CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
CALL WDIALOGTOOLTIP(ID_OPEN,'Open a *.PRJ file')
CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVEAS,1)
CALL WDIALOGTOOLTIP(ID_SAVE,'Save a *.PRJ file')
CALL WDIALOGPUTIMAGE(ID_OPENRUN,ID_ICONOPENRUN,1)
CALL WDIALOGTOOLTIP(ID_OPENRUN,'Open a *.RUN file')
CALL WDIALOGPUTIMAGE(ID_SAVERUN,ID_ICONSAVERUN,1)
CALL WDIALOGTOOLTIP(ID_SAVERUN,'Start the Simulation Manager')
CALL WDIALOGPUTIMAGE(ID_DRAW,ID_ICONDRAW,1)
CALL WDIALOGTOOLTIP(ID_DRAW,'Port Topic files to iMOD Manager')
CALL WDIALOGPUTIMAGE(ID_DRAW2,ID_ICONDRAWPLUS,1)
CALL WDIALOGTOOLTIP(ID_DRAW2,'Special Open - Selected Order')
CALL WDIALOGPUTIMAGE(ID_PROPERTIES,ID_ICONPROPERTIES,1)
CALL WDIALOGTOOLTIP(ID_PROPERTIES,'Define Characteristics')
CALL WDIALOGPUTIMAGE(ID_PROPERTIES_AUTO,ID_ICONPROPERTIES_AUTO,1)
CALL WDIALOGTOOLTIP(ID_PROPERTIES_AUTO,'Define Characteristics Automatically')
CALL WDIALOGPUTIMAGE(ID_CALC,ID_ICONCALC,1)
CALL WDIALOGTOOLTIP(ID_CALC,'Calculator for Predifined Options')
NPERIOD=0
NSPECIES=0
DO I=1,SIZE(TOPICS)
NULLIFY(TOPICS(I)%STRESS)
NULLIFY(TOPICS(I)%STRESS_TMP)
ENDDO
!## -----------------------------------------------
!## Define for each model which topics is available
!## all
ALLOCATE(MC(1)%T(MAXTOPICS),MC(1)%IACT(MAXTOPICS))
MC(1)%MCNAME='ALL'
DO I=1,MAXTOPICS; MC(1)%T(I)=I; ENDDO; MC(1)%IACT=1
!## for mf2005
ALLOCATE(MC(2)%T(34),MC(2)%IACT(34))
MC(2)%MCNAME='MODFLOW2005'; MC(2)%IACT=1
MC(2)%T=[TBND,TTOP,TBOT,TKHV,TKVA,TKDW,TKVV,TVCW,TSHD,TSTO,TSPY,TANI,THFB,TIBS,TPWT, & ! 1-15
TSFT,TCAP,TUZF,TRCH,TEVT,TDRN,TOLF,TRIV,TISG,TSFR,TLAK,TWEL,TMNW,TGHB,TCHD, & !16-30
TFHB,TPST,TPCG,TCON] !31-34
!## for modflow6
ALLOCATE(MC(3)%T(20),MC(3)%IACT(20))
MC(3)%MCNAME='MODFLOW6'; MC(3)%IACT=1
MC(3)%T=[TBND,TTOP,TBOT,TKHV,TKVA,TSHD,TSTO,TSPY,THFB,TUZF,TRCH,TEVT,TDRN,TRIV,TISG, & ! 1-15
TWEL,TMNW,TGHB,TCHD,TPCG] !16-20
!## for seawat
ALLOCATE(MC(4)%T(35),MC(4)%IACT(35))
MC(4)%MCNAME='SEAWAT'; MC(4)%IACT=1
MC(4)%T=[TBND,TTOP,TBOT,TKHV,TKVA,TKDW,TKVV,TVCW,TSHD,TSTO,TSPY,TPOR,TANI,TRCH,TEVT, & ! 1-15
TDRN,TRIV,TWEL,TGHB,TCHD,TOBS,TPCG,TGCG,TVDF,TFDE,TCBI,TSCO,TDSP,TTVC,TICS, & !16-30
TFSC,TSSC,TFOD,TFOS,TRCT] !31-35
!## for mt3d
ALLOCATE(MC(5)%T(21),MC(5)%IACT(21))
MC(5)%MCNAME='MT3D'; MC(5)%IACT=1
MC(5)%T=[TTOP,TTHK,TPOR,TRCH,TEVT,TRIV,TWEL,TGHB,TCHD,TOBS,TGCG,TCBI,TSCO,TDSP,TTVC, & ! 1-15
TICS,TFSC,TSSC,TFOD,TFOS,TRCT] !16-21
!## for particle tracking
ALLOCATE(MC(6)%T(4),MC(6)%IACT(4))
MC(6)%MCNAME='MODPATH'; MC(6)%IACT=1
MC(6)%T=[TBND,TTOP,TBOT,TPOR] ! 1- 4
!## -----------------------------------------------
ALLOCATE(TMPNAME(SIZE(MC))); TMPNAME=MC%MCNAME
CALL WDIALOGSELECT(ID_DPMANAGER_TAB2); CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,SIZE(TMPNAME),1) !MC%MCNAME,SIZE(MC),1)
DEALLOCATE(TMPNAME)
I=SIZE(MC(1)%IACT); CALL WGRIDROWS(IDF_GRID1,I)
ALLOCATE(TMPNAME(I)); TMPNAME=TOPICS(MC(1)%T)%TNAME
CALL WGRIDPUTSTRING(IDF_GRID1,1,TMPNAME,I) !TOPICS(MC(1)%T)%TNAME,I)
DEALLOCATE(TMPNAME)
CALL WGRIDPUTCHECKBOX(IDF_GRID1,2,MC(1)%IACT,I)
END SUBROUTINE PMANAGER_UTL_INIT
!####====================================================================
SUBROUTINE PMANAGER_SAVEMF2005_DEALLOCATE()
!####====================================================================
IMPLICIT NONE
IF(ALLOCATED(NP_IPER))DEALLOCATE(NP_IPER)
IF(PBMAN%IIES.EQ.0)THEN
CALL IDFDEALLOCATEX(PRJIDF)
IF(ALLOCATED(BND))THEN
CALL IDFDEALLOCATE(BND,SIZE(BND)); DEALLOCATE(BND)
ENDIF
ENDIF
IF(ALLOCATED(SHD))THEN
CALL IDFDEALLOCATE(SHD,SIZE(SHD)); DEALLOCATE(SHD)
ENDIF
IF(ALLOCATED(KDW))THEN
CALL IDFDEALLOCATE(KDW,SIZE(KDW)); DEALLOCATE(KDW)
ENDIF
IF(ALLOCATED(VCW))THEN
CALL IDFDEALLOCATE(VCW,SIZE(VCW)); DEALLOCATE(VCW)
ENDIF
IF(ALLOCATED(TOP))THEN
CALL IDFDEALLOCATE(TOP,SIZE(TOP)); DEALLOCATE(TOP)
ENDIF
IF(ALLOCATED(BOT))THEN
CALL IDFDEALLOCATE(BOT,SIZE(BOT)); DEALLOCATE(BOT)
ENDIF
IF(ALLOCATED(ANA))THEN
CALL IDFDEALLOCATE(ANA,SIZE(ANA)); DEALLOCATE(ANA)
ENDIF
IF(ALLOCATED(ANF))THEN
CALL IDFDEALLOCATE(ANF,SIZE(ANF)); DEALLOCATE(ANF)
ENDIF
IF(ALLOCATED(CON))THEN
CALL IDFDEALLOCATE(CON,SIZE(CON)); DEALLOCATE(CON)
ENDIF
IF(ALLOCATED(KHV))THEN
CALL IDFDEALLOCATE(KHV,SIZE(KHV)); DEALLOCATE(KHV)
ENDIF
IF(ALLOCATED(KVV))THEN
CALL IDFDEALLOCATE(KVV,SIZE(KVV)); DEALLOCATE(KVV)
ENDIF
IF(ALLOCATED(KVA))THEN
CALL IDFDEALLOCATE(KVA,SIZE(KVA)); DEALLOCATE(KVA)
ENDIF
IF(ALLOCATED(STO))THEN
CALL IDFDEALLOCATE(STO,SIZE(STO)); DEALLOCATE(STO)
ENDIF
IF(ALLOCATED(SPY))THEN
CALL IDFDEALLOCATE(SPY,SIZE(SPY)); DEALLOCATE(SPY)
ENDIF
IF(ALLOCATED(LAK))THEN
CALL IDFDEALLOCATE(LAK,SIZE(LAK)); DEALLOCATE(LAK)
ENDIF
IF(ALLOCATED(LBD))THEN
CALL IDFDEALLOCATE(LBD,SIZE(LBD)); DEALLOCATE(LBD)
ENDIF
IF(ALLOCATED(LCD))THEN
CALL IDFDEALLOCATE(LCD,SIZE(LCD)); DEALLOCATE(LCD)
ENDIF
IF(ALLOCATED(SFT))THEN
CALL IDFDEALLOCATE(SFT,SIZE(SFT)); DEALLOCATE(SFT)
ENDIF
IF(ALLOCATED(ULAKES)) DEALLOCATE(ULAKES)
IF(ALLOCATED(FHBHED)) DEALLOCATE(FHBHED)
IF(ALLOCATED(FHBFLW)) DEALLOCATE(FHBFLW)
IF(ALLOCATED(FHBNBDTIM))DEALLOCATE(FHBNBDTIM)
IF(ASSOCIATED(FNAMES)) DEALLOCATE(FNAMES)
IF(ALLOCATED(PRJILIST)) DEALLOCATE(PRJILIST)
!## set active layers for current submodel
IF(PBMAN%SMTYPE.EQ.1)THEN
IF(ASSOCIATED(PBMAN%SM))THEN
IF(ASSOCIATED(PBMAN%SM(PBMAN%ISUBMODEL)%IDF))THEN
CALL IDFDEALLOCATE(PBMAN%SM(PBMAN%ISUBMODEL)%IDF,SIZE(PBMAN%SM(PBMAN%ISUBMODEL)%IDF))
DEALLOCATE(PBMAN%SM(PBMAN%ISUBMODEL)%IDF)
ENDIF
ENDIF
ENDIF
END SUBROUTINE PMANAGER_SAVEMF2005_DEALLOCATE
!#####=================================================================
SUBROUTINE PMANAGER_UTL_CLOSE()
!#####=================================================================
IMPLICIT NONE
CALL WINDOWSELECT(0); CALL WMENUSETSTATE(ID_PMANAGER,2,0)
CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGHIDE()
IF(ALLOCATED(LAYCON))DEALLOCATE(LAYCON)
END SUBROUTINE PMANAGER_UTL_CLOSE
END MODULE MOD_PMANAGER_UTL