!!  Copyright (C) Stichting Deltares, 2005-2016.
!!
!!  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 <http://www.gnu.org/licenses/>.
!!
!!  Contact: imod.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands.
!!
MODULE MOD_PMANAGER

USE WINTERACTER
USE RESOURCE
USE MOD_MDL_PAR, ONLY : REPLACESTRING
USE MOD_UTL, ONLY : UTL_GETUNIT,ITOS,RTOS,UTL_WSELECTFILE,UTL_CAP,UTL_MESSAGEHANDLE,UTL_SUBST,UTL_FILLDATES,NEWLINE,UTL_LISTOFFILES, &
    IDATETOGDATE,UTL_IDATETOJDATE,UTL_GDATE,UTL_JDATETOIDATE,JD,UTL_IDFSNAPTOGRID,UTL_CREATEDIR,UTL_GETMED,UTL_CLOSEUNITS,ITIMETOHMS, &
    HMSTOITIME,UTL_IDATETOJDATE,UTL_PCK_READTXT,UTL_PCK_GETTLP,ITIMETOGDATE,UTL_IMODVERSION,UTL_DEBUGLEVEL
USE MOD_IDF, ONLY : IDFREAD,IDFDEALLOCATE,IDFNULLIFY,IDFREADSCALE,IDFCOPY,IDFDEALLOCATEX,IDFIROWICOL,IDFALLOCATEX,IDFGETAREA,IDFFILLSXSY
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_PMANAGER_PAR
USE MOD_MANAGER, ONLY : MANAGERDELETE
USE MODPLOT, ONLY : MP,MPW
USE IMOD, ONLY : IDFINIT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE DATEVAR
USE MOD_ISG_GRID, ONLY : ISG2GRID
USE MOD_ISG_UTL, ONLY : ISGDEAL,UTL_GETUNITSISG,ISGREAD
USE MOD_POLINT, ONLY : POL1LOCATE
USE MOD_QKSORT
USE MOD_ASC2IDF_HFB, ONLY : ASC2IDF_HFB
USE MOD_ASC2IDF_PAR, ONLY : ASC2IDF_INT_NULLIFY,ASC2IDF_INT_DEALLOCATE,XP,YP,ZP,WP,FP

TYPE SIMGRO_OBJ
 INTEGER :: IBOUND   !boundary condition
 INTEGER :: LGN      !landuse
 INTEGER :: METEO    !meteo-station
 INTEGER :: BER_LAAG !artificial recharge layer
 INTEGER :: BEREGEN  !artificial recharge
 INTEGER :: BODEM    !soil type
 REAL    :: BEREGEN_Q  !artificial recharge strength
 REAL    :: NOPP     !wetted-surface
 REAL    :: SOPP     !urban-surface
 REAL    :: RZ       !rootzone
 REAL    :: MV       !surface-level
 REAL    :: PWT_LEVEL !level for PWT (optional)
 REAL    :: COND      !conductivity
 REAL    :: MOISTURE  !moisture
 REAL    :: VXMU_SOPP !micro-storage capacity, sill of the runoff relationship
 REAL    :: VXMU_ROPP !micro-storage capacity, sill of the runoff relationship
 REAL    :: CRUNOFF_SOPP !runoff resistance (days)
 REAL    :: CRUNOFF_ROPP !runoff resistance (days)
 REAL    :: CRUNON_SOPP !runon resistance (days)
 REAL    :: CRUNON_ROPP !runon resistance (days)
 REAL    :: QINFBASIC_SOPP !infiltratie cap.
 REAL    :: QINFBASIC_ROPP
END TYPE SIMGRO_OBJ
TYPE(SIMGRO_OBJ),ALLOCATABLE,DIMENSION(:,:) :: SIMGRO         
INTEGER,PRIVATE :: INDSB     !unit number for svat2swnr_roff.inp
INTEGER,PRIVATE :: IAREA     !unit number for area_msw.inp
INTEGER,PRIVATE :: ISELSVAT  !unit number for sel_svat_bda.inp
INTEGER,PRIVATE :: ISCAP     !unit number for scap_msw.inp
INTEGER,PRIVATE :: IGWMP     !unit number for gwmp_msw.inp
INTEGER,PRIVATE :: IMODSIM   !unit number for mod-sim.txt
INTEGER,PRIVATE :: IINFI     !unit number for infi_svat.inp
INTEGER,PRIVATE :: IIDF      !unit number for idf_svat.inp
INTEGER,PRIVATE :: IUSCL   
REAL,PARAMETER,PRIVATE :: MSWPMV=10.0       !##   add meter to surface level urban area
INTEGER,PRIVATE :: IARMWP

CONTAINS

 !###======================================================================
 SUBROUTINE PMANAGERMAIN(ITYPE,MESSAGE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITYPE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER :: I
 
 SELECT CASE (ITYPE)
  CASE (FIELDCHANGED)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_TREEVIEW1)
     CALL PMANAGERFIELDS()
   END SELECT
  CASE (PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_CLEAN)
     CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to refresh the Project Manager?','Question')
     IF(WINFODIALOG(4).EQ.1)THEN
      DO I=1,SIZE(TOPICS); CALL PMANAGER_DEALLOCATE(I); ENDDO; CALL PMANAGER_DEALLOCATE_PEST()
      CALL PMANAGERUPDATE(0,0,0)
     ENDIF
    CASE (ID_DRAW)
     CALL PMANAGERDRAW()
    CASE (ID_DRAW2)
     CALL PMANAGERDRAW_PLUS()
    CASE (ID_PROPERTIES)
     CALL PMANAGEROPEN()
    CASE (ID_OPENRUN,ID_SAVERUN)
     IF(PMANAGERRUN(MESSAGE%VALUE1,'',0))THEN; ENDIF
    CASE (ID_OPEN,ID_SAVE)
     IF(PMANAGERPRJ(MESSAGE%VALUE1,'',0))THEN; ENDIF
    CASE (ID_DELETE)
     CALL PMANAGERDELETE()
    CASE (IDCANCEL)
     CALL PMANAGERCLOSE()
    CASE (IDHELP)
     CALL IMODGETHELP('3.3.6','VMO.iMODProjMan')
   END SELECT
 END SELECT

 END SUBROUTINE PMANAGERMAIN

 !###======================================================================
 SUBROUTINE PMANAGEROPEN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,II,J,K,N,M,JJ,ITYPE,ID,IPER,ITOPIC,IST,IYR,IMH,IDY,ISUBTOPIC, &
            ISYS,IOPTION,IHR,IMT,ISC,ICF
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=256) :: CNAME
 CHARACTER(LEN=3) :: EXT
 LOGICAL :: LEX,LNEW
 CHARACTER(LEN=MAXLEN) :: CD
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILAY,ISORT
 REAL(KIND=8),ALLOCATABLE,DIMENSION(:) :: RTIME
 CHARACTER(LEN=256),POINTER,DIMENSION(:) :: INPLIST
   
 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGGETTREEVIEW(ID_TREEVIEW1,ID,CNAME)

 !## get the right topics, attributes from the tree-view
 IF(.NOT.PMANAGER_GETSELECTED(ID,ITOPIC,IPER,ISYS,ISUBTOPIC,1))RETURN

 SELECT CASE (ITOPIC)
  CASE (21)
    EXT='IPF'; ICF=0
  CASE (29)
    EXT='ISG'; ICF=0
  CASE (15)
    EXT='GEN'; ICF=0
  CASE DEFAULT
    EXT='IDF'; ICF=1
 END SELECT
 
 !## pest goes to another dialog
 IF(ITOPIC.EQ.20)THEN
  CALL PMANAGEROPEN_PEST()
  IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   !## create/update new period
   CALL PMANAGER_STRESSES(ITOPIC,IPER)   
   !## create new system
   CALL PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)
  ELSE
   IPER=1; ISYS=1
  ENDIF
  TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%IACT =1 
  CALL PMANAGERUPDATE(ITOPIC,IPER,ISYS)  
  RETURN
 ENDIF

 N=TOPICS(ITOPIC)%NSUBTOPICS; ALLOCATE(PRJ(N))
 IYR=0; IMH=0; IDY=0; IHR=0; IMT=0; ISC=0

 CALL WDIALOGLOAD(ID_DPMANAGEROPEN,ID_DPMANAGEROPEN)

 !## add a new period
 !## add a new system for current period 
 IF(IPER.EQ.0.OR.ISYS.EQ.0)THEN
  PRJ%ILAY =1
  PRJ%FCT  =1.0
  PRJ%IMP  =0.0
  PRJ%CNST =-999.99
  PRJ%ICNST=ICF
  PRJ%FNAME=''
  PRJ%IACT =1
  CALL IOSDATE(IYR,IMH,IDY); IHR=0; IMT=0; ISC=0
  CALL WDIALOGPUTSTRING(IDOK,'Add New System')
  LNEW=.FALSE.; IF(IPER.EQ.0)LNEW=.TRUE.
 !## edit an existing system
 ELSE
  DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
   PRJ(ISUBTOPIC)%FNAME=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME
   PRJ(ISUBTOPIC)%FCT  =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FCT
   PRJ(ISUBTOPIC)%IMP  =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%IMP
   PRJ(ISUBTOPIC)%CNST =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%CNST
   PRJ(ISUBTOPIC)%ICNST=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST
   PRJ(ISUBTOPIC)%ILAY =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ILAY
   PRJ(ISUBTOPIC)%IACT =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%IACT
  ENDDO
  CALL WDIALOGPUTSTRING(IDOK,'Adjust Parameters for System')
  LNEW=.FALSE.
 ENDIF
 
 IF(ITOPIC.EQ.1.AND.IPER.GT.0)THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES))THEN
    ALLOCATE(INPLIST(SIZE(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES)))
    INPLIST=TOPICS(ITOPIC)%STRESS(IPER)%INPFILES
   ENDIF
  ENDIF
 ENDIF
 
 IOPTION=1
 
 !## can not change date
 IF(.NOT.LNEW)THEN
  CALL WDIALOGFIELDSTATE(IDF_RADIO3,0)
  CALL WDIALOGFIELDSTATE(IDF_RADIO4,0)
  CALL WDIALOGFIELDSTATE(IDF_RADIO5,0)
 ENDIF

 IF(IPER.GT.0)THEN
  IF(TOPICS(ITOPIC)%TIMDEP)THEN
   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
   !## true date eentered
   IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN
    CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO4) !## transient
    IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO4,1)
   ELSE
    !## check whether available period selected
    DO I=1,NPERIOD; IF(TRIM(UTL_CAP(TOPICS(ITOPIC)%STRESS(IPER)%CDATE,'U')).EQ.TRIM(UTL_CAP(PERIOD(I)%NAME,'U')))EXIT; ENDDO
    IF(I.LE.NPERIOD)THEN
     IOPTION=I
     CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO5) !## specified period
     IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO5,1)
    ELSE
     CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3) !## steady-state
     IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO3,1)
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 
 IST=1
 CALL WDIALOGTITLE('Define Characteristics for: '//TRIM(TOPICS(ITOPIC)%TNAME))
 ALLOCATE(MENUNAMES(TOPICS(ITOPIC)%NSUBTOPICS))
 DO J=1,TOPICS(ITOPIC)%NSUBTOPICS; MENUNAMES(J)=TOPICS(ITOPIC)%SNAME(J); ENDDO
 CALL WDIALOGPUTMENU(IDF_MENU1,MENUNAMES,TOPICS(ITOPIC)%NSUBTOPICS,IST)
 IF(TOPICS(ITOPIC)%NSUBTOPICS.EQ.1)CALL WDIALOGFIELDSTATE(IDF_MENU1,2)
 DEALLOCATE(MENUNAMES)
  
 IF(ITOPIC.EQ.1)THEN
  CALL WDIALOGFIELDSTATE(IDF_LABEL1,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER1,0)
  CALL WDIALOGFIELDSTATE(ID_ADDFILES,1)
 ELSE
  CALL WDIALOGFIELDSTATE(ID_ADDFILES,0)
 ENDIF
 
 IF(NPERIOD.EQ.0)THEN
  CALL WDIALOGFIELDSTATE(IDF_MENU3,0)
  CALL WDIALOGCLEARFIELD(IDF_MENU3)
 ELSE
  CALL WDIALOGPUTMENU(IDF_MENU3,PERIOD%NAME,NPERIOD,IOPTION)
  CALL WDIALOGFIELDSTATE(IDF_MENU3,1)
 ENDIF
 
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPENIDF,1)
 
 IF(.NOT.TOPICS(ITOPIC)%TIMDEP)THEN
  CALL WDIALOGFIELDSTATE(IDF_RADIO3,0)
  CALL WDIALOGFIELDSTATE(IDF_RADIO4,0)
  CALL WDIALOGFIELDSTATE(IDF_RADIO5,0)
  CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER2,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER5,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER6,0)
  CALL WDIALOGFIELDSTATE(IDF_MENU2,0)
  CALL WDIALOGFIELDSTATE(IDF_MENU3,0)
  CALL WDIALOGFIELDSTATE(ID_PROPERTIES,0)
  CALL WDIALOGPUTSTRING(IDF_LABEL1,'Assign parameter to modellayer. Use >0 to enter modellayer number')
 ELSE
  CALL WDIALOGPUTSTRING(IDF_LABEL1,'Assign parameter to modellayer. Use >0 to enter modellayer number; use -1 to assign to uppermost active '// &
             'modellayer and use =0 to assign to modellayers automatically')
 ENDIF
 
 CALL WDIALOGPUTMENU(IDF_MENU2,CDATE,12,MAX(1,IMH))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,IDY)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3,IYR)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IHR)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IMT)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER6,ISC)
 
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,PRJ(1)%ILAY)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1 ,PRJ(1)%IACT)

 IF(TOPICS(ITOPIC)%TIMDEP)THEN
  CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,-1,9999)
 ELSE
  CALL WDIALOGRANGEINTEGER(IDF_INTEGER1, 1,9999)
 ENDIF

 CALL WDIALOGFIELDSTATE(IDF_RADIO1,ICF)
 IF(ICF.EQ.0)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
 
 CALL PMANAGERPUTFIELDS(IST)
 CALL PMANAGEROPENFIELDS(TOPICS(ITOPIC)%TIMDEP,LNEW)
 CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2)
 
 CALL WDIALOGSHOW(-1,-1,0,3)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_MENU1)
      CALL PMANAGERGETFIELDS(IST)
     CASE (IDF_RADIO1,IDF_RADIO2,IDF_RADIO3,IDF_RADIO4,IDF_RADIO5,IDF_CHECK1)
      CALL PMANAGEROPENFIELDS(TOPICS(ITOPIC)%TIMDEP,LNEW)
     CASE (IDF_INTEGER2,IDF_INTEGER3,IDF_MENU2)
      CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2)
    END SELECT
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDF_MENU1)
      CALL PMANAGERPUTFIELDS(IST)
      CALL PMANAGEROPENFIELDS(TOPICS(ITOPIC)%TIMDEP,LNEW)
    END SELECT
    
   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_ADDFILES)
      CALL UTL_LISTOFFILES(INPLIST,(/'*.*','','','','','Specify the files to be added to the package'/),I)
     CASE (ID_PROPERTIES)
      CALL PMANAGERDEFINEPERIODS()
      IF(NPERIOD.GT.0)THEN
       CALL WDIALOGPUTMENU(IDF_MENU3,PERIOD%NAME,NPERIOD,1)
       CALL WDIALOGFIELDSTATE(IDF_MENU3,1)
      ELSE
       CALL WDIALOGFIELDSTATE(IDF_MENU3,0)
       CALL WDIALOGCLEARFIELD(IDF_MENU3)
      ENDIF
     CASE (ID_OPEN)
      IF(UTL_WSELECTFILE('iMOD '//TRIM(EXT)//' File (*.'//TRIM(EXT)//')|*.'//TRIM(EXT)//'|',     &
        LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,PRJ(IST)%FNAME,&
        'Load iMOD '//TRIM(EXT)//' File'))THEN
       CALL WDIALOGPUTSTRING(IDF_STRING1,PRJ(IST)%FNAME)
      ENDIF
     CASE (IDOK)
      LEX=.TRUE.
      IF(TOPICS(ITOPIC)%TIMDEP)THEN
       CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,I)
       CD=''
       IF(I.EQ.1)THEN     !## steady-state
        CD='STEADY-STATE'; IYR=0; IMH=0; IDY=0; IHR=0; IMT=0; ISC=0
       ELSEIF(I.EQ.2)THEN !## date
        CALL WDIALOGGETINTEGER(IDF_INTEGER2,IDY)
        CALL WDIALOGGETINTEGER(IDF_INTEGER3,IYR)
        CALL WDIALOGGETMENU(IDF_MENU2,IMH)
        CALL WDIALOGGETINTEGER(IDF_INTEGER4,IHR)
        CALL WDIALOGGETINTEGER(IDF_INTEGER5,IMT)
        CALL WDIALOGGETINTEGER(IDF_INTEGER6,ISC)
        WRITE(CD,'(I4.4,5(A1,I2.2))') IYR,'-',IMH,'-',IDY,' ',IHR,':',IMT,':',ISC
        
       ELSEIF(I.EQ.3)THEN !## period
        CALL WDIALOGGETMENU(IDF_MENU3,I)
        WRITE(CD,'(A)') PERIOD(I)%NAME
        IYR=0; IMH=0; IDY=0; IHR=0; IMT=0; ISC=0
       ENDIF

       IF(LNEW)THEN
        !## test whether date has been defined already
        N=0; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))N=SIZE(TOPICS(ITOPIC)%STRESS)
        DO I=1,N
         IF(TRIM(UTL_CAP(TOPICS(ITOPIC)%STRESS(I)%CDATE,'U')).EQ.TRIM(UTL_CAP(CD,'U')))THEN
          !## defined already
          CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Entered date ['//TRIM(CD)//'] has been defined already.','Information')
          LEX=.FALSE.
         ENDIF
        ENDDO
       ENDIF
       
      ENDIF
      IF(LEX)THEN
       CALL WDIALOGGETINTEGER(IDF_INTEGER1,PRJ(1)%ILAY)
       CALL WDIALOGGETCHECKBOX(IDF_CHECK1 ,PRJ(1)%IACT)
       PRJ(1:SIZE(PRJ))%ILAY=PRJ(1)%ILAY
       PRJ(1:SIZE(PRJ))%IACT=PRJ(1)%IACT
       CALL PMANAGERGETFIELDS(IST)
       EXIT
      ENDIF
     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 CALL WDIALOGUNLOAD()

 IF(MESSAGE%VALUE1.EQ.IDOK)THEN
  
  !## create new period
  CALL PMANAGER_STRESSES(ITOPIC,IPER)   
  !## create new system
  CALL PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)

  TOPICS(ITOPIC)%STRESS(IPER)%CDATE=CD
  TOPICS(ITOPIC)%STRESS(IPER)%IYR=IYR; TOPICS(ITOPIC)%STRESS(IPER)%IMH=IMH
  TOPICS(ITOPIC)%STRESS(IPER)%IDY=IDY; TOPICS(ITOPIC)%STRESS(IPER)%IHR=IHR
  TOPICS(ITOPIC)%STRESS(IPER)%IMT=IMT; TOPICS(ITOPIC)%STRESS(IPER)%ISC=ISC

  IF(ITOPIC.EQ.1)THEN
   IF(ASSOCIATED(INPLIST))THEN
    IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES))DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES)
    ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%INPFILES(SIZE(INPLIST)))
    TOPICS(ITOPIC)%STRESS(IPER)%INPFILES=INPLIST
    DEALLOCATE(INPLIST)
   ENDIF
  ENDIF
  
  DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%IACT =PRJ(ISUBTOPIC)%IACT
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME=PRJ(ISUBTOPIC)%FNAME
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FCT  =PRJ(ISUBTOPIC)%FCT
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%IMP  =PRJ(ISUBTOPIC)%IMP
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST=PRJ(ISUBTOPIC)%ICNST
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%CNST =PRJ(ISUBTOPIC)%CNST
   TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ILAY =PRJ(ISUBTOPIC)%ILAY
   IF(PRJ(ISUBTOPIC)%ICNST.EQ.2)THEN
    TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ALIAS= &
       UTL_CAP(TRIM(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME &
      (INDEX(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME,'\',.TRUE.)+1:)),'L')
   ENDIF
  ENDDO
  
  !## 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; ISORT=0
   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; 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 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)%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

  CALL PMANAGERUPDATE(ITOPIC,IPER,ISYS)

 ENDIF
  
 DEALLOCATE(PRJ)

 END SUBROUTINE PMANAGEROPEN
 
 !###======================================================================
 SUBROUTINE PMANAGEROPEN_PEST()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,DID,N,I
 
 DID=WINFODIALOG(CURRENTDIALOG)
 CALL WDIALOGLOAD(ID_DPMANAGER_PEST,ID_DPMANAGER_PEST)
 
 CALL WDIALOGPUTSTRING(IDOK,'Apply System Settings')
 
 !## fill in values
 CALL WDIALOGPUTINTEGER(IDF_INTEGER7 ,PEST%PE_MXITER)
 CALL WDIALOGPUTREAL(IDF_REAL4,PEST%PE_STOP,'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL8,PEST%PE_PADJ ,'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL5,PEST%PE_SENS,'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL9,PEST%PE_DRES,'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL6,PEST%PE_TARGET(1),'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL7,PEST%PE_TARGET(2),'(F10.2)')
 CALL WDIALOGPUTOPTION(IDF_MENU4,PEST%PE_SCALING)
 CALL WDIALOGPUTOPTION(IDF_MENU5,PEST%PE_KTYPE)

 N=0; IF(ASSOCIATED(PEST%S_PERIOD))N=SIZE(PEST%S_PERIOD)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER8 ,N)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER8,2) 

 N=0; IF(ASSOCIATED(PEST%B_FRACTION))N=SIZE(PEST%B_FRACTION)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER9 ,N)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER9,2)

 N=0; IF(ASSOCIATED(PEST%PARAM))N=SIZE(PEST%PARAM)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER10,N)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER10,2) 

 N=0; IF(ASSOCIATED(PEST%IDFFILES))N=SIZE(PEST%IDFFILES)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER11,N)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER11,2) 
 
 N=0; IF(ASSOCIATED(PEST%MEASURES))N=SIZE(PEST%MEASURES)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER12,N)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER12,2) 

 CALL WDIALOGSHOW(-1,-1,0,3)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
    END SELECT
    SELECT CASE (MESSAGE%VALUE1)
    END SELECT
    
   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_PERIODS)
      CALL WDIALOGGETINTEGER(IDF_INTEGER8,N)
      CALL PMANAGEROPEN_PESTPARAM(ID_PERIODS,N)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER8,N)
     CASE (ID_BATCHFILES)
      CALL WDIALOGGETINTEGER(IDF_INTEGER9,N)
      CALL PMANAGEROPEN_PESTPARAM(ID_BATCHFILES,N)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER9,N)
     CASE (ID_PARAMETERS)
      CALL WDIALOGGETINTEGER(IDF_INTEGER10,N)
      CALL PMANAGEROPEN_PESTPARAM(ID_PARAMETERS,N)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER10,N)
     CASE (ID_ZONES)
      CALL WDIALOGGETINTEGER(IDF_INTEGER11,N)
      CALL PMANAGEROPEN_PESTPARAM(ID_ZONES,N)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER11,N)
     CASE (ID_MEASURES)
      CALL WDIALOGGETINTEGER(IDF_INTEGER12,N)
      CALL PMANAGEROPEN_PESTPARAM(ID_MEASURES,N)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER12,N)
     CASE (IDOK,IDCANCEL)
      EXIT   
    END SELECT
  END SELECT

 ENDDO

 !## read values
 IF(MESSAGE%VALUE1.EQ.IDOK)THEN
  CALL WDIALOGGETINTEGER(IDF_INTEGER7 ,PEST%PE_MXITER)
  CALL WDIALOGGETREAL(IDF_REAL4,PEST%PE_STOP)
  CALL WDIALOGGETREAL(IDF_REAL8,PEST%PE_PADJ)
  CALL WDIALOGGETREAL(IDF_REAL5,PEST%PE_SENS)
  CALL WDIALOGGETREAL(IDF_REAL9,PEST%PE_DRES)
  CALL WDIALOGGETREAL(IDF_REAL6,PEST%PE_TARGET(1))
  CALL WDIALOGGETREAL(IDF_REAL7,PEST%PE_TARGET(2))
  CALL WDIALOGGETMENU(IDF_MENU4,PEST%PE_SCALING)
  CALL WDIALOGGETMENU(IDF_MENU5,PEST%PE_KTYPE)
 ENDIF
 
 CALL WDIALOGSELECT(ID_DPMANAGER_PEST)
 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(DID)

 END SUBROUTINE PMANAGEROPEN_PEST

 !###======================================================================
 SUBROUTINE PMANAGEROPEN_PESTPARAM(ID,N)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER,INTENT(INOUT) :: N
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,DID,I,M

 DID=WINFODIALOG(CURRENTDIALOG)
    
 CALL WDIALOGLOAD(ID_DPMANAGER_PESTFILES,ID_DPMANAGER_PESTFILES)
 SELECT CASE (ID)

  CASE (ID_PERIODS)
   
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
   CALL WDIALOGSETTAB(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB1)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB2,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB3,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB4,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB5,0)
   
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB1)
   CALL WDIALOGPUTINTEGER(IDF_INTEGER8,N)
   IF(N.GT.0)THEN
    CALL WGRIDROWS(IDF_GRID1,N)
    CALL WGRIDPUTINTEGER(IDF_GRID1,1,PEST%S_PERIOD,N)
    CALL WGRIDPUTINTEGER(IDF_GRID1,2,PEST%E_PERIOD,N)
   ELSE
    CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
   ENDIF
   
  CASE (ID_BATCHFILES)
   
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
   CALL WDIALOGSETTAB(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB2)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB1,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB3,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB4,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB5,0)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB2)
   CALL WDIALOGPUTINTEGER(IDF_INTEGER9,N)
   IF(N.GT.0)THEN
    CALL WGRIDROWS(IDF_GRID1,N)
    CALL WGRIDPUTREAL(IDF_GRID1,1,PEST%B_FRACTION,N)
    CALL WGRIDPUTSTRING(IDF_GRID1,2,PEST%B_BATCHFILE,N)
    CALL WGRIDPUTSTRING(IDF_GRID1,3,PEST%B_OUTFILE,N)
   ELSE
    CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
   ENDIF
   
  CASE (ID_PARAMETERS)
     
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
   CALL WDIALOGSETTAB(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB3)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB1,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB2,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB4,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB5,0)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB3)
   CALL WDIALOGPUTINTEGER(IDF_INTEGER10,N)
   IF(N.GT.0)THEN
    CALL WGRIDROWS(IDF_GRID1,N)
    CALL WGRIDPUTCHECKBOX(IDF_GRID1,1 ,PEST%PARAM%PACT,N)
    CALL WGRIDPUTMENU(IDF_GRID1    ,2 ,PARAM,SIZE(PARAM),PEST%PARAM%IPARAM,N)
    CALL WGRIDPUTINTEGER(IDF_GRID1 ,3 ,PEST%PARAM%PILS,N)
    CALL WGRIDPUTINTEGER(IDF_GRID1 ,4 ,PEST%PARAM%PIZONE,N)
    CALL WGRIDPUTINTEGER(IDF_GRID1 ,5 ,PEST%PARAM%PIGROUP,N)
    CALL WGRIDPUTREAL(IDF_GRID1    ,6 ,PEST%PARAM%PINI,N)
    CALL WGRIDPUTREAL(IDF_GRID1    ,7 ,PEST%PARAM%PMIN,N)
    CALL WGRIDPUTREAL(IDF_GRID1    ,8 ,PEST%PARAM%PMAX,N)
    CALL WGRIDPUTREAL(IDF_GRID1    ,9 ,PEST%PARAM%PDELTA,N)
    CALL WGRIDPUTREAL(IDF_GRID1    ,10,PEST%PARAM%PINCREASE,N)
    CALL WGRIDPUTCHECKBOX(IDF_GRID1,11,PEST%PARAM%PLOG,N)
   ELSE
    CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
   ENDIF

  CASE (ID_ZONES)
   
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
   CALL WDIALOGSETTAB(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB4)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB1,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB2,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB3,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB5,0)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB4)
   CALL WDIALOGPUTINTEGER(IDF_INTEGER11,N)
   IF(N.GT.0)THEN
    CALL WGRIDROWS(IDF_GRID1,N)
    CALL WGRIDPUTSTRING(IDF_GRID1,1,PEST%IDFFILES,N)
   ELSE
    CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
   ENDIF
   
  CASE (ID_MEASURES)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
   CALL WDIALOGSETTAB(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB5)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB1,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB2,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB3,0)
   CALL WDIALOGTABSTATE(IDF_TAB1,ID_DPMANAGER_PESTFILES_TAB4,0)
   
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB5)
   CALL WDIALOGPUTINTEGER(IDF_INTEGER12,N)
   IF(N.GT.0)THEN
    CALL WGRIDROWS(IDF_GRID1,N)
    CALL WGRIDPUTSTRING  (IDF_GRID1,1,PEST%MEASURES%IPFNAME,N)
    CALL WGRIDPUTCHECKBOX(IDF_GRID1,2,PEST%MEASURES%IPFTYPE,N)
    CALL WGRIDPUTINTEGER (IDF_GRID1,3,PEST%MEASURES%IXCOL,N)
    CALL WGRIDPUTINTEGER (IDF_GRID1,4,PEST%MEASURES%IYCOL,N)
    CALL WGRIDPUTINTEGER (IDF_GRID1,5,PEST%MEASURES%ILCOL,N)
    CALL WGRIDPUTINTEGER (IDF_GRID1,6,PEST%MEASURES%IMCOL,N)
    CALL WGRIDPUTINTEGER (IDF_GRID1,7,PEST%MEASURES%IVCOL,N)
   ELSE
    CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
   ENDIF
    
 END SELECT
 
 CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
 CALL WDIALOGSHOW(-1,-1,0,3)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
    END SELECT
    SELECT CASE (MESSAGE%VALUE1)
    END SELECT
    
   CASE(PUSHBUTTON)
    CALL WDIALOGSELECT(MESSAGE%WIN)

    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_PERIODS)

      CALL WDIALOGGETINTEGER(IDF_INTEGER8,N)
      IF(N.EQ.0)THEN
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       IF(ASSOCIATED(PEST%S_PERIOD))DEALLOCATE(PEST%S_PERIOD,PEST%E_PERIOD)
       CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
      ELSE
       M=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
       IF(N.GT.M)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can specify a maximum of '//TRIM(ITOS(M))//' Periods','Error'); N=M
       ENDIF
      
       !## resize variables
       IF(ASSOCIATED(PEST%S_PERIOD))THEN
        M=SIZE(PEST%S_PERIOD)
        IF(N.NE.M)THEN
         ALLOCATE(PEST%S_PERIOD_BU(N),PEST%E_PERIOD_BU(N)); PEST%S_PERIOD_BU=20150101; PEST%E_PERIOD_BU=20151231
         DO I=1,MIN(N,M); PEST%S_PERIOD_BU(I)=PEST%S_PERIOD(I); ENDDO
         DO I=1,MIN(N,M); PEST%E_PERIOD_BU(I)=PEST%E_PERIOD(I); ENDDO
         DEALLOCATE(PEST%S_PERIOD,PEST%E_PERIOD); PEST%S_PERIOD=>PEST%S_PERIOD_BU; PEST%E_PERIOD=>PEST%E_PERIOD_BU
        ENDIF
       ELSE
        ALLOCATE(PEST%S_PERIOD(N),PEST%E_PERIOD(N)); PEST%S_PERIOD=20150101; PEST%E_PERIOD=20151231
       ENDIF  

       CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
       CALL WGRIDROWS(IDF_GRID1,N)
       CALL WGRIDPUTINTEGER(IDF_GRID1,1,PEST%S_PERIOD,N)
       CALL WGRIDPUTINTEGER(IDF_GRID1,2,PEST%E_PERIOD,N) 
      ENDIF
      
     CASE (ID_BATCHFILES)

      CALL WDIALOGGETINTEGER(IDF_INTEGER9,N)
      IF(N.EQ.0)THEN
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       IF(ASSOCIATED(PEST%B_FRACTION))DEALLOCATE(PEST%B_FRACTION,PEST%B_BATCHFILE,PEST%B_OUTFILE)
       CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
      ELSE
       M=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
       IF(N.GT.M)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can specify a maximum of '//TRIM(ITOS(M))//' Batchfiles','Error'); N=M
       ENDIF
    
       !## resize variables
       IF(ASSOCIATED(PEST%B_FRACTION))THEN
        M=SIZE(PEST%B_FRACTION)
        IF(N.NE.M)THEN
         ALLOCATE(PEST%B_FRACTION_BU(N),PEST%B_BATCHFILE_BU(N),PEST%B_OUTFILE_BU(N))
         PEST%B_FRACTION_BU=1.0; PEST%B_BATCHFILE_BU=''; PEST%B_OUTFILE_BU=''
         DO I=1,MIN(N,M); PEST%B_FRACTION_BU(I) =PEST%B_FRACTION(I); ENDDO
         DO I=1,MIN(N,M); PEST%B_BATCHFILE_BU(I)=PEST%B_BATCHFILE(I); ENDDO
         DO I=1,MIN(N,M); PEST%B_OUTFILE_BU(I)  =PEST%B_OUTFILE(I); ENDDO
         DEALLOCATE(PEST%B_FRACTION,PEST%B_BATCHFILE,PEST%B_OUTFILE)
         PEST%B_FRACTION=>PEST%B_FRACTION_BU; PEST%B_BATCHFILE=>PEST%B_BATCHFILE_BU; PEST%B_OUTFILE=>PEST%B_OUTFILE_BU
        ENDIF
       ELSE
        ALLOCATE(PEST%B_FRACTION(N),PEST%B_BATCHFILE(N),PEST%B_OUTFILE(N)); PEST%B_FRACTION=1.0; PEST%B_BATCHFILE=''; PEST%B_OUTFILE=''
       ENDIF   

       CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
       CALL WGRIDROWS(IDF_GRID1,N)
       CALL WGRIDPUTREAL(IDF_GRID1,1,PEST%B_FRACTION,N)
       CALL WGRIDPUTSTRING(IDF_GRID1,2,PEST%B_BATCHFILE,N)
       CALL WGRIDPUTSTRING(IDF_GRID1,3,PEST%B_OUTFILE,N)
      ENDIF
      
     CASE (ID_PARAMETERS)
  
      CALL WDIALOGGETINTEGER(IDF_INTEGER10,N)
      IF(N.EQ.0)THEN
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       IF(ASSOCIATED(PEST%PARAM))DEALLOCATE(PEST%PARAM)
       CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
      ELSE
       M=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
       IF(N.GT.M)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can specify a maximum of '//TRIM(ITOS(M))//' Parameters','Error'); N=M
       ENDIF
   
       !## resize variables
       IF(ASSOCIATED(PEST%PARAM))THEN
        M=SIZE(PEST%PARAM)
        IF(N.NE.M)THEN
         ALLOCATE(PEST%PARAM_BU(N)); DO I=1,N; PEST%PARAM_BU(I)%PIGROUP=I; PEST%PARAM_BU(I)%PIZONE=I; ENDDO
         DO I=1,MIN(N,M); PEST%PARAM_BU(I) =PEST%PARAM(I); ENDDO
         DEALLOCATE(PEST%PARAM)
         PEST%PARAM=>PEST%PARAM_BU
        ENDIF
       ELSE
        ALLOCATE(PEST%PARAM(N)); DO I=1,N; PEST%PARAM(I)%PIGROUP=I; PEST%PARAM(I)%PIZONE=I; ENDDO
       ENDIF     

       CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
       CALL WGRIDROWS(IDF_GRID1,N)
       CALL WGRIDPUTCHECKBOX(IDF_GRID1,1 ,PEST%PARAM%PACT,N)
       CALL WGRIDPUTMENU(IDF_GRID1    ,2 ,PARAM,SIZE(PARAM),PEST%PARAM%IPARAM,N)
       CALL WGRIDPUTINTEGER(IDF_GRID1 ,3 ,PEST%PARAM%PILS,N)
       CALL WGRIDPUTINTEGER(IDF_GRID1 ,4 ,PEST%PARAM%PIZONE,N)
       CALL WGRIDPUTINTEGER(IDF_GRID1 ,5 ,PEST%PARAM%PIGROUP,N)
       CALL WGRIDPUTREAL(IDF_GRID1    ,6 ,PEST%PARAM%PINI,N)
       CALL WGRIDPUTREAL(IDF_GRID1    ,7 ,PEST%PARAM%PMIN,N)
       CALL WGRIDPUTREAL(IDF_GRID1    ,8 ,PEST%PARAM%PMAX,N)
       CALL WGRIDPUTREAL(IDF_GRID1    ,9 ,PEST%PARAM%PDELTA,N)
       CALL WGRIDPUTREAL(IDF_GRID1    ,10,PEST%PARAM%PINCREASE,N)
       CALL WGRIDPUTCHECKBOX(IDF_GRID1,11,PEST%PARAM%PLOG,N)
      ENDIF
      
     CASE (ID_ZONES)

      CALL WDIALOGGETINTEGER(IDF_INTEGER11,N)
      IF(N.EQ.0)THEN
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       IF(ASSOCIATED(PEST%IDFFILES))DEALLOCATE(PEST%IDFFILES)
       CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
      ELSE
       M=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
       IF(N.GT.M)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can specify a maximum of '//TRIM(ITOS(M))//' Zones','Error'); N=M
       ENDIF
   
       !## resize variables
       IF(ASSOCIATED(PEST%IDFFILES))THEN
        M=SIZE(PEST%IDFFILES)
        IF(N.NE.M)THEN
         ALLOCATE(PEST%IDFFILES_BU(N))
         PEST%IDFFILES_BU=''
         DO I=1,MIN(N,M); PEST%IDFFILES_BU(I) =PEST%IDFFILES(I); ENDDO
         DEALLOCATE(PEST%IDFFILES)
         PEST%IDFFILES=>PEST%IDFFILES_BU
        ENDIF
       ELSE
        ALLOCATE(PEST%IDFFILES(N)); PEST%IDFFILES=''
       ENDIF  

       CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
       CALL WGRIDROWS(IDF_GRID1,N)
       CALL WGRIDPUTSTRING(IDF_GRID1,1,PEST%IDFFILES,N) 
      ENDIF
      
     CASE (ID_MEASURES)

      CALL WDIALOGGETINTEGER(IDF_INTEGER12,N)
      IF(N.EQ.0)THEN
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       IF(ASSOCIATED(PEST%MEASURES))DEALLOCATE(PEST%MEASURES)
       CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
      ELSE
       M=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
       IF(N.GT.M)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can specify a maximum of '//TRIM(ITOS(M))//' Measurement','Error'); N=M
       ENDIF
       
       !## resize variables
       IF(ASSOCIATED(PEST%MEASURES))THEN
        M=SIZE(PEST%MEASURES)
        IF(N.NE.M)THEN
         ALLOCATE(PEST%MEASURES_BU(N)); PEST%MEASURES_BU%IPFNAME=''; PEST%MEASURES_BU%IXCOL=1; PEST%MEASURES_BU%IYCOL=2; PEST%MEASURES_BU%ILCOL=3
         PEST%MEASURES_BU%IMCOL=4; PEST%MEASURES_BU%IVCOL=-5; PEST%MEASURES_BU%IPFTYPE=0
         DO I=1,MIN(N,M); PEST%MEASURES_BU(I)=PEST%MEASURES(I); ENDDO
         DEALLOCATE(PEST%MEASURES); PEST%MEASURES=>PEST%MEASURES_BU
        ENDIF
       ELSE
        ALLOCATE(PEST%MEASURES(N)); PEST%MEASURES%IPFNAME=''; PEST%MEASURES%IXCOL=1; PEST%MEASURES%IYCOL=2; PEST%MEASURES%ILCOL=3
        PEST%MEASURES%IMCOL=4; PEST%MEASURES%IVCOL=-5; PEST%MEASURES%IPFTYPE=0
       ENDIF    

       CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
       CALL WGRIDROWS(IDF_GRID1,N)
       CALL WGRIDPUTSTRING  (IDF_GRID1,1,PEST%MEASURES%IPFNAME,N)
       CALL WGRIDPUTCHECKBOX(IDF_GRID1,2,PEST%MEASURES%IPFTYPE,N)
       CALL WGRIDPUTINTEGER (IDF_GRID1,3,PEST%MEASURES%IXCOL,N)
       CALL WGRIDPUTINTEGER (IDF_GRID1,4,PEST%MEASURES%IYCOL,N)
       CALL WGRIDPUTINTEGER (IDF_GRID1,5,PEST%MEASURES%ILCOL,N)
       CALL WGRIDPUTINTEGER (IDF_GRID1,6,PEST%MEASURES%IMCOL,N)
       CALL WGRIDPUTINTEGER (IDF_GRID1,7,PEST%MEASURES%IVCOL,N)
      ENDIF
        
     CASE (IDOK,IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 SELECT CASE (ID)

  CASE (ID_PERIODS)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB1)
   IF(ASSOCIATED(PEST%S_PERIOD))THEN
    N=SIZE(PEST%S_PERIOD)
    CALL WGRIDGETINTEGER(IDF_GRID1,1,PEST%S_PERIOD,N)
    CALL WGRIDGETINTEGER(IDF_GRID1,2,PEST%E_PERIOD,N)
   ENDIF

  CASE (ID_BATCHFILES)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB2)
   IF(ASSOCIATED(PEST%B_FRACTION))THEN
    N=SIZE(PEST%B_FRACTION)
    CALL WGRIDGETREAL(IDF_GRID1,1,PEST%B_FRACTION,N)
    CALL WGRIDGETSTRING(IDF_GRID1,2,PEST%B_BATCHFILE,N)
    CALL WGRIDGETSTRING(IDF_GRID1,3,PEST%B_OUTFILE,N)
   ENDIF
   
  CASE (ID_PARAMETERS)
  
   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB3)
   IF(ASSOCIATED(PEST%PARAM))THEN
    N=SIZE(PEST%PARAM)
    CALL WGRIDGETCHECKBOX(IDF_GRID1,1 ,PEST%PARAM%PACT,N)
    CALL WGRIDGETMENU(IDF_GRID1    ,2 ,PEST%PARAM%IPARAM,N)
    CALL WGRIDGETINTEGER(IDF_GRID1 ,3 ,PEST%PARAM%PILS,N)
    CALL WGRIDGETINTEGER(IDF_GRID1 ,4 ,PEST%PARAM%PIZONE,N)
    CALL WGRIDGETINTEGER(IDF_GRID1 ,5 ,PEST%PARAM%PIGROUP,N)
    CALL WGRIDGETREAL(IDF_GRID1    ,6 ,PEST%PARAM%PINI,N)
    CALL WGRIDGETREAL(IDF_GRID1    ,7 ,PEST%PARAM%PMIN,N)
    CALL WGRIDGETREAL(IDF_GRID1    ,8 ,PEST%PARAM%PMAX,N)
    CALL WGRIDGETREAL(IDF_GRID1    ,9 ,PEST%PARAM%PDELTA,N)
    CALL WGRIDGETREAL(IDF_GRID1    ,10,PEST%PARAM%PINCREASE,N)
    CALL WGRIDGETCHECKBOX(IDF_GRID1,11,PEST%PARAM%PLOG,N)
    DO I=1,SIZE(PEST%PARAM); PEST%PARAM(I)%PPARAM=PARAM(PEST%PARAM(I)%IPARAM); ENDDO
   ENDIF
   
  CASE (ID_ZONES)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB4)
   CALL WDIALOGGETINTEGER(IDF_INTEGER8,N)
   IF(N.GT.0)CALL WGRIDGETSTRING(IDF_GRID1,1,PEST%IDFFILES,N)

  CASE (ID_MEASURES)

   CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES_TAB5)
   IF(ASSOCIATED(PEST%MEASURES))THEN
    N=SIZE(PEST%MEASURES)
    CALL WGRIDGETSTRING  (IDF_GRID1,1,PEST%MEASURES%IPFNAME,N)
    CALL WGRIDGETCHECKBOX(IDF_GRID1,2,PEST%MEASURES%IPFTYPE,N)
    CALL WGRIDGETINTEGER (IDF_GRID1,3,PEST%MEASURES%IXCOL,N)
    CALL WGRIDGETINTEGER (IDF_GRID1,4,PEST%MEASURES%IYCOL,N)
    CALL WGRIDGETINTEGER (IDF_GRID1,5,PEST%MEASURES%ILCOL,N)
    CALL WGRIDGETINTEGER (IDF_GRID1,6,PEST%MEASURES%IMCOL,N)
    CALL WGRIDGETINTEGER (IDF_GRID1,7,PEST%MEASURES%IVCOL,N)
    CALL WDIALOGGETCHECKBOX(IDF_CHECK1,PEST%IIPF)
   ENDIF
     
 END SELECT

 CALL WDIALOGSELECT(ID_DPMANAGER_PESTFILES)
 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(DID)

 END SUBROUTINE PMANAGEROPEN_PESTPARAM
 
 !###======================================================================
 SUBROUTINE PMANAGERDEFINEPERIODS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ITYPE,I,IOPTION
 TYPE(WIN_MESSAGE) :: MESSAGE
 
 CALL WDIALOGLOAD(ID_DPMANAGERDATES,ID_DPMANAGERDATES)
 CALL WDIALOGPUTIMAGE(ID_NEW,ID_ICONNEW,1)
 CALL WDIALOGPUTIMAGE(ID_DELETE,ID_ICONDELETE,1)
 CALL WDIALOGPUTIMAGE(ID_RENAME,ID_ICONRENAME,1)
 !## enter artificial year to be able to use generic routine
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3,2000)
 
 IF(.NOT.PMANAGERDEFINEPERIODS_INIT())THEN
  CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DPMANAGEROPEN)
  RETURN
 ENDIF
 
 !## display dialog
 CALL WDIALOGSHOW(-1,-1,0,3)

 DO

  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    !## current field
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_MENU3)
      IF(MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)CALL PMANAGERDEFINEPERIODS_PUT()
     CASE (IDF_MENU1)
      CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU1,IDF_INTEGER1)
    END SELECT
    
   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_DELETE)
      CALL WDIALOGGETMENU(IDF_MENU3,IOPTION)
      CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to delete selected'//CHAR(13)// &
              'period: ['//TRIM(PERIOD(IOPTION)%NAME)//']','Question')
      IF(WINFODIALOG(4).EQ.1)THEN
       DO I=IOPTION,SIZE(PERIOD)-1; PERIOD(I)=PERIOD(I+1); ENDDO; NPERIOD=MAX(NPERIOD-1,0)
      ENDIF
      IF(.NOT.PMANAGERDEFINEPERIODS_INIT())EXIT 
     CASE (ID_NEW)
      CALL WDIALOGSELECT(ID_DPMANAGERDATES); CALL WDIALOGGETMENU(IDF_MENU3,IOPTION)
      CALL PMANAGERDEFINEPERIODS_GET(IOPTION)
      CALL PMANAGERDEFINEPERIODS_RENAME(0)
     CASE (ID_RENAME)
      CALL PMANAGERDEFINEPERIODS_RENAME(1)
     CASE (IDOK)
      CALL WDIALOGSELECT(ID_DPMANAGERDATES); CALL WDIALOGGETMENU(IDF_MENU3,IOPTION)
      CALL PMANAGERDEFINEPERIODS_GET(IOPTION); EXIT
     CASE (IDCANCEL)
      EXIT
     CASE (IDHELP)
    END SELECT
  END SELECT

 ENDDO

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DPMANAGEROPEN)

 END SUBROUTINE PMANAGERDEFINEPERIODS

 !###======================================================================
 LOGICAL FUNCTION PMANAGERDEFINEPERIODS_INIT()
 !###======================================================================
 IMPLICIT NONE
  
 PMANAGERDEFINEPERIODS_INIT=.FALSE.
 
 IF(NPERIOD.EQ.0)THEN
  CALL PMANAGERDEFINEPERIODS_RENAME(0)
  !## cannot start unless nperiod>0
  IF(NPERIOD.EQ.0)THEN
   CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DPMANAGERDATES); RETURN
  ENDIF
 ELSE
  !## fill in menu
  CALL WDIALOGPUTMENU(IDF_MENU3,PERIOD%NAME,NPERIOD,1)
  CALL PMANAGERDEFINEPERIODS_PUT()
  IF(NPERIOD.GE.SIZE(PERIOD))CALL WDIALOGFIELDSTATE(ID_NEW,0)
 ENDIF

 PMANAGERDEFINEPERIODS_INIT=.TRUE.
 
 END FUNCTION PMANAGERDEFINEPERIODS_INIT

 !###======================================================================
 SUBROUTINE PMANAGERDEFINEPERIODS_RENAME(ICODE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICODE
 INTEGER :: IOPTION,ITYPE,I
 TYPE(WIN_MESSAGE) :: MESSAGE

 !## define new period
 IF(ICODE.EQ.0)THEN
  NPERIOD=NPERIOD+1;        IOPTION=NPERIOD
  PERIOD(IOPTION)%NAME=''
  PERIOD(IOPTION)%IMH=4; PERIOD(IOPTION)%IDY=1;  PERIOD(IOPTION)%IYR=2014
  PERIOD(IOPTION)%IHR=0; PERIOD(IOPTION)%IMT=0;  PERIOD(IOPTION)%ISC=0
 !## use existing one
 ELSE
  CALL WDIALOGGETMENU(IDF_MENU3,IOPTION)
 ENDIF
 
 CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
 CALL WDIALOGSHOW(-1,-1,0,3)
 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Enter a new name')
 IF(IOPTION.EQ.0)CALL WDIALOGPUTSTRING(IDF_STRING1,'...')
 IF(IOPTION.GT.0)CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(PERIOD(IOPTION)%NAME))
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETSTRING(IDF_STRING1,PERIOD(IOPTION)%NAME)
      IF(TRIM(PERIOD(IOPTION)%NAME).EQ.'')THEN
       CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should specify a name of at least 1 character','Warning')
      ELSE
       DO I=1,NPERIOD
        IF(I.EQ.IOPTION)CYCLE
        IF(UTL_CAP(TRIM(PERIOD(I)%NAME),'U').EQ.UTL_CAP(TRIM(PERIOD(IOPTION)%NAME),'U'))THEN
         CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Given name has defined already.'//CHAR(13)// &
           'You should specify an unique name','Warning')
         EXIT
        ENDIF
       ENDDO
       IF(I.GT.NPERIOD)EXIT
      ENDIF
     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT
 ENDDO
 
 CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_DPMANAGERDATES)

 IF(MESSAGE%VALUE1.EQ.IDOK)THEN
  CALL WDIALOGPUTMENU(IDF_MENU3,PERIOD%NAME,NPERIOD,IOPTION)
  CALL PMANAGERDEFINEPERIODS_PUT()
 ELSEIF(MESSAGE%VALUE1.EQ.IDCANCEL)THEN
  NPERIOD=NPERIOD-1
 ENDIF
 IF(NPERIOD.GE.SIZE(PERIOD))CALL WDIALOGFIELDSTATE(ID_NEW,0)
 
 END SUBROUTINE PMANAGERDEFINEPERIODS_RENAME
 
 !###======================================================================
 SUBROUTINE PMANAGERDEFINEPERIODS_PUT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IOPTION,I
 
 CALL WDIALOGSELECT(ID_DPMANAGERDATES)
 CALL WDIALOGGETMENU(IDF_MENU3,IOPTION)
 CALL WDIALOGGETINTEGER(IDF_INTEGER4,I)

 !## make copy of entered data first, before overwrite it with new one
 IF(I.NE.IOPTION)CALL PMANAGERDEFINEPERIODS_GET(I)

 CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IOPTION)

 CALL WDIALOGPUTMENU(IDF_MENU1,CDATE,12,PERIOD(IOPTION)%IMH)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1   ,PERIOD(IOPTION)%IDY)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3   ,PERIOD(IOPTION)%IYR)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER6   ,PERIOD(IOPTION)%IHR)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER7   ,PERIOD(IOPTION)%IMT)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER8   ,PERIOD(IOPTION)%ISC)
 
 CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU1,IDF_INTEGER1)
 
 END SUBROUTINE PMANAGERDEFINEPERIODS_PUT

 !###======================================================================
 SUBROUTINE PMANAGERDEFINEPERIODS_GET(IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IOPTION
 
 IF(IOPTION.GT.0)THEN
  CALL WDIALOGGETMENU(IDF_MENU1       ,PERIOD(IOPTION)%IMH)
  CALL WDIALOGGETINTEGER(IDF_INTEGER1 ,PERIOD(IOPTION)%IDY)
  CALL WDIALOGGETINTEGER(IDF_INTEGER3 ,PERIOD(IOPTION)%IYR)
  CALL WDIALOGGETINTEGER(IDF_INTEGER6 ,PERIOD(IOPTION)%IHR)
  CALL WDIALOGGETINTEGER(IDF_INTEGER7 ,PERIOD(IOPTION)%IMT)
  CALL WDIALOGGETINTEGER(IDF_INTEGER8 ,PERIOD(IOPTION)%ISC)
 ENDIF
 
 END SUBROUTINE PMANAGERDEFINEPERIODS_GET

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_GETSELECTED(ID,ITOPIC,IPER,ISYS,ISUBTOPIC,IERROR)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IERROR
 INTEGER,INTENT(OUT) :: ITOPIC,IPER,ISYS,ISUBTOPIC 
 INTEGER :: NSYS

 PMANAGER_GETSELECTED=.FALSE.
 
 !## check what topic has been selected
TOPICLOOP: DO ITOPIC=1,MAXTOPICS
  IPER=0; ISYS=0; ISUBTOPIC=0; IF(ID.EQ.TOPICS(ITOPIC)%ID)EXIT TOPICLOOP
  NPER=0; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))NPER=SIZE(TOPICS(ITOPIC)%STRESS)
  DO IPER=1,NPER
   ISYS=0; ISUBTOPIC=0 
   IF(ID.EQ.TOPICS(ITOPIC)%IDT(IPER))EXIT TOPICLOOP 
   NSYS=0; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(IPER)%FILES))NSYS=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
   !## read for each subtopic
   DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
    ISYS=0
    IF(ID.EQ.TOPICS(ITOPIC)%ISD(IPER,ISUBTOPIC))THEN
     IF(IERROR.EQ.1)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should select a MAIN TOPIC, a DATE or an individual FILENAME.','Warning')
      RETURN
     ELSE
      EXIT TOPICLOOP
     ENDIF
    ENDIF
    !## read for each system
    DO ISYS=1,NSYS
     IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ID.EQ.ID)EXIT TOPICLOOP
    ENDDO
   ENDDO
  ENDDO
 ENDDO TOPICLOOP

 IF(ITOPIC.GT.MAXTOPICS)THEN
  ITOPIC=0
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should select a MAIN TOPIC at least','Warning')
  RETURN
 ENDIF
 
 !## ITOPIC   =TOPIC NUMBER (E.G. SHD, BND, WEL)
 !## IPER     =STRESSPERIOD
 !## ISYS     =SYSTEM NUMBER
 
 PMANAGER_GETSELECTED=.TRUE.
  
 END FUNCTION PMANAGER_GETSELECTED

 !###======================================================================
 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=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)
  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))
  ISYS=1
 ENDIF
 
 END SUBROUTINE PMANAGER_SYSTEMS

 !###======================================================================
 SUBROUTINE PMANAGERPUTFIELDS(IST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IST

 CALL WDIALOGGETMENU(IDF_MENU1,IST)
 CALL WDIALOGPUTREAL(IDF_REAL1,PRJ(IST)%FCT,'(F10.2)')  
 CALL WDIALOGPUTREAL(IDF_REAL2,PRJ(IST)%IMP,'(F10.2)') 
 CALL WDIALOGPUTREAL(IDF_REAL3,PRJ(IST)%CNST,'(F10.2)')  
 IF(PRJ(IST)%ICNST.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
 IF(PRJ(IST)%ICNST.EQ.2)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO2)
 CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(PRJ(IST)%FNAME))
 
 END SUBROUTINE PMANAGERPUTFIELDS
 
 !###======================================================================
 SUBROUTINE PMANAGERGETFIELDS(IST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IST
 
 CALL WDIALOGGETREAL(IDF_REAL1,PRJ(IST)%FCT)  
 CALL WDIALOGGETREAL(IDF_REAL2,PRJ(IST)%IMP) 
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,PRJ(IST)%ICNST)
 CALL WDIALOGGETREAL(IDF_REAL3,PRJ(IST)%CNST)  
 CALL WDIALOGGETSTRING(IDF_STRING1,PRJ(IST)%FNAME)

 END SUBROUTINE PMANAGERGETFIELDS

 !###======================================================================
 SUBROUTINE PMANAGEROPENFIELDS(LEX,LNEW)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LEX,LNEW
 INTEGER :: II,I,J,K,L
 
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,II)
 IF(II.EQ.1)THEN
  CALL WDIALOGPUTSTRING(IDF_CHECK1,'Package is ACTIVE for coming simulations, deselect to Deactivate Parameter; ')
  CALL WDIALOGCOLOUR(IDF_CHECK1,WRGB(0,0,0),WRGB(0,255,0))
 ELSE
  CALL WDIALOGPUTSTRING(IDF_CHECK1,'Package is INACTIVE for coming simulations, select to Activate Parameter; .')
  CALL WDIALOGCOLOUR(IDF_CHECK1,WRGB(255,255,255),WRGB(255,0,0))
 ENDIF
 
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL3,ABS(I-2))
 CALL WDIALOGFIELDSTATE(IDF_STRING1,ABS(I-1))
 CALL WDIALOGFIELDSTATE(ID_OPEN,ABS(I-1))

 IF(LEX)THEN
  CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,I)
  SELECT CASE (I)
   CASE (1)
    J=0; K=0; L=0
   CASE (2)
    J=1; K=0; L=0; IF(.NOT.LNEW)J=2
   CASE (3)
    J=0; K=1; L=1; IF(.NOT.LNEW)L=2
    IF(NPERIOD.EQ.0)L=0
  END SELECT
  CALL WDIALOGFIELDSTATE(IDF_MENU2,J)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER2,J)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,J)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,J)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER5,J)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER6,J)
  CALL WDIALOGFIELDSTATE(IDF_MENU3,L)
  CALL WDIALOGFIELDSTATE(ID_PROPERTIES,K)  
 ENDIF

 END SUBROUTINE PMANAGEROPENFIELDS
 
 !###======================================================================
 SUBROUTINE PMANAGERDRAW_PLUS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ITYPE,IOPTION
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILIST
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: FNAMES
 INTEGER :: I,J,K,JJ,KK,ISYS,IL1,IL2,IPLOT,NFILES
 
 CALL PMANAGER_GETNLAY()
 IF(MXNLAY.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'There are no layers available.','Warning')
  RETURN
 ENDIF

 CALL WDIALOGLOAD(ID_DPMANAGER_SPECIALOPEN,ID_DPMANAGER_SPECIALOPEN)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,1)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,1,MXNLAY)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,MXNLAY)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER2,1,MXNLAY)
 CALL WDIALOGSHOW(-1,-1,0,3)
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDCANCEL)
      EXIT
     CASE (IDHELP)
     CASE (IDOK)
      CALL WDIALOGGETMENU(IDF_MENU1,IOPTION)
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,IL1)
      CALL WDIALOGGETINTEGER(IDF_INTEGER2,IL2)
      EXIT
    END SELECT
  END SELECT
 ENDDO
  
 CALL WDIALOGUNLOAD
 IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
 
 NLAY=IL2-IL1+1
 
 !## create list of filenames
 SELECT CASE (IOPTION)
  !## TOP1 - BOT1 - TOP2 - ...
  CASE (1)
   ALLOCATE(FNAMES(NLAY*2),ILIST(2))
   ILIST(1)=2; ILIST(2)=3
   
  !## TOP1 - KDW1 - BOT1 - TOP2 - KDW2 - BOT2 ...
  CASE (2)
   ALLOCATE(FNAMES(NLAY*3),ILIST(3))
   ILIST(1)=2; ILIST(2)=6; ILIST(3)=3

  !## TOP1 - KDW1 - BOT1 - VCW1 - TOP2 - KDW1- BOT2 - VCW2 - TOP3 ...
  CASE (3)
   ALLOCATE(FNAMES(NLAY*4-1),ILIST(4))
   ILIST(1)=2; ILIST(2)=6; ILIST(3)=3; ILIST(4)=9

  !## TOP1 - BOT1 - VCW1 - TOP2 - BOT2 - VCW2 - TOP3 ...
  CASE(4)
   ALLOCATE(FNAMES(NLAY*3-1),ILIST(3))
   ILIST(1)=2; ILIST(2)=3; ILIST(3)=9

  !## TOP1 - SHD1 - BOT1 - TOP2 - SHD2 - BOT2 ...
  CASE (5)
   ALLOCATE(FNAMES(NLAY*3),ILIST(3))
   ILIST(1)=2; ILIST(2)=5; ILIST(3)=3

  !## TOP1 - KHV1 - BOT1 - TOP2 - KHV2 - BOT2 ...
  CASE (6)
   ALLOCATE(FNAMES(NLAY*3),ILIST(3))
   ILIST(1)=2; ILIST(2)=7; ILIST(3)=3

  !## TOP1 - BOT1 - KVV1 - TOP2 - BOT2 - KVV2 - TOP3 ...
  CASE(7)
   ALLOCATE(FNAMES(NLAY*3-1),ILIST(3))
   ILIST(1)=2; ILIST(2)=3; ILIST(3)=10

  !## TOP1 - KHV1 - BOT1 - KVV1 - TOP2 - KHV2 - BOT2 - KVV2 - TOP3 ...
  CASE (8)
   ALLOCATE(FNAMES(NLAY*4-1),ILIST(4))
   ILIST(1)=2; ILIST(2)=7; ILIST(3)=3; ILIST(4)=10

 END SELECT
 
 KK=0
 DO I=IL1,IL2
  DO J=1,SIZE(ILIST)
   JJ=ILIST(J)  
   !## skip last - if that is vcw/kvv
   IF(I.EQ.IL2)THEN
    IF(JJ.EQ.9.OR.JJ.EQ.10)CYCLE
   ENDIF
   IF(TOPICS(JJ)%TIMDEP)CYCLE
   IF(.NOT.ASSOCIATED(TOPICS(JJ)%STRESS))CYCLE
   IF(.NOT.ASSOCIATED(TOPICS(JJ)%STRESS(1)%FILES))CYCLE

   !## number of subtopics
KLOOP: DO K=1,SIZE(TOPICS(JJ)%STRESS(1)%FILES,1)
    !## number of systems
    DO ISYS=1,SIZE(TOPICS(JJ)%STRESS(1)%FILES,2)
     IF(TOPICS(JJ)%STRESS(1)%FILES(K,ISYS)%ICNST.EQ.2)THEN
      IF(TOPICS(JJ)%STRESS(1)%FILES(K,ISYS)%ILAY.EQ.I)THEN
       KK=KK+1
       FNAMES(KK)=TOPICS(JJ)%STRESS(1)%FILES(K,ISYS)%FNAME
       EXIT KLOOP
      ENDIF
     ENDIF
    ENDDO
   ENDDO KLOOP
   
  ENDDO
 ENDDO

 !## actual found files
 NFILES=KK

 IF(NFILES.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No files found.','Warning')
  RETURN
 ELSE
  !## select files in the imod manager
  MP%ISEL=.FALSE.
  DO I=1,NFILES
   DO IPLOT=1,SIZE(MP) 
    IF(TRIM(UTL_CAP(MP(IPLOT)%IDFNAME,'U')).EQ.TRIM(UTL_CAP(FNAMES(I),'U')))MP(IPLOT)%ISEL=.TRUE.
   ENDDO       
  END DO
  !## delete them all from manager
  CALL MANAGERDELETE(IQ=0)

  DO I=1,NFILES; CALL IDFINIT(FNAMES(I),LPLOT=.FALSE.,LDEACTIVATE=.FALSE.); ENDDO

 ENDIF
 
 DEALLOCATE(FNAMES,ILIST)
 
 END SUBROUTINE PMANAGERDRAW_PLUS
 
 !###======================================================================
 SUBROUTINE PMANAGERDRAW()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPER,ITOPIC,ISYS,ID,ISUBTOPIC
 CHARACTER(LEN=256) :: CNAME

 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGGETTREEVIEW(ID_TREEVIEW1,ID,CNAME)

 !## get the right topics, attributes from the tree-view
 IF(.NOT.PMANAGER_GETSELECTED(ID,ITOPIC,IPER,ISYS,ISUBTOPIC,0))RETURN
 
 !## major topic selected, draw everything
 IF(IPER.EQ.0.AND.ISYS.EQ.0.AND.ISUBTOPIC.EQ.0)THEN
  NPER=0; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))NPER=SIZE(TOPICS(ITOPIC)%STRESS)
  DO IPER=1,NPER
   DO ISYS=1,SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
    DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
     !## idf file
     IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.2)THEN
      CALL IDFINIT(IDFNAMEGIVEN=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME,LPLOT=.TRUE.)
     ENDIF
    ENDDO
   ENDDO 
  ENDDO
 ELSEIF(IPER.GT.0.AND.ISYS.EQ.0.AND.ISUBTOPIC.EQ.0)THEN
  DO ISYS=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
   DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
    !## idf file
    IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.2)THEN
     CALL IDFINIT(IDFNAMEGIVEN=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME,LPLOT=.TRUE.)
    ENDIF
   ENDDO
  ENDDO 
 ELSEIF(IPER.GT.0.AND.ISYS.GT.0.AND.ISUBTOPIC.EQ.0)THEN
  DO ISUBTOPIC=1,TOPICS(ITOPIC)%NSUBTOPICS
   !## idf file
   IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.2)THEN
    CALL IDFINIT(IDFNAMEGIVEN=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME,LPLOT=.TRUE.)
   ENDIF
  ENDDO
 ELSEIF(IPER.GT.0.AND.ISYS.EQ.0.AND.ISUBTOPIC.GT.0)THEN
  DO ISYS=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
   !## idf file
   IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.2)THEN
    CALL IDFINIT(IDFNAMEGIVEN=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FNAME,LPLOT=.TRUE.)
   ENDIF
  ENDDO
 ELSE
  CALL IDFINIT(IDFNAMEGIVEN=TOPICS(ITOPIC)%STRESS(1)%FILES(ISUBTOPIC,ISYS)%FNAME,LPLOT=.TRUE.)
 ENDIF

 END SUBROUTINE PMANAGERDRAW

 !###======================================================================
 LOGICAL FUNCTION PMANAGERPRJ(ID,RUNFNAME,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IBATCH
 CHARACTER(LEN=*),INTENT(IN) :: RUNFNAME
 CHARACTER(LEN=256) :: FNAME

 PMANAGERPRJ=.FALSE.
 
 IF(ID.EQ.ID_OPEN)THEN

  IF(RUNFNAME.EQ.'')THEN
   FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.prj'
   IF(.NOT.UTL_WSELECTFILE('iMOD Project File (*.prj)|*.prj|',     &
        LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,&
        'Load iMOD Project File'))RETURN
  ELSE
   FNAME=RUNFNAME
  ENDIF

  IF(.NOT.PMANAGER_LOADPRJ(FNAME))THEN
   IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can not read in the Project File','Error')
  ELSE
   IF(IBATCH.EQ.0)CALL PMANAGERUPDATE(0,0,0); PMANAGERPRJ=.TRUE.
  ENDIF
  
 ELSEIF(ID.EQ.ID_SAVE)THEN

  IF(RUNFNAME.EQ.'')THEN
   FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.prj'
   IF(.NOT.UTL_WSELECTFILE('iMOD Project Files (*.prj)|*.prj|',  &
         SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Project File'))RETURN
  ELSE
   FNAME=RUNFNAME
  ENDIF
  
  IF(PMANAGER_SAVEPRJ(FNAME))THEN
   IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written project file:'//CHAR(13)//TRIM(FNAME),'Information')
   IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'Successfully written project file:'//TRIM(FNAME)
   PMANAGERPRJ=.TRUE.
  ENDIF
 ENDIF
 
 END FUNCTION PMANAGERPRJ
 
  !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEPRJ(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER :: IU,I,J,K,L
 CHARACTER(LEN=256) :: LINE
 
 PMANAGER_SAVEPRJ=.FALSE.
  
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED')
  
 !## write modules
 DO I=1,MAXTOPICS  
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE

  !## pst module is exception
  IF(I.EQ.20)THEN
   WRITE(IU,'(I4.4,3A,I1)') SIZE(PEST%PARAM),',',TRIM(TOPICS(I)%TNAME),',',TOPICS(I)%IACT_MODEL 
   CALL PMANAGER_SAVEPST(IU,1)
   CYCLE
  ENDIF
  
  WRITE(IU,'(I4.4,3A,I1)') SIZE(TOPICS(I)%STRESS),',',TRIM(TOPICS(I)%TNAME),',',TOPICS(I)%IACT_MODEL 
  DO L=1,SIZE(TOPICS(I)%STRESS)
   IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(L)%FILES))CYCLE
   IF(TOPICS(I)%TIMDEP)THEN
    IF(TOPICS(I)%STRESS(L)%IYR+TOPICS(I)%STRESS(L)%IMH+TOPICS(I)%STRESS(L)%IDY+ &
       TOPICS(I)%STRESS(L)%IHR+TOPICS(I)%STRESS(L)%IMT+TOPICS(I)%STRESS(L)%ISC.GT.0)THEN
     WRITE(IU,'(I4.4,5(A1,I2.2))') TOPICS(I)%STRESS(L)%IYR,'-',TOPICS(I)%STRESS(L)%IMH,'-',TOPICS(I)%STRESS(L)%IDY,' ', &
                                   TOPICS(I)%STRESS(L)%IHR,':',TOPICS(I)%STRESS(L)%IMT,':',TOPICS(I)%STRESS(L)%ISC
    ELSE
     WRITE(IU,'(A)') TRIM(TOPICS(I)%STRESS(L)%CDATE)
    ENDIF
   ENDIF
   WRITE(IU,'(2(I3.3,A1))') SIZE(TOPICS(I)%STRESS(L)%FILES,1),',',SIZE(TOPICS(I)%STRESS(L)%FILES,2)
   DO K=1,SIZE(TOPICS(I)%STRESS(L)%FILES,1)  !## systems(.)
    DO J=1,SIZE(TOPICS(I)%STRESS(L)%FILES,2) !## subtopics(.)
     WRITE(IU,'(1X,2(I1,A1),I4.4,3(A1,G15.7),A1,A)') &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%IACT ,',', &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST,',', &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%ILAY ,',', &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%FCT  ,',', &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%IMP  ,',', &
                                 TOPICS(I)%STRESS(L)%FILES(K,J)%CNST ,',', &
                  CHAR(39)//TRIM(TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME)//CHAR(39)
    ENDDO
   ENDDO
  
   !## write extra files only for MetaSWAP
   IF(I.EQ.1)THEN
    IF(ASSOCIATED(TOPICS(I)%STRESS(L)%INPFILES))THEN
     K=SIZE(TOPICS(I)%STRESS(L)%INPFILES)
     WRITE(IU,'(I3.3,A)') K,',EXTRA FILES'
     DO J=1,K; WRITE(IU,'(A)') TRIM(TOPICS(I)%STRESS(L)%INPFILES(J)); ENDDO
    ENDIF
   ENDIF
   
  ENDDO 
 
 ENDDO

 WRITE(IU,'(A)') 'Periods'
 DO I=1,NPERIOD
  WRITE(IU,'(A)') '"'//TRIM(PERIOD(I)%NAME)//'"'
  WRITE(IU,'(2(I2.2,A1),I4.4,3(A1,I2.2))') PERIOD(I)%IDY,'-',PERIOD(I)%IMH,'-',PERIOD(I)%IYR,' ', &
                                           PERIOD(I)%IHR,':',PERIOD(I)%IMT,':',PERIOD(I)%ISC
 ENDDO
 
 CLOSE(IU)
 
 PMANAGER_SAVEPRJ=.TRUE.

 END FUNCTION PMANAGER_SAVEPRJ
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_LOADPRJ(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER :: IU,I,J,K,IOS,NC,L,NSYS,IACT
 CHARACTER(LEN=MAXLEN) :: CTOPIC
 CHARACTER(LEN=512) :: LINE
  
 PMANAGER_LOADPRJ=.FALSE.
  
 DO I=1,SIZE(TOPICS); CALL PMANAGER_DEALLOCATE(I); ENDDO; CALL PMANAGER_DEALLOCATE_PEST()
  
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED')

 !## read modules
 DO
  READ(IU,'(A512)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
  READ(LINE,*,IOSTAT=IOS) NPER,CTOPIC,IACT
  IF(IOS.NE.0)THEN; IACT=1; READ(LINE,*,IOSTAT=IOS) NPER,CTOPIC; IF(IOS.NE.0)EXIT; ENDIF 
  IF(NPER.LE.0)CYCLE
  I=PMANAGER_FIND_KEYWORD(CTOPIC); IF(I.LE.0)CYCLE

  !## pst module is exception
  IF(I.EQ.20)THEN
   CALL PMANAGER_LOADPST(IU,NPER,1)
   TOPICS(I)%IACT_MODEL=IACT; ALLOCATE(TOPICS(I)%STRESS(1)); ALLOCATE(TOPICS(I)%STRESS(1)%FILES(1,1))
   CYCLE
  ENDIF

  ALLOCATE(TOPICS(I)%STRESS(NPER)); TOPICS(I)%IACT_MODEL=IACT
  DO L=1,NPER 
   IF(TOPICS(I)%TIMDEP)THEN
    READ(IU,'(A)') LINE
    READ(LINE,'(I4,5(1X,I2))',IOSTAT=IOS) TOPICS(I)%STRESS(L)%IYR,TOPICS(I)%STRESS(L)%IMH,TOPICS(I)%STRESS(L)%IDY, &
                                          TOPICS(I)%STRESS(L)%IHR,TOPICS(I)%STRESS(L)%IMT,TOPICS(I)%STRESS(L)%ISC
    IF(IOS.NE.0)THEN
     TOPICS(I)%STRESS(L)%CDATE=LINE
     TOPICS(I)%STRESS(L)%IYR=0; TOPICS(I)%STRESS(L)%IMH=0; TOPICS(I)%STRESS(L)%IDY=0
     TOPICS(I)%STRESS(L)%IHR=0; TOPICS(I)%STRESS(L)%IMT=0; TOPICS(I)%STRESS(L)%ISC=0
    ENDIF
   ENDIF
   READ(IU,*) NC,NSYS
   IF(NC.NE.TOPICS(I)%NSUBTOPICS)THEN
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Number of parameters is not correct'//CHAR(13)//TRIM(TOPICS(I)%TNAME),'Error')
    CLOSE(IU); RETURN
   ENDIF
   ALLOCATE(TOPICS(I)%STRESS(L)%FILES(NC,NSYS))
   DO K=1,TOPICS(I)%NSUBTOPICS
    DO J=1,NSYS
     READ(IU,'(A512)',IOSTAT=IOS) LINE
     IF(IOS.EQ.0)THEN
      READ(LINE,*,IOSTAT=IOS)   TOPICS(I)%STRESS(L)%FILES(K,J)%IACT , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST
      IF(IOS.EQ.0)THEN
       IF(TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST.EQ.1)THEN
        READ(LINE,*,IOSTAT=IOS) TOPICS(I)%STRESS(L)%FILES(K,J)%IACT , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST, &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%ILAY , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%FCT  , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%IMP  , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%CNST
        TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME=''
       ELSEIF(TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST.EQ.2)THEN 
        READ(LINE,*,IOSTAT=IOS) TOPICS(I)%STRESS(L)%FILES(K,J)%IACT , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%ICNST, &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%ILAY , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%FCT  , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%IMP  , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%CNST , &
                                TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME
        IF(TRIM(PREFVAL(5)).NE.'')THEN
         TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME=UTL_SUBST(TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME,TRIM(REPLACESTRING),PREFVAL(5))
        ENDIF
        TOPICS(I)%STRESS(L)%FILES(K,J)%ALIAS= &
          UTL_CAP(TRIM(TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME(INDEX(TOPICS(I)%STRESS(L)%FILES(K,J)%FNAME,'\',.TRUE.)+1:)),'L')
       ENDIF
      ENDIF
     ENDIF
     IF(IOS.NE.0)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Incorrect number of input field for'//CHAR(13)//TRIM(TOPICS(I)%TNAME),'Error')
      CLOSE(IU); RETURN
     ENDIF
    ENDDO
   ENDDO

   !## extra files only for MetaSWAP
   IF(I.EQ.1)THEN
    READ(IU,*) K
    IF(ASSOCIATED(TOPICS(I)%STRESS(L)%INPFILES))DEALLOCATE(TOPICS(I)%STRESS(L)%INPFILES)
    ALLOCATE(TOPICS(I)%STRESS(L)%INPFILES(K))
    DO J=1,K; READ(IU,'(A256)') TOPICS(I)%STRESS(L)%INPFILES(J); ENDDO
   ENDIF

  ENDDO
 ENDDO

 I=0; DO
  READ(IU,'(A512)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
  I=I+1; READ(LINE,*,IOSTAT=IOS) PERIOD(I)%NAME
  READ(IU,'(2(I2.2,1X),I4.4,3(1X,I2.2))',IOSTAT=IOS) PERIOD(I)%IDY,PERIOD(I)%IMH,PERIOD(I)%IYR, &
                                                     PERIOD(I)%IHR,PERIOD(I)%IMT,PERIOD(I)%ISC

  IF(IOS.NE.0)THEN; I=I-1; EXIT; ENDIF
 ENDDO; NPERIOD=I

 CLOSE(IU)
 
 PMANAGER_LOADPRJ=.TRUE.

 END FUNCTION PMANAGER_LOADPRJ

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEPST(IU,IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,IOPTION
 INTEGER :: I,N,M
 CHARACTER(LEN=256) :: LINE
 
 IF(IOPTION.EQ.1)THEN
  IF(ASSOCIATED(PEST%MEASURES))THEN
   I=SIGN(SIZE(PEST%MEASURES),PEST%IIPF)
   LINE=TRIM(ITOS(I))
   WRITE(IU,'(A)') TRIM(LINE)
   DO I=1,SIZE(PEST%MEASURES)
    LINE=CHAR(39)//TRIM(PEST%MEASURES(I)%IPFNAME)//CHAR(39)//','// &
         TRIM(ITOS(PEST%MEASURES(I)%IPFTYPE))//','// &
         TRIM(ITOS(PEST%MEASURES(I)%IXCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IYCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%ILCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IMCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IVCOL))
    WRITE(IU,'(A)') TRIM(LINE)
   ENDDO
  ELSE
   LINE=TRIM(ITOS(0))
   WRITE(IU,'(A)') TRIM(LINE)
  ENDIF
 ENDIF
  
 N=0; IF(ASSOCIATED(PEST%B_FRACTION))N=SIZE(PEST%B_FRACTION)
 M=0; IF(ASSOCIATED(PEST%S_PERIOD))  M=SIZE(PEST%S_PERIOD)
 
 LINE=TRIM(ITOS(PEST%PE_MXITER))         //','//TRIM(RTOS(PEST%PE_STOP,'F',2))     //','// &
      TRIM(RTOS(PEST%PE_SENS,'F',2))     //','//TRIM(ITOS(M))                      //','// &
      TRIM(ITOS(N))                      //','//TRIM(RTOS(PEST%PE_TARGET(1),'F',2))//','// &
      TRIM(RTOS(PEST%PE_TARGET(2),'F',2))//','//TRIM(ITOS(PEST%PE_SCALING-1))      //','// &
      TRIM(RTOS(PEST%PE_PADJ,'F',2))     //','//TRIM(RTOS(PEST%PE_DRES,'F',2))     //','// &
      TRIM(ITOS(PEST%PE_KTYPE))
 WRITE(IU,'(A)') TRIM(LINE)
 
 IF(N.GT.0)THEN
  DO I=1,SIZE(PEST%S_PERIOD)
   LINE=TRIM(ITOS(PEST%S_PERIOD(I)))//','//TRIM(ITOS(PEST%E_PERIOD(I)))
   WRITE(IU,'(A)') TRIM(LINE)   
  ENDDO
 ENDIF
 
 IF(M.GT.0)THEN
  DO I=1,SIZE(PEST%B_FRACTION)
   LINE=TRIM(RTOS(PEST%B_FRACTION(I),'F',2))//','//CHAR(39)//TRIM(PEST%B_BATCHFILE(I))//CHAR(39)//','//CHAR(39)//TRIM(PEST%B_OUTFILE(I))//CHAR(39)
   WRITE(IU,'(A)') TRIM(LINE)   
  ENDDO
 ENDIF

 IF(ASSOCIATED(PEST%PARAM))THEN
  DO I=1,SIZE(PEST%PARAM)
   LINE=TRIM(ITOS(PEST%PARAM(I)%PACT))           //','// &
        TRIM(PEST%PARAM(I)%PPARAM)               //','// &
        TRIM(ITOS(PEST%PARAM(I)%PILS))           //','// &
        TRIM(ITOS(PEST%PARAM(I)%PIZONE))         //','// &    
        TRIM(RTOS(PEST%PARAM(I)%PINI,'F',2))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PDELTA,'F',2))   //','// &
        TRIM(RTOS(PEST%PARAM(I)%PMIN,'F',2))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PMAX,'F',2))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PINCREASE,'F',2))//','// &
        TRIM(ITOS(PEST%PARAM(I)%PIGROUP))        //','// &
        TRIM(ITOS(PEST%PARAM(I)%PLOG))
   WRITE(IU,'(A)') TRIM(LINE)   
  ENDDO
 ENDIF

 IF(ASSOCIATED(PEST%IDFFILES))THEN
  LINE=TRIM(ITOS(SIZE(PEST%IDFFILES)))
  WRITE(IU,'(A)') TRIM(LINE)    
  DO I=1,SIZE(PEST%IDFFILES)
   LINE=TRIM(PEST%IDFFILES(I))
   WRITE(IU,'(A)') TRIM(LINE)    
  ENDDO
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEPST
 
 !###======================================================================
 SUBROUTINE PMANAGER_LOADPST(IU,NPARAM,IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,NPARAM,IOPTION
 INTEGER :: I,J,IOS,N,M
 CHARACTER(LEN=256) :: LINE
 
 IF(IOPTION.EQ.1)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,*) 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
 ENDIF
  
 READ(IU,'(A)') 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
 IF(IOS.NE.0)THEN
  PEST%PE_KTYPE=1
  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
   PEST%PE_DRES=0.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
   IF(IOS.NE.0)THEN
    PEST%PE_PADJ=0.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
    IF(IOS.NE.0)THEN
     PEST%PE_SCALING=0
     READ(LINE,*,IOSTAT=IOS) PEST%PE_MXITER,PEST%PE_STOP,PEST%PE_SENS,N,M,PEST%PE_TARGET(1),PEST%PE_TARGET(2)
    ENDIF
   ENDIF
  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.0; 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) 
  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)%PPARAM=UTL_CAP(PEST%PARAM(I)%PPARAM,'U')
   IF(IOS.NE.0)THEN
    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
  
   SELECT CASE (PEST%PARAM(I)%PPARAM)
    CASE ('RC','AH')
     PEST%PARAM(I)%PLOG=0
    CASE DEFAULT
     PEST%PARAM(I)%PLOG=1
   END SELECT

   !## 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)
  ENDDO
 ENDIF
 
 END SUBROUTINE PMANAGER_LOADPST
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGERRUN(ID,RUNFNAME,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IBATCH
 CHARACTER(LEN=*),INTENT(IN) :: RUNFNAME
 INTEGER :: IU,ITOPIC
 CHARACTER(LEN=256) :: FNAME

 PMANAGERRUN=.FALSE.
 
 IF(ID.EQ.ID_OPENRUN)THEN

  IF(RUNFNAME.EQ.'')THEN
   FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.run'
   IF(.NOT.UTL_WSELECTFILE('iMOD Run File (*.run)|*.run|',     &
        LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,&
        'Load iMOD Run File'))RETURN
  ELSE
   FNAME=RUNFNAME
  ENDIF

  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED')
 
  IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(0)

  IF(PMANAGER_GETKEYS(IU)) THEN
   IF(PMANAGER_GETFILES(IU,ITOPIC))THEN
    IF(IBATCH.EQ.0)CALL PMANAGERUPDATE(0,0,0); PMANAGERRUN=.TRUE.
   ELSE
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading BODY runfile '//TRIM(CMOD(ITOPIC)),'Error')
   ENDIF
  ELSE
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading HEADER runfile','Error')
  ENDIF
  CLOSE(IU)
 
  IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(1)
  
 ELSEIF(ID.EQ.ID_SAVERUN)THEN

  FNAME=RUNFNAME
  IF(.NOT.PMANAGER_INITSIM(FNAME,IBATCH))THEN; IF(ASSOCIATED(SIM))DEALLOCATE(SIM); RETURN; ENDIF

  IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(0)

  IF(IFORMAT.EQ.1)THEN
   IF(PMANAGER_SAVERUN(FNAME))THEN
    IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written runfile:'//CHAR(13)//TRIM(FNAME),'Error')
    IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'Successfully written runfile:'//TRIM(FNAME)
    PMANAGERRUN=.TRUE.
   ENDIF
  ELSEIF(IFORMAT.EQ.2)THEN
   IF(PMANAGER_SAVEMF2005(FNAME,IBATCH))THEN
    IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written MF2005 files:'//CHAR(13)//TRIM(FNAME),'Error')
    IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'Successfully written MF2005 files:'//TRIM(FNAME)
    PMANAGERRUN=.TRUE.
   ENDIF
  ENDIF
  
  CALL UTL_CLOSEUNITS()
  DEALLOCATE(SIM)

  IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(1)
  
 ENDIF 

 END FUNCTION PMANAGERRUN

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVERUN(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=512) :: LINE
 CHARACTER(LEN=52) :: CDATE1,CDATE2
 INTEGER :: IU,I,J,K,IPER,KPER,N,IBNDCHK,IFVDL
 LOGICAL :: LDAYS
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 
 PMANAGER_SAVERUN=.FALSE.
  
 !## remove last timestep sinces it is the final date
 IF(NPER.GT.1)NPER=NPER-1
 
 MXNLAY=NLAY
 
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED')
 IF(IU.EQ.0)RETURN

 WRITE(IU,'(A)') CHAR(39)//TRIM(PREFVAL(1))//'\MODELS\'//TRIM(MODELNAME)//CHAR(39)
 
 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN
  N=SIZE(PEST%MEASURES); IF(PEST%IIPF.EQ.1)N=-1*N
 ENDIF
 
 !## metaswap
 IARMWP=0
 IF(TOPICS(1)%IACT_MODEL.EQ.1)THEN
  IF(ASSOCIATED(TOPICS(1)%STRESS))THEN
   LINE=TOPICS(1)%STRESS(1)%FILES(8,1)%FNAME
   IF(INDEX(UTL_CAP(LINE,'U'),'IPF').GT.0)IARMWP=1
  ENDIF
 ENDIF
 IBNDCHK=0; IFVDL=0
 WRITE(IU,'(12(I10,1X))') NLAY,MXNLAY,NPER,0,1,0,0,N,IUNCONF,IFVDL,IARMWP,IBNDCHK

 !## write measures
 IF(N.NE.0)THEN
  DO I=1,SIZE(PEST%MEASURES)
   LINE=TRIM(PEST%MEASURES(I)%IPFNAME)      //','// &
        TRIM(ITOS(PEST%MEASURES(I)%IPFTYPE))//','// &
        TRIM(ITOS(PEST%MEASURES(I)%IXCOL))  //','// &
        TRIM(ITOS(PEST%MEASURES(I)%IYCOL))  //','// &
        TRIM(ITOS(PEST%MEASURES(I)%ILCOL))  //','// &
        TRIM(ITOS(PEST%MEASURES(I)%IMCOL))  //','// &
        TRIM(ITOS(PEST%MEASURES(I)%IVCOL))
   WRITE(IU,'(A)') TRIM(LINE)
  ENDDO
 ENDIF

 WRITE(IU,'(6(I10,A1))') 1,',',0,',',0,',',0,',',0,',',0 
 LINE=TRIM(ITOS(MXITER))//','//TRIM(ITOS(ITER1))//','// & 
      TRIM(RTOS(HCLOSE,'E',7))//','//TRIM(RTOS(RCLOSE,'E',7))//','// &
      TRIM(RTOS(RELAX,'E',7))//','//TRIM(ITOS(NPCOND)) 
 WRITE(IU,'(A)') TRIM(LINE)
 
 IF(ISUBMODEL.EQ.0)THEN
  ALLOCATE(IDF(1)); CALL IDFNULLIFY(IDF(1))
  IF(.NOT.IDFREAD(IDF(1),TOPICS(4)%STRESS(1)%FILES(1,1)%FNAME,0))THEN
   CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF); CLOSE(IU); RETURN
  ENDIF
  WRITE(IU,'(6(F10.2,A1))') IDF(1)%XMIN,',',IDF(1)%YMIN,',',IDF(1)%XMAX,',',IDF(1)%YMAX,',',IDF(1)%DX,',',0.0
  CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 ELSE
  WRITE(IU,'(6(F10.2,A1))') SUBMODEL(1),',',SUBMODEL(2),',',SUBMODEL(3),',',SUBMODEL(4),',',SUBMODEL(5),',',SUBMODEL(6)
 ENDIF
 
 WRITE(IU,'(A)') 'ACTIVE MODULES'

 DO I=1,MAXTOPICS  
  IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE

  !## pst module is exception
  IF(I.EQ.20)THEN; WRITE(IU,'(A)') '1,0 '//TRIM(TOPICS(I)%TNAME); CYCLE; ENDIF
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE
  WRITE(IU,'(A)') '1,1,0 '//TRIM(TOPICS(I)%TNAME)
 ENDDO
 
 !## write bndfile
 WRITE(IU,'(A)') CHAR(39)//TRIM(TOPICS(4)%STRESS(1)%FILES(1,1)%FNAME)//CHAR(39)

 WRITE(IU,'(A)') 'MODULES FOR EACH LAYER'
  
 !## write modules
 DO I=1,MAXTOPICS
  IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE
  IF(TOPICS(I)%TIMDEP)CYCLE

  !## pst module is exception
  IF(I.EQ.20)THEN
   LINE=TRIM(ITOS(SIZE(PEST%PARAM)))//',(PST)'; WRITE(IU,'(A)') TRIM(LINE) 
   CALL PMANAGER_SAVEPST(IU,0); CYCLE
  ENDIF
  
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE
  
  !## check the number of active packages
  K=1; N=0
  DO J=1,SIZE(TOPICS(I)%STRESS(1)%FILES,2)
   IF(TOPICS(I)%STRESS(1)%FILES(K,J)%IACT.EQ.1)N=N+1
  ENDDO

  WRITE(IU,'(I3.3,A)') N,','//TRIM(TOPICS(I)%TNAME)

  IF(N.GT.0)THEN
   !## number of subtopics
   DO K=1,SIZE(TOPICS(I)%STRESS(1)%FILES,1)
    !## number of systems
    DO J=1,SIZE(TOPICS(I)%STRESS(1)%FILES,2)
     !## skip temporary deactivated packages
     IF(TOPICS(I)%STRESS(1)%FILES(K,J)%IACT.EQ.0)CYCLE
     !## pwt - skip ilay
     IF(I.EQ.13)THEN
      WRITE(LINE,'(5X,     2(G15.7,A1))') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,','
     ELSE
      WRITE(LINE,'(1X,I4.4,2(A1,G15.7),A1)') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%ILAY,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,','
     ENDIF
     IF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.1)THEN
      LINE=TRIM(LINE)//TRIM(RTOS(TOPICS(I)%STRESS(1)%FILES(K,J)%CNST,'G',7))
     ELSEIF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.2)THEN
      LINE=TRIM(LINE)//CHAR(39)//TRIM(TOPICS(I)%STRESS(1)%FILES(K,J)%FNAME)//CHAR(39)
     ENDIF
     WRITE(IU,'(A)') TRIM(LINE)

    ENDDO
   ENDDO
  
   !## write extra files only for MetaSWAP
   IF(I.EQ.1)THEN
    IF(ASSOCIATED(TOPICS(I)%STRESS(1)%INPFILES))THEN
     K=SIZE(TOPICS(I)%STRESS(1)%INPFILES)
     DO J=1,K; WRITE(IU,'(1X,A)') TRIM(TOPICS(I)%STRESS(1)%INPFILES(J)); ENDDO
    ENDIF
   ENDIF
 
  ENDIF

 ENDDO

 WRITE(IU,'(A)') 'PACKAGES FOR EACH LAYER AND STRESS-PERIOD '

 !## only days available
 LDAYS=.TRUE.
 DO KPER=1,NPER
  IF(SIM(KPER)%IHR+SIM(KPER)%IMT+SIM(KPER)%ISC.GT.0)THEN; LDAYS=.FALSE.; EXIT; ENDIF
 ENDDO

 !## write packages - incl./excl. steady-state
 DO KPER=1,NPER
  
  !## steady-state
  IF(SIM(KPER)%DELT.EQ.0.0)THEN
   WRITE(IU,'(I5.5,A1,F15.7,A1,A,2(A1,I1))') KPER,',',SIM(KPER)%DELT,',',TRIM(SIM(KPER)%CDATE),',',SIM(KPER)%ISAVE,',',SIM(KPER)%ISUM
  !## transient (use final date as well, used for labeling file-names!)
  ELSE
   IF(LDAYS)THEN
    WRITE(CDATE1,'(I4.4,2I2.2)') SIM(KPER)%IYR  ,SIM(KPER)%IMH  ,SIM(KPER)%IDY
   ELSE
    WRITE(CDATE1,'(I4.4,5I2.2)') SIM(KPER)%IYR  ,SIM(KPER)%IMH  ,SIM(KPER)%IDY  ,SIM(KPER)%IHR  ,SIM(KPER)%IMT  ,SIM(KPER)%ISC
   ENDIF   
   IF(LDAYS)THEN
    WRITE(CDATE2,'(I4.4,2I2.2)') SIM(KPER+1)%IYR,SIM(KPER+1)%IMH,SIM(KPER+1)%IDY
   ELSE
    WRITE(CDATE2,'(I4.4,5I2.2)') SIM(KPER+1)%IYR,SIM(KPER+1)%IMH,SIM(KPER+1)%IDY,SIM(KPER+1)%IHR,SIM(KPER+1)%IMT,SIM(KPER+1)%ISC
   ENDIF
   WRITE(IU,'(I5.5,A1,F15.7,A1,A,2(A1,I1),A)') KPER,',',SIM(KPER)%DELT,',',TRIM(CDATE1),',',SIM(KPER)%ISAVE,',',SIM(KPER)%ISUM,','//TRIM(CDATE2)
  ENDIF

  DO I=1,MAXTOPICS  
   IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE
   IF(.NOT.TOPICS(I)%TIMDEP)CYCLE
   IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
   IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE

   IPER=PMANAGER_GETCURRENTIPER(KPER,I)
   
   !## overrule wel/isg paclages per stress-period
   SELECT CASE (I); CASE (21,29); IPER=ABS(IPER); END SELECT
   
   !## reuse previous timestep
   IF(IPER.LE.0)THEN

    N=MAX(IPER,-1)
    WRITE(IU,'(I3,A)') N,','//TRIM(TOPICS(I)%TNAME)
   
   ELSE
   
    !## check the number of active packages
    K=1; N=0
    DO J=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,2)
     IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%IACT.EQ.1)N=N+1
    ENDDO
    WRITE(IU,'(I3,A)') N,','//TRIM(TOPICS(I)%TNAME)
 
    IF(N.GT.0)THEN
     !## number of subtopics
     DO K=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,1)
      !## number of systems
      DO J=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,2)
       !## skip temporary deactivated packages
       IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%IACT.EQ.0)CYCLE
       IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%ICNST.EQ.1)THEN
        WRITE(IU,'(1X,I4.4,3(A1,G15.7))') &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%ILAY,',', &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%FCT ,',', &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%IMP ,',', &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%CNST
       ELSEIF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%ICNST.EQ.2)THEN
        WRITE(IU,'(1X,I4.4,2(A1,G15.7),A1,A)') &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%ILAY,',', &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%FCT ,',', &
                                    TOPICS(I)%STRESS(IPER)%FILES(K,J)%IMP ,',', &
                     CHAR(39)//TRIM(TOPICS(I)%STRESS(IPER)%FILES(K,J)%FNAME)//CHAR(39)
       ENDIF
      ENDDO
     ENDDO
    ENDIF
    
   ENDIF
  ENDDO
 ENDDO
 
 CLOSE(IU)
 
 PMANAGER_SAVERUN=.TRUE.

 END FUNCTION PMANAGER_SAVERUN

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005(FNAME,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=512) :: DIR,LINE
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IUGEN
 INTEGER :: IU,IUBAS,IPER,KPER,IERROR,SCL_D,SCL_U,IINT,ITOPIC,ILAY,ISS,IINV,NRCHOP,NEVTOP,NP
 INTEGER :: IHEDUN,IBCFCB,IRCHCB,IEVTCB,IDRNCB,IRIVCB,IGHBCB,ICHDCB,IWELCB,ICB,IROW,ICOL,ISTEADY
 REAL :: HNOFLOW,STOPER
 TYPE(IDFOBJ) :: IDF
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: BND,TOP,BOT,KD,SHD
 CHARACTER(LEN=52) :: TEXT,CAUX,CMAXNO,CPCK
 CHARACTER(LEN=256) :: EXFNAME
 LOGICAL :: LEX,LTB
 
 PMANAGER_SAVEMF2005=.FALSE.

 !## remove final stress as it is the final timestep
 IF(NPER.GT.1)NPER=NPER-1
 
 IIDEBUG=0          !## if 1 write asc files instead of arr
 STOPER=0.1         !## stop error of total waterbalance
 HNOFLOW=HUGE(1.0)  !## noflow value
 ISTEADY=0; IF(SIM(1)%DELT.EQ.0.0)ISTEADY=1
 
 IHEDUN=51; IBCFCB=52; IRCHCB=53; IEVTCB=54; IDRNCB=55; IRIVCB=56; IGHBCB=57; ICHDCB=58; IWELCB=59
 
 NRCHOP=1  !## applied to top of gridcells
 NEVTOP=1  !## applied to top of gridcells
 
 LPCG =.TRUE.
 LPCGN=.FALSE.  !## option?
 LPWT =.FALSE.
 
 !## cap
 LMSP=.FALSE.; ITOPIC=1; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LMSP=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LMSP=.FALSE.

 !## hfb
 LHFB=.FALSE.; ITOPIC=15; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LHFB=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LHFB=.FALSE.

 !## wel
 LWEL=.FALSE.; ITOPIC=21; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LWEL=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LWEL=.FALSE.

 !## drn
 LDRN=.FALSE.; ITOPIC=22; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LDRN=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LDRN=.FALSE.

 !## riv
 LRIV=.FALSE.; ITOPIC=23; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LRIV=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LRIV=.FALSE.

 !## evt
 LEVT=.FALSE.; ITOPIC=24; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LEVT=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LEVT=.FALSE.

 !## ghb
 LGHB=.FALSE.; ITOPIC=25; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LGHB=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LGHB=.FALSE.

 !## rch
 LRCH=.FALSE.; ITOPIC=26; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LRCH=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LRCH=.FALSE.

 !## sof
 LOLF=.FALSE.; ITOPIC=27; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LOLF=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LOLF=.FALSE.

 !## chd
 LCHD=.FALSE.; ITOPIC=28; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LCHD=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LCHD=.FALSE.

 !## isg
 LISG=.FALSE.; ITOPIC=29; IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))LISG=.TRUE.; ENDIF 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)LISG=.FALSE.

 DIR=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)

 MXNLAY=NLAY
  
 CALL UTL_CREATEDIR(DIR(:INDEX(DIR,'\',.TRUE.)-1))
 
 !## write *.nam file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.NAM',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 LINE=FNAME(INDEX(FNAME,'\',.TRUE.)+1:INDEX(FNAME,'.',.TRUE.)-1)
 WRITE(IU,'(A)') '# Nam File Generated by '//TRIM(UTL_IMODVERSION())
 WRITE(IU,'(A)') 'LIST 10 '//CHAR(39)//TRIM(LINE)//'.LIST'//CHAR(39)
 WRITE(IU,'(A)') 'BAS6 11 '//CHAR(39)//TRIM(LINE)//'.BAS6'//CHAR(39)
 WRITE(IU,'(A)') 'DIS  12 '//CHAR(39)//TRIM(LINE)//'.DIS6'//CHAR(39)
 IF(LBCF) WRITE(IU,'(A)') 'BCF6 13 '//CHAR(39)//TRIM(LINE)//'.BCF6'//CHAR(39)
 IF(LLPF) WRITE(IU,'(A)') 'LPF  13 '//CHAR(39)//TRIM(LINE)//'.LPF7'//CHAR(39)
 IF(LPCG) WRITE(IU,'(A)') 'PCG  14 '//CHAR(39)//TRIM(LINE)//'.PCG7'//CHAR(39)
 IF(LPCGN)WRITE(IU,'(A)') 'PCGN 14 '//CHAR(39)//TRIM(LINE)//'.PCGN'//CHAR(39)
 IF(LSIP) WRITE(IU,'(A)') 'SIP  14 '//CHAR(39)//TRIM(LINE)//'.SIP'//CHAR(39)
          WRITE(IU,'(A)') 'OC   15 '//CHAR(39)//TRIM(LINE)//'.OC'//CHAR(39)
 IF(LRCH) WRITE(IU,'(A)') 'RCH  16 '//CHAR(39)//TRIM(LINE)//'.RCH7'//CHAR(39)
 IF(LEVT) WRITE(IU,'(A)') 'EVT  17 '//CHAR(39)//TRIM(LINE)//'.EVT7'//CHAR(39)
 IF(LDRN.OR.LOLF) WRITE(IU,'(A)') 'DRN  18 '//CHAR(39)//TRIM(LINE)//'.DRN7'//CHAR(39)
 IF(LRIV.OR.LISG) WRITE(IU,'(A)') 'RIV  19 '//CHAR(39)//TRIM(LINE)//'.RIV7'//CHAR(39)
 IF(LGHB) WRITE(IU,'(A)') 'GHB  20 '//CHAR(39)//TRIM(LINE)//'.GHB7'//CHAR(39)
 IF(LCHD) WRITE(IU,'(A)') 'CHD  21 '//CHAR(39)//TRIM(LINE)//'.CHD7'//CHAR(39)
 IF(LWEL) WRITE(IU,'(A)') 'WEL  22 '//CHAR(39)//TRIM(LINE)//'.WEL7'//CHAR(39)
 IF(LHFB) WRITE(IU,'(A)') 'HFB  23 '//CHAR(39)//TRIM(LINE)//'.HFB7'//CHAR(39)

 WRITE(IU,'(A,I3,A)')         'DATA(BINARY) ',IHEDUN,' '//CHAR(39)//TRIM(LINE)//'_HEAD.DAT'//CHAR(39)
 WRITE(IU,'(A,I3,A)')         'DATA(BINARY) ',IBCFCB,' '//CHAR(39)//TRIM(LINE)//'_FBCF.DAT'//CHAR(39) 
 IF(LRCH)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IRCHCB,' '//CHAR(39)//TRIM(LINE)//'_FRCH.DAT'//CHAR(39) 
 IF(LEVT)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IEVTCB,' '//CHAR(39)//TRIM(LINE)//'_FEVT.DAT'//CHAR(39) 
 IF(LDRN.OR.LOLF)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IDRNCB,' '//CHAR(39)//TRIM(LINE)//'_FDRN.DAT'//CHAR(39) 
 IF(LRIV.OR.LISG)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IRIVCB,' '//CHAR(39)//TRIM(LINE)//'_FRIV.DAT'//CHAR(39) 
 IF(LGHB)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IGHBCB,' '//CHAR(39)//TRIM(LINE)//'_FGHB.DAT'//CHAR(39) 
 IF(LCHD)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',ICHDCB,' '//CHAR(39)//TRIM(LINE)//'_FCHD.DAT'//CHAR(39) 
 IF(LWEL)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IWELCB,' '//CHAR(39)//TRIM(LINE)//'_FWEL.DAT'//CHAR(39) 
 
 CLOSE(IU)
   
 ALLOCATE(BND(NLAY)); DO ILAY=1,NLAY; CALL IDFNULLIFY(BND(ILAY)); ENDDO
 ALLOCATE(SHD(NLAY)); DO ILAY=1,NLAY; CALL IDFNULLIFY(SHD(ILAY)); ENDDO
 ALLOCATE(TOP(NLAY)); DO ILAY=1,NLAY; CALL IDFNULLIFY(TOP(ILAY)); ENDDO
 ALLOCATE(BOT(NLAY)); DO ILAY=1,NLAY; CALL IDFNULLIFY(BOT(ILAY)); ENDDO
 ALLOCATE(KD (NLAY)); DO ILAY=1,NLAY; CALL IDFNULLIFY(KD (ILAY)); ENDDO

 !## read idf for dimensions
 CALL IDFNULLIFY(IDF); IFULL=0
 !## try to read at least a single BND file specified as IDF
 DO ILAY=1,NLAY
  !## skip constant entries
  IF(TOPICS(4)%STRESS(1)%FILES(ILAY,1)%ICNST.EQ.1)CYCLE
  IF(.NOT.IDFREAD(IDF,TOPICS(4)%STRESS(1)%FILES(ILAY,1)%FNAME,0,IQ=1))THEN
   IF(IDF%IU.GT.0)THEN
    INQUIRE(UNIT=IDF%IU,OPENED=LEX)
    IF(LEX)CLOSE(IDF%IU); IDF%IU=0
   ENDIF 
   CLOSE(IU); RETURN
  ELSE
   !## read in correct, close it again
   CLOSE(IDF%IU); IDF%IU=0; EXIT 
  ENDIF
 ENDDO

 IF(ISUBMODEL.EQ.1)THEN
  !## include buffer to simulation window
  SUBMODEL(1)=SUBMODEL(1)-SUBMODEL(6); SUBMODEL(2)=SUBMODEL(2)-SUBMODEL(6)
  SUBMODEL(3)=SUBMODEL(3)+SUBMODEL(6); SUBMODEL(4)=SUBMODEL(4)+SUBMODEL(6)
  CALL UTL_IDFSNAPTOGRID(SUBMODEL(1),SUBMODEL(3),SUBMODEL(2),SUBMODEL(4),SUBMODEL(5),IDF%NCOL,IDF%NROW)
  IF(SUBMODEL(1).GT.IDF%XMIN)IFULL(1)=1; IF(SUBMODEL(2).GT.IDF%YMIN)IFULL(2)=1
  IF(SUBMODEL(3).LT.IDF%XMAX)IFULL(3)=1; IF(SUBMODEL(4).LT.IDF%YMAX)IFULL(4)=1
  IDF%XMIN=SUBMODEL(1); IDF%YMIN=SUBMODEL(2); IDF%XMAX=SUBMODEL(3); IDF%YMAX=SUBMODEL(4); IDF%DX=SUBMODEL(5); IDF%DY=SUBMODEL(5)
 ENDIF
 IF(.NOT.IDFALLOCATEX(IDF))RETURN
 !## fill sx/sy variable in idf
 IF(.NOT.IDFFILLSXSY(IDF))RETURN
 
 IERROR=0
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.BAS6'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.BAS6'//'...'
  
 !## construct bas6-file
 IUBAS=UTL_GETUNIT(); CALL OSD_OPEN(IUBAS,FILE=TRIM(DIR)//'.BAS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IUBAS.EQ.0)RETURN
 WRITE(IUBAS,'(A)') '# BAS6 File Generated by '//TRIM(UTL_IMODVERSION())
 WRITE(IUBAS,'(A,F15.7)') 'FREE STOPERROR ',STOPER
 !## bnd settings
 ITOPIC=4; SCL_D=0; SCL_U=1; IINV=0
 DO ILAY=1,NLAY
  CALL IDFCOPY(IDF,BND(ILAY))
  IF(.NOT.PMANAGER_SAVEMF2005_MOD(BND(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN 
  !## adjust boundary for submodel()
  CALL PMANAGER_SAVEMF2005_BND(BND(ILAY),HNOFLOW)
 ENDDO
 
 !## shd settings
 ITOPIC=5; SCL_D=1; SCL_U=2; IINV=0
 DO ILAY=1,NLAY
  CALL IDFCOPY(IDF,SHD(ILAY))
  IF(.NOT.PMANAGER_SAVEMF2005_MOD(SHD(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SHD(ILAY),0,ITOPIC)
 ENDDO
 
 DO ILAY=1,NLAY; CALL IDFCOPY(BND(ILAY),TOP(ILAY)); ENDDO
 DO ILAY=1,NLAY; CALL IDFCOPY(BND(ILAY),BOT(ILAY)); ENDDO
 DO ILAY=1,NLAY; CALL IDFCOPY(BND(ILAY),KD(ILAY) ); ENDDO

 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.DIS6'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.DIS6'//'...'
 
 !## construct dis-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.DIS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# DIS6 File Generated by '//TRIM(UTL_IMODVERSION())
 LINE=TRIM(ITOS(NLAY))//','//TRIM(ITOS(IDF%NROW))//','//TRIM(ITOS(IDF%NCOL))//','//TRIM(ITOS(NPER))//',4,2'
 WRITE(IU,'(A)') TRIM(LINE)
  
 !## laycbd code
 LINE=''
 DO ILAY=1,NLAY
  IF(ILAY.LT.NLAY)THEN
   !## quasi-3d scheme
   IF(LQBD)THEN
    LINE=TRIM(LINE)//' 1'
   !## 3d no quasi confining bed
   ELSE
    LINE=TRIM(LINE)//' 0'
   ENDIF
  ELSE
   !## lowest layer has never a quasi-confining bed
   LINE=TRIM(LINE)//' 0'
  ENDIF
 ENDDO

 WRITE(IU,'(A)') TRIM(LINE)
 WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(IDF%DX,'E',7)); WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(IDF%DY,'E',7))
 
 !## check top/bottom
 LTB=.TRUE.
 
 !## top settings
 SCL_D=1; SCL_U=2; IINT=0
 DO ILAY=1,NLAY
  ITOPIC=2; LEX=.FALSE.
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))THEN
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(TOP(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,TOP(ILAY),0,ITOPIC)
    LEX=.TRUE.
   ENDIF
  ENDIF
  IF(.NOT.LEX)THEN; TOP(ILAY)%X=0.0; LTB=.FALSE.; ENDIF
  ITOPIC=3; LEX=.FALSE.
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))THEN
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(BOT(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,BOT(ILAY),0,ITOPIC)
    LEX=.TRUE.
   ENDIF
  ENDIF
  IF(.NOT.LEX)THEN; BOT(ILAY)%X=0.0; LTB=.FALSE.; ENDIF
 ENDDO
 
 !## apply consistency checks
 IF(LTB)THEN
  !## apply consistency check top/bot
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL; DO ILAY=1,NLAY
   !## minimal aquifer thickness
   IF(ILAY.GT.1)TOP(ILAY)%X(ICOL,IROW)=MIN(BOT(ILAY-1)%X(ICOL,IROW)-MINTHICKNESS,TOP(ILAY)%X(ICOL,IROW))
   BOT(ILAY)%X(ICOL,IROW)=MIN(TOP(ILAY)%X(ICOL,IROW),BOT(ILAY)%X(ICOL,IROW))
!   BOT(ILAY)%X(ICOL,IROW)=MIN(TOP(ILAY)%X(ICOL,IROW)-MINTHICKNESS  ,BOT(ILAY)%X(ICOL,IROW))
  ENDDO; ENDDO; ENDDO

!## figure out how to come up with something to correct permeability later for minimal thicknesses
!  DO ILAY=1,NLAY
!   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)CYCLE
!   !## minimal aquifer thickness
!   D=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
!   !## correct whenever minimal thickness requirement is not met
!   IF(D.LT.MINTHICKNESS)THEN
!    !## get current available transmissivity
!    KD=KHV(ICOL,IROW,ILAY)*D
!    KV=KVA(ICOL,IROW,ILAY)*D
!    !## assign new bottom
!    D=MINTHICKNESS; BOT(ICOL,IROW,ILAY)=TOP(ICOL,IROW,ILAY)-D
!    !## correct rest of interval that are within current adjusted interval and compute renewed permeability
!    DO JLAY=ILAY+1,NLAY
!    
!     T1=MAX(TOP(ICOL,IROW,JLAY),BOT(ICOL,IROW,ILAY))
!     B1=MAX(BOT(ICOL,IROW,JLAY),BOT(ICOL,IROW,ILAY))
!    
!     !## add available thickness of underlying modellayer, if positive
!     D=T1-B1
!         
!     KD=KD+KHV(ICOL,IROW,JLAY)*D
!     KV=KV+KVA(ICOL,IROW,JLAY)*D
!     TOP(ICOL,IROW,JLAY)=MIN(TOP(ICOL,IROW,JLAY),BOT(ICOL,IROW,ILAY))
!     BOT(ICOL,IROW,JLAY)=MIN(BOT(ICOL,IROW,JLAY),BOT(ICOL,IROW,ILAY))
!    ENDDO
!    KHV(ICOL,IROW,ILAY)=KD/MINTHICKNESS
!    KVA(ICOL,IROW,ILAY)=KV/MINTHICKNESS
!   ENDIF
!  ENDDO

  !## apply consistency check constant head and top/bot
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL; DO ILAY=1,NLAY
   IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
    !## constant head cell dry - becomes active node
    IF(SHD(ILAY)%X(ICOL,IROW).LE.BOT(ILAY)%X(ICOL,IROW))BND(ILAY)%X(ICOL,IROW)=1
   ENDIF
  ENDDO; ENDDO; ENDDO
 ENDIF
  
 !## write bas and dis - after consistency checks 
 IINT=1
 DO ILAY=1,NLAY
  EXFNAME=TRIM(DIR)//'\BAS6\IBOUND_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,BND(ILAY),IINT,IUBAS,HNOFLOW))RETURN
 ENDDO
 WRITE(IUBAS,'(A)') TRIM(RTOS(HNOFLOW,'E',7))
 IINT=0
 DO ILAY=1,NLAY
  EXFNAME=TRIM(DIR)//'\BAS6\STRT_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,SHD(ILAY),IINT,IUBAS,HNOFLOW))RETURN
 ENDDO
 CLOSE(IUBAS)

 DO ILAY=1,NLAY
  EXFNAME=TRIM(DIR)//'\DIS6\TOP_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,TOP(ILAY),IINT,IU,HNOFLOW))RETURN
  !## quasi-3d scheme add bot aquifer modellayer
  IF(LQBD.OR.ILAY.EQ.NLAY)THEN
   EXFNAME=TRIM(DIR)//'\DIS6\BOTM_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,BOT(ILAY),IINT,IU,HNOFLOW))RETURN
  ENDIF
 ENDDO
  
 ISS=0
 !## time information
 DO KPER=1,NPER
  LINE=TRIM(RTOS(SIM(KPER)%DELT,'E',7))//',1,1.0'
  IF(SIM(KPER)%DELT.EQ.0.0)LINE=TRIM(LINE)//',SS'
  IF(SIM(KPER)%DELT.NE.0.0)THEN; LINE=TRIM(LINE)//',TR'; ISS=1; ENDIF
  LINE=TRIM(LINE)//' ['//TRIM(SIM(KPER)%CDATE)//']'
  WRITE(IU,'(A)') TRIM(LINE)
 ENDDO
 CLOSE(IU)

 !## write metaswap
 IF(LMSP)THEN
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.MSP7 ...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.MSP7 ...'
  CALL PMANAGER_SAMEMF2005_METASWAP(IDF%NCOL,IDF%NROW,NLAY,HNOFLOW,BND,IDF)
 ENDIF
 
 !## use bcf6
 IF(LBCF)THEN

  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.BCF6'//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.BCF6'//'...'

  !## construct bcf6-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.BCF6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  LINE=TRIM(ITOS(IBCFCB))//','//TRIM(RTOS(HNOFLOW,'E',7))//',0,1.0,1,0'
  WRITE(IU,'(A)') TRIM(LINE)
  !## ltype code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'00,'
   IF(MOD(ILAY,40).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO
  IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  WRITE(IU,'(A)') 'CONSTANT 1.0' !## trpy

  DO ILAY=1,NLAY
   !## sf1
   IF(ISS.EQ.1)THEN
    ITOPIC=11; SCL_D=1; SCL_U=2; IINV=0; IINT=0
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,0,ITOPIC)
    EXFNAME=TRIM(DIR)//'\BCF6\SF1_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW))RETURN
   ENDIF   
   !## kdw
   ITOPIC=6; SCL_D=1; SCL_U=3; IINV=0; IINT=0
   IF(.NOT.PMANAGER_SAVEMF2005_MOD(KD(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KD(ILAY),0,ITOPIC)
   EXFNAME=TRIM(DIR)//'\BCF6\TRAN_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,KD(ILAY),IINT,IU,HNOFLOW))RETURN
   IF(ILAY.NE.NLAY)THEN
    !## vcont
    ITOPIC=9; SCL_D=1; SCL_U=6; IINV=1; IINT=0
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,0,ITOPIC)
    EXFNAME=TRIM(DIR)//'\BCF6\VCONT_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW))RETURN
   ENDIF
  ENDDO  
  CLOSE(IU)

 ENDIF
  
 !## use lpf7
 IF(LLPF)THEN

  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.LPF7'//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.LPF7'//'...'

  !## construct lpf7-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.LPF7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# LPF7 File Generated by '//TRIM(UTL_IMODVERSION())
  LINE=TRIM(ITOS(IBCFCB))//','//TRIM(RTOS(HNOFLOW,'E',7))//',0,STORAGECOEFFICIENT'
  WRITE(IU,'(A)') TRIM(LINE)
  !## laytyp code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'0,'
   IF(MOD(ILAY,40).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  !## layavg code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'0,'
   IF(MOD(ILAY,40).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  !## chani code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'1.0,'
   IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  !## lvka code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'1,'
   IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  !## laywet code
  LINE=''; DO ILAY=1,NLAY; LINE=TRIM(LINE)//'0,'
   IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') TRIM(LINE); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') TRIM(LINE)
  
  DO ILAY=1,NLAY
   !## hk
   ITOPIC=7; SCL_D=1; SCL_U=3; IINT=0; IINV=0
   IF(.NOT.PMANAGER_SAVEMF2005_MOD(KD(ILAY),ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KD(ILAY),0,ITOPIC)
   EXFNAME=TRIM(DIR)//'\LPF7\HK_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,KD(ILAY),IINT,IU,HNOFLOW))RETURN
   !## vka
   ITOPIC=8; SCL_D=1; SCL_U=2; IINT=0; IINV=1
   IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,0,ITOPIC)
   EXFNAME=TRIM(DIR)//'\LPF7\VKA_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW))RETURN
   !## sf1
   IF(ISS.EQ.1)THEN
    ITOPIC=11; SCL_D=1; SCL_U=2; IINT=0; IINV=0
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,0,ITOPIC)
    EXFNAME=TRIM(DIR)//'\LPF7\SF1_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW))RETURN
   ENDIF
   
   !## quasi-3d scheme add bot aquifer modellayer
   IF(LQBD.AND.ILAY.NE.NLAY)THEN
    !## kvv
    ITOPIC=10; SCL_D=1; SCL_U=3; IINT=0; IINV=1
    IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,1,1,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,0,ITOPIC)
    EXFNAME=TRIM(DIR)//'\LPF7\VKCB_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW))RETURN
   ENDIF
  ENDDO  
  
  CLOSE(IU)
  
 ENDIF

 !## use hfb
 IF(LHFB)THEN

  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.HFB7'//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.HFB7'//'...'

  !## construct hfb-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.HFB7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# HFB7 File Generated by '//TRIM(UTL_IMODVERSION())
  ALLOCATE(IUGEN(NLAY)); IUGEN=0
  DO ILAY=1,NLAY
   IUGEN(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(IUGEN(ILAY),FILE=TRIM(DIR)//'_HFB_L'//TRIM(ITOS(ILAY))//'.GEN',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   IF(IUGEN(ILAY).EQ.0)RETURN
  ENDDO
  ITOPIC=15; IF(.NOT.PMANAGER_SAVEMF2005_HFB(IDF,ITOPIC,IU,IUGEN,TOP,BOT,BND,KD))RETURN
  DEALLOCATE(IUGEN)
 ENDIF

 !## use pcg
 IF(LPCG)THEN
  !## construct pcg-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.PCG7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# PCG7 File Generated by '//TRIM(UTL_IMODVERSION())
  LINE=TRIM(ITOS(MXITER))//','//TRIM(ITOS(ITER1))//','//TRIM(ITOS(NPCOND))
  WRITE(IU,'(A)') TRIM(LINE)
  LINE=TRIM(RTOS(HCLOSE,'E',7))//','//TRIM(RTOS(RCLOSE,'E',7))//','//TRIM(RTOS(RELAX,'E',7))//',1,1,0,1.0'
  WRITE(IU,'(A)') TRIM(LINE)
  CLOSE(IU)
 ENDIF
  
 !## use pcgn
 IF(LPCGN)THEN
  !## construct pcgn-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.PCGN',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  LINE=TRIM(ITOS(MXITER))//','//TRIM(ITOS(ITER1))//','//TRIM(RTOS(RCLOSE,'E',7))//','//TRIM(RTOS(HCLOSE,'E',7))
  WRITE(IU,'(A)') TRIM(LINE)
  LINE=TRIM(RTOS(RELAX,'E',7))//',1,0,0'; WRITE(IU,'(A)') TRIM(LINE)
  LINE='0,1.0,0.0,0.5,1.0'; WRITE(IU,'(A)') TRIM(LINE)
  LINE='0,0.0,0,0.0,0'; WRITE(IU,'(A)') TRIM(LINE)
  CLOSE(IU)
 ENDIF
   
 !## use pcg
 IF(LSIP)THEN
  !## construct sip-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.SIP',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# SIP File Generated by '//TRIM(UTL_IMODVERSION())
  LINE=TRIM(ITOS(MXITER))//',5'; WRITE(IU,'(A)') TRIM(LINE)
  LINE=TRIM(RTOS(RELAX,'E',7))//','//TRIM(RTOS(HCLOSE,'E',7))//',1,0.0,1'; WRITE(IU,'(A)') TRIM(LINE)
  CLOSE(IU)
 ENDIF

 !## construct oc-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.OC',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# OC File Generated by '//TRIM(UTL_IMODVERSION())
 LINE='HEAD SAVE UNIT '//TRIM(ITOS(IHEDUN)); WRITE(IU,'(A)') TRIM(LINE)
 DO IPER=1,NPER
  LINE='PERIOD '//TRIM(ITOS(IPER))//' STEP 1'; WRITE(IU,'(A)') TRIM(LINE)
  LINE='SAVE HEAD'; DO ILAY=1,NLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO; WRITE(IU,'(A)') TRIM(LINE)
  LINE='SAVE BUDGET'; DO ILAY=1,NLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO; WRITE(IU,'(A)') TRIM(LINE)
 ENDDO
 CLOSE(IU)

 DO ITOPIC=21,29
  
  SELECT CASE (ITOPIC)
   CASE (21); LEX=LWEL; CPCK='WEL'; ICB=IWELCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (22); LEX=LDRN; CPCK='DRN'; ICB=IDRNCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (23); LEX=LRIV; CPCK='RIV'; ICB=IRIVCB; CMAXNO='NaN'; CAUX=', AUXILIARY INFFCT AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (24); LEX=LEVT; CPCK='EVT'; ICB=IEVTCB; CMAXNO=TRIM(ITOS(NEVTOP)); CAUX=''; TEXT=''
   CASE (25); LEX=LGHB; CPCK='GHB'; ICB=IGHBCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (26); LEX=LRCH; CPCK='RCH'; ICB=IRCHCB; CMAXNO=TRIM(ITOS(NRCHOP)); CAUX=''; TEXT=''
   CASE (27); LEX=LOLF
    CPCK='OLF'; IF(.NOT.LDRN)CPCK='DRN'
    ICB=IDRNCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (28); LEX=LCHD; CPCK='CHD'; ICB=ICHDCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
   CASE (29); LEX=LISG
    CPCK='ISG'; IF(.NOT.LRIV)CPCK='RIV'
    ICB=IRIVCB; CMAXNO='NaN'; CAUX=', AUXILIARY SYSTEM NOPRINT'; TEXT='_'
  END SELECT
 
  !## not available
  IF(.NOT.LEX)CYCLE

  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIR)//'.'//TRIM(CPCK)//'7...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIR)//'.'//TRIM(CPCK)//'7...'

  IU=UTL_GETUNIT()
  CALL OSD_OPEN(IU,FILE=TRIM(DIR)//'.'//TRIM(CPCK)//'7'//TRIM(TEXT),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# '//TRIM(CPCK)//'7 File Generated by '//TRIM(UTL_IMODVERSION())
  LINE=TRIM(CMAXNO)//','//TRIM(ITOS(ICB))//TRIM(CAUX); WRITE(IU,'(A)') TRIM(LINE)
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(IU,ITOPIC,BND,HNOFLOW,DIR,TRIM(CPCK)//'7\'//TRIM(CPCK),NP,LTB,TOP,BOT,KD,IBATCH))RETURN
  CLOSE(IU); IF(TEXT.NE.'')CALL PMANAGER_SAVEMF2005_MAXNO(TRIM(DIR)//'.'//TRIM(CPCK)//'7'//TRIM(TEXT),NP)
 
 ENDDO

 !## combine olf/drn and isg/riv
 IF(LOLF.AND.LDRN)CALL PMANAGER_SAMEMF2005_COMBINE(DIR,(/'OLF','DRN','DRN_'/),IDRNCB,'')
 IF(LISG.AND.LRIV)CALL PMANAGER_SAMEMF2005_COMBINE(DIR,(/'ISG','RIV','RIV_'/),IRIVCB,'AUXILIARY INFFCT')
  
 CALL IDFDEALLOCATEX(IDF)
 CALL IDFDEALLOCATE(BND,SIZE(BND)); DEALLOCATE(BND)
 CALL IDFDEALLOCATE(SHD,SIZE(SHD)); DEALLOCATE(SHD)
 CALL IDFDEALLOCATE(TOP,SIZE(TOP)); DEALLOCATE(TOP)
 CALL IDFDEALLOCATE(BOT,SIZE(BOT)); DEALLOCATE(BOT)
 CALL IDFDEALLOCATE(KD ,SIZE(KD));  DEALLOCATE(KD)
 
 PMANAGER_SAVEMF2005=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005

 !####====================================================================
 SUBROUTINE PMANAGER_SAMEMF2005_METASWAP(NCOL,NROW,NLAY,HNOFLOW,BND,IDF)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NCOL,NROW,NLAY
 REAL,INTENT(IN) :: HNOFLOW
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 TYPE(IDFOBJ),DIMENSION(NLAY),INTENT(INOUT) :: BND
 !## dummy variables
 INTEGER :: ISYS,ILAY,ITOPIC,IPER,IINV,SCL_U,SCL_D
 INTEGER :: I,J,NIDF
 REAL,DIMENSION(:),ALLOCATABLE :: NODATA
 CHARACTER(LEN=256) :: FFNAME
  
 NIDF=22; ALLOCATE(NODATA(NIDF))

 !## allocate memory
 IF(ALLOCATED(SIMGRO))DEALLOCATE(SIMGRO); ALLOCATE(SIMGRO(NCOL,NROW))

 !## initialize unit numbers
 INDSB=0; IAREA=0; ISELSVAT=0; IGWMP=0; IMODSIM=0; ISCAP=0; IINFI=0; IIDF =0
    
 !## open indsb
 FFNAME='svat2swnr_roff.inp'; INDSB=UTL_GETUNIT(); CALL OSD_OPEN(INDSB,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open iarea
 FFNAME='area_svat.inp'; IAREA=UTL_GETUNIT(); CALL OSD_OPEN(IAREA,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open iscap
 FFNAME='scap_svat.inp'; ISCAP=UTL_GETUNIT(); CALL OSD_OPEN(ISCAP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open igwmp
 FFNAME='mod2svat.inp'; IGWMP=UTL_GETUNIT(); CALL OSD_OPEN(IGWMP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open MOD-SIM.TXT
 FFNAME='MOD-SIM.TXT'; IMODSIM=UTL_GETUNIT(); CALL OSD_OPEN(IMODSIM,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open iselsvat
 FFNAME='sel_svat_bda.inp'; ISELSVAT=UTL_GETUNIT(); CALL OSD_OPEN(ISELSVAT,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open infi_svat.inp
 FFNAME='infi_svat.inp'; IINFI=UTL_GETUNIT(); OPEN(IINFI,FILE=FFNAME,STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACTION='WRITE')
 !## open idf_svat.inp
 FFNAME='idf_svat.inp'; IIDF=UTL_GETUNIT(); CALL OSD_OPEN(IIDF,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open uscl_svat.inp
 FFNAME='uscl_svat.inp'; IUSCL=UTL_GETUNIT(); CALL OSD_OPEN(IUSCL,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')

 !## metaswap
 IARMWP=0
 IF(TOPICS(1)%IACT_MODEL.EQ.1)THEN
  IF(ASSOCIATED(TOPICS(1)%STRESS))THEN
   FFNAME=TOPICS(1)%STRESS(1)%FILES(8,1)%FNAME
   IF(INDEX(UTL_CAP(FFNAME,'U'),'IPF').GT.0)IARMWP=1
  ENDIF
 ENDIF

 ISYS=0; ILAY=1; ITOPIC=1; IPER=1; IINV=0
 
 !## open all files
 DO ISYS=1,NIDF
  !## skip ipf for artificial recharge
  IF(IARMWP.EQ.1.AND.ISYS.EQ.8)CYCLE
  
  SELECT CASE (ISYS)
   CASE (1);          NODATA(ISYS)=-999.99; SCL_U=1; SCL_D=0
   CASE (2:5,7:9);    NODATA(ISYS)=-999.99; SCL_U=7; SCL_D=0
   CASE (6,12,13,20); NODATA(ISYS)=-999.99; SCL_U=2; SCL_D=1
   CASE (21,22);      NODATA(ISYS)=-999.99; SCL_U=2; SCL_D=0
   CASE (18,19);      NODATA(ISYS)=-999.99; SCL_U=6; SCL_D=0 !## scaling m/d -> reciprook -> m/d
   CASE (14:17);      NODATA(ISYS)=-999.99; SCL_U=6; SCL_D=0
   CASE (10,11);      NODATA(ISYS)=-999.99; SCL_U=5; SCL_D=0
  END SELECT

  !## read in data
  IF(.NOT.PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,IPER,ISYS,ILAY,SCL_D,SCL_U,HNOFLOW,IINV))RETURN
 
  SELECT CASE (ISYS)
   CASE (1);  SIMGRO%IBOUND=INT(IDF%X)
   CASE (2);  SIMGRO%LGN=INT(IDF%X)
   CASE (3);  SIMGRO%RZ=IDF%X
   CASE (4);  SIMGRO%BODEM=INT(IDF%X)
   CASE (5);  SIMGRO%METEO=INT(IDF%X)
   CASE (6);  SIMGRO%MV=IDF%X
   CASE (7);  SIMGRO%BEREGEN=INT(IDF%X)
   CASE (8);  SIMGRO%BER_LAAG=INT(IDF%X)
   CASE (9);  SIMGRO%BEREGEN_Q=IDF%X
   CASE (10); SIMGRO%NOPP=IDF%X
   CASE (11); SIMGRO%SOPP=IDF%X
   CASE (12); SIMGRO%VXMU_SOPP=IDF%X 
   CASE (13); SIMGRO%VXMU_ROPP=IDF%X 
   CASE (14); SIMGRO%CRUNOFF_SOPP=IDF%X
   CASE (15); SIMGRO%CRUNOFF_ROPP=IDF%X
   CASE (16); SIMGRO%CRUNON_SOPP=IDF%X
   CASE (17); SIMGRO%CRUNON_ROPP=IDF%X
   CASE (18); SIMGRO%QINFBASIC_SOPP=IDF%X
   CASE (19); SIMGRO%QINFBASIC_ROPP=IDF%X
   CASE (20); SIMGRO%PWT_LEVEL=IDF%X
   CASE (21); SIMGRO%MOISTURE=IDF%X
   CASE (22); SIMGRO%COND=IDF%X
  END SELECT

 ENDDO

 IF(.NOT.LPWT)SIMGRO%PWT_LEVEL=NODATA(20) 

 !## check input parameters
 CALL PMANAGER_SAMEMF2005_METASWAP_CHECK(IDF,NCOL,NROW,NLAY,NODATA)
  
 ISYS=8
 CALL PMANAGER_SAMEMF2005_METASWAP_INPFILES(NROW,NCOL,NLAY,NODATA(20),TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%FNAME,IDF,LPWT)
 
 IF(IAREA.GT.0)   CLOSE(IAREA)
 IF(ISELSVAT.GT.0)CLOSE(ISELSVAT)
 IF(INDSB.GT.0)   CLOSE(INDSB)
 IF(ISCAP.GT.0)   CLOSE(ISCAP)
 IF(IGWMP.GT.0)   CLOSE(IGWMP)
 IF(IMODSIM.GT.0) CLOSE(IMODSIM)
 IF(IINFI.GT.0)   CLOSE(IINFI)
 IF(IIDF.GT.0)    CLOSE(IIDF)
 IF(IUSCL.GT.0)   CLOSE(IUSCL)
  
 !## write extra files
 IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%INPFILES))THEN
  J=SIZE(TOPICS(ITOPIC)%STRESS(1)%INPFILES)
  DO I=1,J
   FFNAME=UTL_CAP(TOPICS(ITOPIC)%STRESS(1)%INPFILES(I),'U')
   IF(INDEX(FFNAME,'PARA_SIM.INP').GT.0)THEN
    CALL PMANAGER_SAMEMF2005_METASWAP_PARASIM(FFNAME,IDF)
   ELSE
    CALL SYSTEM('COPY "'//TRIM(FFNAME)//'" /Y ')
   ENDIF
  ENDDO
 ENDIF

 !## metaswap 727 computing with recharge (possibility) if mete_grid.inp exists
! CALL PMANAGER_SAMEMF2005_METASWAP_METEGRID()

 DEALLOCATE(SIMGRO,NODATA)
 
 END SUBROUTINE PMANAGER_SAMEMF2005_METASWAP

 !###====================================================================
 SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_PARASIM(FNAME,IDF)
 !###====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER :: IU,JU,I,IOS
 CHARACTER(LEN=256) :: LINE

 I=INDEX(FNAME,'\',.TRUE.)

 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ')
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE='para_sim.inp',STATUS='REPLACE',ACTION='WRITE')
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  WRITE(JU,'(A)') TRIM(LINE)
 ENDDO
 
 WRITE(JU,'(A)') '*'
 WRITE(JU,'(A)') '*  Parameters for IDF output'
 WRITE(JU,'(A)') '*'
 WRITE(JU,'(A)') '      idf_per                =      1    ! Writing IDF files' 
 LINE='      idf_xmin                =      '//TRIM(RTOS(IDF%XMIN,'F',2))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_ymin                =      '//TRIM(RTOS(IDF%YMIN,'F',2))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_dx                  =      '//TRIM(RTOS(IDF%DX,'F',2))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_dy                  =      '//TRIM(RTOS(IDF%DY,'F',2))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_ncol                =      '//TRIM(ITOS(IDF%NCOL))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_nrow                =      '//TRIM(ITOS(IDF%NROW))
 WRITE(JU,'(A)') TRIM(LINE) 
 LINE='      idf_nodata              =      '//TRIM(RTOS(-9999.99,'F',2))
 WRITE(JU,'(A)') TRIM(LINE)

 CLOSE(JU)

 END SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_PARASIM
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_INPFILES(NROW,NCOL,NLAY,NODATA_PWT,IPFFILE,IDF,LPWT)
 !###====================================================================
 IMPLICIT NONE
 LOGICAL :: LPWT
 REAL,INTENT(IN) :: NODATA_PWT
 INTEGER,INTENT(IN) :: NROW,NCOL,NLAY
 CHARACTER(LEN=*),INTENT(IN) :: IPFFILE
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER,PARAMETER :: AEND=0 !## no surfacewater units
 INTEGER :: NUND,MDND,MDND2,IROW,ICOL,LYBE,TYBE,BEREGENID,JROW,JCOL,N,M,I,J,JU
 REAL :: XC,YC,ARND,QBER
 TYPE IPFOBJ
  INTEGER :: ILAY
  REAL :: X,Y,CAP
 END TYPE IPFOBJ
 TYPE(IPFOBJ),ALLOCATABLE,DIMENSION(:) :: IPF

 IF(IARMWP.EQ.1)THEN
  JU=UTL_GETUNIT(); MDND=0
  DO J=1,2
   CALL OSD_OPEN(JU,FILE=IPFFILE,ACTION='READ',STATUS='OLD') 
   READ(JU,*) N; READ(JU,*) M
!   IF(M.LT.5)CALL PRINTTEXT('IPF for artificial recharge should be at least 5 column, x,y,ilay,id,capacity',2)
   DO I=1,M+1; READ(JU,*) ; ENDDO
   IF(J.EQ.2)THEN; ALLOCATE(IPF(MDND)); IPF%ILAY=0; IPF%CAP=0.0; ENDIF
   DO I=1,N
    READ(JU,*) XC,YC,LYBE,NUND,QBER
    IF(J.EQ.1)MDND=MAX(MDND,NUND)
    IF(J.EQ.2)THEN; IPF(NUND)%X=XC; IPF(NUND)%Y=YC; IPF(NUND)%ILAY=LYBE; IPF(NUND)%CAP=QBER; ENDIF   
   ENDDO
   CLOSE(JU)
  ENDDO
 ENDIF

 NUND=0 
 DO IROW=1,NROW
  DO ICOL=1,NCOL
   IF(SIMGRO(ICOL,IROW)%IBOUND.LE.0)CYCLE
   
   MDND=(IROW-1)*NCOL+ICOL
   ARND=IDFGETAREA(IDF,ICOL,IROW)
   ARND= ARND-SIMGRO(ICOL,IROW)%NOPP-SIMGRO(ICOL,IROW)%SOPP

   !## rural area > 0
   IF(ARND.GT.0.0)THEN
    NUND=NUND+1

    !## write idf_svat.inp - inside area of interest
    WRITE(IIDF,'(3I10)') NUND,IROW,ICOL
    
    !## write sel_svat_bda.inp
    WRITE(ISELSVAT,'(I10)') NUND

    !## write area_svat.inp
    WRITE(IAREA,'(I10,F10.1,F8.3,8X,I6,8X,8X,I6,F8.3,I10,2F8.3)') NUND,ARND,SIMGRO(ICOL,IROW)%MV, & 
          SIMGRO(ICOL,IROW)%BODEM,SIMGRO(ICOL,IROW)%LGN,SIMGRO(ICOL,IROW)%RZ/100.0,               &
          SIMGRO(ICOL,IROW)%METEO,1.0,1.0

    !## write svat2swnr_roff.inp ------------------
    WRITE(INDSB,'(I10,I10,F8.3,2F8.1)') NUND,AEND,SIMGRO(ICOL,IROW)%VXMU_ROPP,SIMGRO(ICOL,IROW)%CRUNOFF_ROPP, &
                                        SIMGRO(ICOL,IROW)%CRUNON_ROPP 

    !## write infi_svat.inp, infiltratiecapaciteit per cel, de rest -9999.
    WRITE(IINFI,'(I10,F8.3,4F8.1)') NUND,SIMGRO(ICOL,IROW)%QINFBASIC_ROPP,-9999.0,-9999.0,-9999.0,-9999.0

    !## BEGIN scap_svat.inp - grondwater + ow

    IF(IARMWP.EQ.0)THEN
     LYBE=SIMGRO(ICOL,IROW)%BER_LAAG
     TYBE=SIMGRO(ICOL,IROW)%BEREGEN
     QBER=SIMGRO(ICOL,IROW)%BEREGEN_Q
     JCOL=ICOL; JROW=IROW
    ELSE
     JCOL=0; JROW=0
     BEREGENID=INT(SIMGRO(ICOL,IROW)%BEREGEN)
     IF(BEREGENID.GT.0.AND.BEREGENID.LE.SIZE(IPF))THEN
      QBER=IPF(BEREGENID)%CAP
      LYBE=IPF(BEREGENID)%ILAY
      TYBE=1 !## groundwater
      CALL IDFIROWICOL(IDF,JROW,JCOL,IPF(BEREGENID)%X,IPF(BEREGENID)%Y)
     ENDIF
    ENDIF    
    MDND2=      (JROW-1)*NCOL+JCOL
    MDND2=MDND2+(LYBE-1)*NCOL*NROW
    
    IF(JROW.NE.0.AND.JCOL.NE.0)THEN
    
     !## maximum groundwater   abstraction mm/day fmmxabgw
     IF(QBER.GT.0.0)THEN
      IF(TYBE.EQ.1)THEN
       WRITE(ISCAP,'(I10,F8.2,24X,I10,I6)') NUND,QBER,NUND,LYBE
      ELSEIF(TYBE.EQ.2)THEN
       WRITE(ISCAP,'(I10,8X,F8.2,32X,I10)') NUND,QBER,AEND
      ENDIF
     ENDIF
    
     !## sprinkling from other than modellayer 1 or other location
     IF(TYBE.EQ.1.AND.MDND.NE.MDND2)THEN !LYBE.GT.1)THEN
      WRITE(IGWMP,'(I10,2X,I10,I5)')   MDND2,NUND,LYBE
      WRITE(IMODSIM,'(I10,2X,I10,I5)') MDND2,NUND,LYBE
     ENDIF
    
    ENDIF
    !## END scap_svat.inp - grondwater + ow

    !## BEGIN mod2svat.inp; NB: als opp. water of glas dan laag = 0

    WRITE(IGWMP  ,'(I10,2X,I10,I5)')  MDND,NUND,1
    WRITE(IMODSIM,'(I10,2X,I10,I5)')  MDND,NUND,1
    
    IF(.NOT.LPWT)THEN
     WRITE(IUSCL,'(I10,3F8.3,8X,2I10)')   NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0,ICOL,IROW
    ELSE
     IF(SIMGRO(ICOL,IROW)%PWT_LEVEL.NE.NODATA_PWT)THEN
      WRITE(IUSCL,'(I10,4F8.3,2I10)')    NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0, &
                                         SIMGRO(ICOL,IROW)%MV-SIMGRO(ICOL,IROW)%PWT_LEVEL,ICOL,IROW
     ELSE
      WRITE(IUSCL,'(I10,3F8.3,8X,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0,ICOL,IROW
     ENDIF
    ENDIF
    
    !## END mod2svat.inp; NB: als opp. water of glas dan laag = 0

   ENDIF

   !## urban area (verhard)
   ARND  =IDFGETAREA(IDF,ICOL,IROW)
   ARND  =MIN(ARND,SIMGRO(ICOL,IROW)%SOPP) !< dit komt niet meer terug?
   IF(ARND.GT.0.0)THEN
    NUND=NUND+1

    !## write sel_svat_bda.inp
    WRITE(ISELSVAT,'(I10)') NUND

    WRITE(IAREA,'(I10,F10.1,F8.3,8X,I6,16X,I6,F8.3,I10,2F8.2)') &  !
      NUND,ARND,SIMGRO(ICOL,IROW)%MV+MSWPMV,SIMGRO(ICOL,IROW)%BODEM,18,0.1,SIMGRO(ICOL,IROW)%METEO,1.0,1.0

    WRITE(INDSB,'(2I10,F8.3,2F8.1)') NUND,0,SIMGRO(ICOL,IROW)%VXMU_SOPP,SIMGRO(ICOL,IROW)%CRUNOFF_SOPP,SIMGRO(ICOL,IROW)%CRUNON_SOPP 
    WRITE(IGWMP,'(I10,2X,I10,I5)')   MDND,NUND,1
    IF(.NOT.LPWT)THEN
     WRITE(IUSCL,'(I10,3F8.3,8X,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0,ICOL,IROW
    ELSE
     IF(SIMGRO(ICOL,IROW)%PWT_LEVEL.NE.NODATA_PWT)THEN
      WRITE(IUSCL,'(I10,4F8.3,2I10)')   NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0, &
                                        SIMGRO(ICOL,IROW)%MV-SIMGRO(ICOL,IROW)%PWT_LEVEL,ICOL,IROW
     ELSE
      WRITE(IUSCL,'(I10,3F8.3,8X,2I10)')   NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0,ICOL,IROW
     ENDIF
    ENDIF
    WRITE(IMODSIM,'(I10,2X,I10,I5)') MDND,NUND,1
    
    !## write infi_svat.inp, infiltratiecapaciteit per cel, de rest -9999.
    WRITE(IINFI,'(I10,F8.3,4F8.1)') NUND,SIMGRO(ICOL,IROW)%QINFBASIC_SOPP,-9999.0,-9999.0,-9999.0,-9999.0

   ENDIF

  ENDDO
 ENDDO

 IF(IARMWP.EQ.1)DEALLOCATE(IPF)
 
 RETURN
 
 END SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_INPFILES

 !###====================================================================
 SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_CHECK(IDF,NCOL,NROW,NLAY,NODATA)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER,INTENT(IN) :: NCOL,NROW,NLAY
 REAL,DIMENSION(:),INTENT(IN) :: NODATA
 INTEGER,DIMENSION(:),ALLOCATABLE :: IERROR
 INTEGER :: IROW,ICOL,STRLEN
 REAL :: DXY,ARND
 CHARACTER(LEN=:),ALLOCATABLE :: STR

 !## make sure that for sopp>0 there is a vxmu value, turn nopp otherwise off
 DO IROW=1,NROW; DO ICOL=1,NCOL
  IF(SIMGRO(ICOL,IROW)%VXMU_SOPP.EQ.NODATA(12))SIMGRO(ICOL,IROW)%SOPP=0.0
  IF(SIMGRO(ICOL,IROW)%SOPP.GT.0.0)THEN
   IF(SIMGRO(ICOL,IROW)%VXMU_SOPP     .EQ.NODATA(12))SIMGRO(ICOL,IROW)%SOPP=0.0
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_SOPP  .EQ.NODATA(14))SIMGRO(ICOL,IROW)%SOPP=0.0
   IF(SIMGRO(ICOL,IROW)%CRUNON_SOPP   .EQ.NODATA(16))SIMGRO(ICOL,IROW)%SOPP=0.0
   IF(SIMGRO(ICOL,IROW)%QINFBASIC_SOPP.EQ.NODATA(18))SIMGRO(ICOL,IROW)%SOPP=0.0
  ENDIF
  DXY=IDFGETAREA(IDF,ICOL,IROW)
  IF(SIMGRO(ICOL,IROW)%VXMU_ROPP.EQ.NODATA(13))SIMGRO(ICOL,IROW)%NOPP=DXY !## surface water, no metaswap
  ARND=DXY-SIMGRO(ICOL,IROW)%NOPP-SIMGRO(ICOL,IROW)%SOPP
  !## rural area
  IF(ARND.GT.0.0)THEN
   IF(SIMGRO(ICOL,IROW)%VXMU_ROPP     .EQ.NODATA(13))SIMGRO(ICOL,IROW)%NOPP=DXY !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_ROPP  .EQ.NODATA(15))SIMGRO(ICOL,IROW)%NOPP=DXY !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%CRUNON_ROPP   .EQ.NODATA(17))SIMGRO(ICOL,IROW)%NOPP=DXY !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%QINFBASIC_ROPP.EQ.NODATA(19))SIMGRO(ICOL,IROW)%NOPP=DXY !## surface water, no metaswap
  ENDIF
 ENDDO; ENDDO

 !## check input
 ALLOCATE(IERROR(22)); IERROR=0
 DO IROW=1,NROW; DO ICOL=1,NCOL
  IF(SIMGRO(ICOL,IROW)%IBOUND.GT.0)THEN
   IF(SIMGRO(ICOL,IROW)%LGN.EQ.NODATA(2))            IERROR(2) =IERROR(2)+1
   IF(SIMGRO(ICOL,IROW)%RZ.EQ.NODATA(3))             IERROR(3) =IERROR(3)+1
   IF(SIMGRO(ICOL,IROW)%BODEM.EQ.NODATA(4))          IERROR(4) =IERROR(4)+1
   IF(SIMGRO(ICOL,IROW)%METEO.EQ.NODATA(5))          IERROR(5) =IERROR(5)+1
   IF(SIMGRO(ICOL,IROW)%MV.EQ.NODATA(6))             IERROR(6) =IERROR(6)+1
   IF(SIMGRO(ICOL,IROW)%BEREGEN.EQ.NODATA(7))        IERROR(7) =IERROR(7)+1
   IF(IARMWP.EQ.0)THEN
    IF(SIMGRO(ICOL,IROW)%BER_LAAG.EQ.NODATA(8))      IERROR(8) =IERROR(8)+1
    IF(SIMGRO(ICOL,IROW)%BEREGEN_Q.EQ.NODATA(9))     IERROR(9) =IERROR(9)+1
   ENDIF
   IF(SIMGRO(ICOL,IROW)%NOPP.EQ.NODATA(10))          IERROR(10)=IERROR(10)+1
   IF(SIMGRO(ICOL,IROW)%SOPP.EQ.NODATA(11))          IERROR(11)=IERROR(11)+1
   IF(SIMGRO(ICOL,IROW)%VXMU_ROPP.EQ.NODATA(13))     IERROR(13)=IERROR(13)+1
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_SOPP.EQ.NODATA(14))  IERROR(14)=IERROR(14)+1
   IF(SIMGRO(ICOL,IROW)%SOPP.GT.0)THEN
    IF(SIMGRO(ICOL,IROW)%VXMU_SOPP.EQ.NODATA(12))     IERROR(12)=IERROR(12)+1
    IF(SIMGRO(ICOL,IROW)%CRUNON_SOPP.EQ.NODATA(16))   IERROR(16)=IERROR(16)+1
    IF(SIMGRO(ICOL,IROW)%QINFBASIC_SOPP.EQ.NODATA(18))IERROR(18)=IERROR(18)+1
   ENDIF
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_ROPP.EQ.NODATA(15))  IERROR(15)=IERROR(15)+1
   IF(SIMGRO(ICOL,IROW)%CRUNON_ROPP.EQ.NODATA(17))   IERROR(17)=IERROR(17)+1
   IF(SIMGRO(ICOL,IROW)%QINFBASIC_ROPP.EQ.NODATA(19))IERROR(19)=IERROR(19)+1
   IF(LPWT)THEN
!    IF(SIMGRO(ICOL,IROW)%PWT_LEVEL.EQ.NODATA(20))  IERROR(20)=IERROR(20)+1 <--- nodata is niet erg, is er geen PWT aanwezig
   ENDIF
   IF(SIMGRO(ICOL,IROW)%MOISTURE.EQ.NODATA(21))      IERROR(21)=IERROR(21)+1
   IF(SIMGRO(ICOL,IROW)%COND.EQ.NODATA(22))          IERROR(22)=IERROR(22)+1
  ENDIF
 ENDDO; ENDDO

 !## error in data
 IF(SUM(IERROR).GT.0)THEN
   STRLEN=22*30; ALLOCATE(CHARACTER(LEN=STRLEN) :: STR)
   STR='NodataValues on active modelcells found in :'//NEWLINE// &
   '- Landuse           '//TRIM(ITOS(IERROR(2)))//NEWLINE// &
   '- Rootzone          '//TRIM(ITOS(IERROR(3)))//NEWLINE// &
   '- Soil Types        '//TRIM(ITOS(IERROR(4)))//NEWLINE// &
   '- Meteo Stations    '//TRIM(ITOS(IERROR(5)))//NEWLINE// &
   '- Surface Level     '//TRIM(ITOS(IERROR(6)))//NEWLINE// &
   '- Art. Recharge     '//TRIM(ITOS(IERROR(7)))//NEWLINE// &
   '- Art. Rch. Layer   '//TRIM(ITOS(IERROR(8)))//NEWLINE// &
   '- Art. Rch. Strength'//TRIM(ITOS(IERROR(9)))//NEWLINE// &
   '- Wetted Area       '//TRIM(ITOS(IERROR(10)))//NEWLINE// &
   '- Surf. Urban Area  '//TRIM(ITOS(IERROR(11)))//NEWLINE// &
   '- VXMU SOPP         '//TRIM(ITOS(IERROR(12)))//NEWLINE// &
   '- VXMU ROPP         '//TRIM(ITOS(IERROR(13)))//NEWLINE// &
   '- CRUNOFF SOPP      '//TRIM(ITOS(IERROR(14)))//NEWLINE// &
   '- CRUNOFF ROPP      '//TRIM(ITOS(IERROR(15)))//NEWLINE// &
   '- CRUNON SOPP       '//TRIM(ITOS(IERROR(16)))//NEWLINE// &
   '- CRUNON ROPP       '//TRIM(ITOS(IERROR(17)))//NEWLINE// &
   '- QINFBASIS SOPP    '//TRIM(ITOS(IERROR(18)))//NEWLINE// &
   '- QINFBASIS ROPP    '//TRIM(ITOS(IERROR(19)))//NEWLINE// &
!   '- Pondingdepth      '//TRIM(ITOS(IERROR(12))),1)
!!  IF(LPWT)CALL PRINTTEXT('- PWT Level         '//TRIM(ITOS(IERROR(20))),1)
   '- Moisture Factor   '//TRIM(ITOS(IERROR(21)))//NEWLINE// &
   '- Conductivity      '//TRIM(ITOS(IERROR(22)))//NEWLINE// &
   'Process stopped!'
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,TRIM(STR),'Error')
  DEALLOCATE(STR,IERROR); RETURN
 ENDIF

 !## change surface water into gras; change urban into gras
 DO IROW=1,NROW
  DO ICOL=1,NCOL
   SELECT CASE (SIMGRO(ICOL,IROW)%LGN)
    CASE (8,18:21,23:26)
     SIMGRO(ICOL,IROW)%LGN=1
    CASE (22)
     SIMGRO(ICOL,IROW)%LGN=12
    CASE (:0,45:)
     SIMGRO(ICOL,IROW)%LGN=1
   END SELECT
  ENDDO
 ENDDO
  
 !## minimale beworteling
 DO IROW=1,NROW; DO ICOL=1,NCOL
  IF(SIMGRO(ICOL,IROW)%RZ.LT.10.0)SIMGRO(ICOL,IROW)%RZ=10.0
 ENDDO; ENDDO
 
 !## minimal nopp-value
 DO IROW=1,NROW; DO ICOL=1,NCOL
  SIMGRO(ICOL,IROW)%NOPP=MAX(0.0,SIMGRO(ICOL,IROW)%NOPP)
  !## minimal sopp-value
  SIMGRO(ICOL,IROW)%SOPP=MAX(0.0,SIMGRO(ICOL,IROW)%SOPP)
 ENDDO; ENDDO
 
 !## bodem 22/23 vertalen naar 9 -> 22 (stedelijk zand?)/23(geen bodem; stad) -> zand
 DO IROW=1,NROW
  DO ICOL=1,NCOL
   SELECT CASE (SIMGRO(ICOL,IROW)%BODEM)
    CASE (23,22)
     SIMGRO(ICOL,IROW)%BODEM=9
   END SELECT
   !## kies bodem 22 for lgn stedelijk gebied
   SELECT CASE (SIMGRO(ICOL,IROW)%LGN)
    CASE (18,25)
!     SIMGRO(ICOL,IROW)%BODEM=22
   END SELECT
  ENDDO
 ENDDO

 IF(IARMWP.EQ.0)THEN

  !## turn off beregening whenever layer is nul!
  DO IROW=1,NROW
   DO ICOL=1,NCOL
    !## maximal artificial recharge layer is nlay
    SIMGRO(ICOL,IROW)%BER_LAAG=MIN(SIMGRO(ICOL,IROW)%BER_LAAG,NLAY)
    IF(SIMGRO(ICOL,IROW)%BEREGEN.NE.0.AND.SIMGRO(ICOL,IROW)%BER_LAAG.EQ.0)SIMGRO(ICOL,IROW)%BEREGEN=0
   ENDDO
  ENDDO
 ENDIF
 
 DEALLOCATE(IERROR)
 
 END SUBROUTINE PMANAGER_SAMEMF2005_METASWAP_CHECK
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAMEMF2005_COMBINE(DIR,PCK,CB,CAUX)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,CAUX
 INTEGER,INTENT(IN) :: CB
 CHARACTER(LEN=*),INTENT(IN),DIMENSION(3) :: PCK
 INTEGER,DIMENSION(3) :: IU
 INTEGER,DIMENSION(3) :: JU,NO,NO_PREV
 CHARACTER(LEN=256) :: LINE
 CHARACTER(LEN=256),DIMENSION(3) :: FNAME,FNAME_PREV
 INTEGER :: I,J,IPER
  
 !## read from files
 IU=0
 DO I=1,SIZE(PCK)
  LINE=TRIM(DIR)//'.'//TRIM(PCK(I))//'7'
  IF(I.LE.2)THEN
   IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='OLD',ACTION='READ')
  ELSE
   !## write to file
   IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='UNKNOWN',ACTION='WRITE')
  ENDIF
 ENDDO
 
 DO I=1,2; READ(IU(I),'(A256)') LINE; ENDDO; WRITE(IU(3),'(A)') TRIM(LINE)

 NO=0; DO I=1,2; READ(IU(I),*) NO(I); ENDDO
 LINE=TRIM(ITOS(SUM(NO)))//','//TRIM(ITOS(CB))//','//TRIM(CAUX)//' AUXILIARY SYSTEM NOPRINT'
 WRITE(IU(3),'(A)') TRIM(LINE)
  
 DO IPER=1,NPER
  
  NO=0; DO I=1,2; READ(IU(I),*) NO(I); ENDDO
  !## use previous timestep for both
  IF(NO(1).EQ.-1.AND.NO(2).EQ.-1)THEN
   WRITE(IU(3),'(I2)') -1; CYCLE
  ENDIF 

  FNAME=''

  !## resuse previous values
  DO I=1,2
   IF(NO(I).LT.0)THEN; NO(I)=NO_PREV(I); FNAME(I)=FNAME_PREV(I); ENDIF
  ENDDO
  
  LINE=TRIM(ITOS(SUM(NO)))
  WRITE(IU(3),'(A)') TRIM(LINE)
  
  JU=0
  DO I=1,2
   !## refresh external filename
   IF(NO(I).GT.0)THEN
    IF(LEN_TRIM(FNAME(I)).EQ.0)THEN
     READ(IU(I),'(11X,A)') FNAME(I)
     FNAME(I)=UTL_CAP(FNAME(I),'U')
     J=INDEX(FNAME(I),'.ARR',.TRUE.)-1
     FNAME(I)=DIR(:INDEX(DIR,'\',.TRUE.)-1)//TRIM(FNAME(I)(2:J))//'.ARR'
     FNAME(I)=UTL_CAP(FNAME(I),'U')
    ENDIF
    JU(I)=UTL_GETUNIT(); CALL OSD_OPEN(JU(I),FILE=FNAME(I),STATUS='OLD',ACTION='READ')
   ENDIF
  ENDDO
  
  !## create (new) output file
  FNAME(3)=TRIM(DIR)//'\'//  TRIM(PCK(2))//'7\'//TRIM(PCK(2))//'_t'//TRIM(ITOS(IPER))//'.ARR'
  FNAME(3)=UTL_CAP(FNAME(3),'U')

  !## append to existing file, create new file otherwise
  JU(3)=UTL_GETUNIT()
  IF(FNAME(3).EQ.FNAME(2))THEN
   CLOSE(JU(2)); JU(2)=0
   CALL OSD_OPEN(JU(3),FILE=FNAME(3),STATUS='OLD'    ,ACTION='WRITE',POSITION='APPEND')
  ELSE
   CALL OSD_OPEN(JU(3),FILE=FNAME(3),STATUS='UNKNOWN',ACTION='WRITE')
  ENDIF

  LINE=FNAME(I); DO J=1,3; LINE=LINE(:INDEX(LINE,'\',.TRUE.)-1); ENDDO
  J=LEN_TRIM(LINE); LINE='.'//FNAME(I)(J+1:)

  IF(SUM(NO).GT.0)WRITE(IU(3),'(A)') 'OPEN/CLOSE '//TRIM(LINE)//' 1.0 (FREE) -1'
   
  IF(JU(1).GT.0)THEN; DO I=1,NO(1); READ(JU(1),'(A256)') LINE; WRITE(JU(3),'(A)') TRIM(LINE); ENDDO; CLOSE(JU(1)); ENDIF
  IF(JU(2).GT.0)THEN; DO I=1,NO(2); READ(JU(2),'(A256)') LINE; WRITE(JU(3),'(A)') TRIM(LINE); ENDDO; CLOSE(JU(2)); ENDIF
  CLOSE(JU(3))
  
  DO I=1,2; NO_PREV(I)=NO(I); FNAME_PREV(I)=FNAME(I); ENDDO

 ENDDO
 
 CLOSE(IU(1),STATUS='DELETE')
 CLOSE(IU(2),STATUS='DELETE')
 CLOSE(IU(3))
 
 !## rename file
 FNAME(1)=TRIM(DIR)//'.'//TRIM(PCK(3))//'7'
 FNAME(2)=TRIM(DIR)//'.'//TRIM(PCK(2))//'7'
 CALL IOSRENAMEFILE(FNAME(1),FNAME(2))
 
 END SUBROUTINE PMANAGER_SAMEMF2005_COMBINE

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MAXNO(FNAME,NP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NP
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER :: IU,JU,IOS
 CHARACTER(LEN=256) :: LINE
 
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME                    ,STATUS='OLD'    ,ACTION='READ' ,FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME(:LEN_TRIM(FNAME)-1),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
  IF(INDEX(LINE,'NaN').GT.0)LINE=UTL_SUBST(LINE,'NaN',ITOS(NP))
  WRITE(JU,'(A)') TRIM(ADJUSTL(LINE))
 ENDDO
 
 CLOSE(IU,STATUS='DELETE'); CLOSE(JU)
 
 END SUBROUTINE PMANAGER_SAVEMF2005_MAXNO
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK(IU,ITOPIC,BND,HNOFLOW,DIR,EXT,NP,LTB,TOP,BOT,KD,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,ITOPIC,IBATCH
 INTEGER,INTENT(OUT) :: NP
 REAL,INTENT(IN) :: HNOFLOW
 CHARACTER(LEN=*),INTENT(IN) :: EXT,DIR
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(:) :: BND,TOP,BOT,KD
 LOGICAL,INTENT(IN) :: LTB
 INTEGER,DIMENSION(:),ALLOCATABLE :: IEQUAL
 INTEGER :: IPER,KPER,ISYS,K,NTOP,NSYS,SCL_D,SCL_U
 CHARACTER(LEN=512) :: LINE
 CHARACTER(LEN=256) :: EXFNAME
 REAL :: FCT,IMP,CNST
 INTEGER :: ILAY,IS1,ICNST,INEW
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:,:) :: PCK 
 
 PMANAGER_SAVEMF2005_PCK=.FALSE.
 
 NP=0 
 DO IPER=1,NPER

  !## output
  IF(IBATCH.EQ.1)WRITE(*,'(1X,A,I10)') 'Exporting timestep ',IPER
  
  !## get appropriate stress-period to store in runfile   
  KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC)
 
  !## overrule wel/isg packages per stress-period
  SELECT CASE (ITOPIC); CASE (21,29); KPER=ABS(KPER); END SELECT

  !## reuse previous timestep
  IF(KPER.LE.0)THEN
  
   SELECT CASE (ITOPIC)
    CASE (24) !## evt 
     WRITE(IU,'(A)') '-1,-1,-1'
    CASE (21,22,23,25,26,27,28,29) !## wel,drn,riv,ghb,rch,chd,olf,isg
     WRITE(IU,'(I10)') -1 
   END SELECT
  
  ELSE
  
   !## allocate memory for packages
   NTOP=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)
   INEW=0
   
   SELECT CASE (ITOPIC)
    CASE (24,26) !## evt,rch
     !## try to reuse pck() for data-efficiency
     IF(ALLOCATED(PCK))THEN
      IF(SIZE(PCK,1).NE.NTOP.OR.SIZE(PCK,2).NE.NSYS+1)THEN
       DO K=1,SIZE(PCK,1); DO ISYS=1,SIZE(PCK,2); CALL IDFDEALLOCATEX(PCK(K,ISYS)); ENDDO; ENDDO; DEALLOCATE(PCK)
      ENDIF
     ENDIF
     IF(.NOT.ALLOCATED(PCK))THEN; ALLOCATE(PCK(NTOP,0:NSYS)); INEW=1; ENDIF
     IS1=0
    CASE (21,22,23,25,27,28,29) !## wel,drn,riv,ghb,chd,olf,isg
     ALLOCATE(PCK(NTOP,NSYS)); IS1=1; INEW=1
   END SELECT

   IF(INEW.EQ.1)THEN
    DO K=1,NTOP; DO ISYS=IS1,NSYS
     CALL IDFNULLIFY(PCK(K,ISYS))
     SELECT CASE (ITOPIC)
      CASE (22:28); CALL IDFCOPY(BND(1),PCK(K,ISYS)) 
     END SELECT
    ENDDO; ENDDO
   ENDIF
   
   !## number of subtopics
   DO K=1,NTOP 
    
    SELECT CASE (ITOPIC)
     CASE (21) !## wel - nothing to do here

     CASE (24) !## evt
      SCL_D=1
      IF(K.EQ.1)SCL_U=4
      IF(K.NE.1)SCL_U=2
     CASE (26) !## rch
      SCL_D=1; SCL_U=4
     CASE (22,23,25,27) !## drn,riv,ghb,chd,olf
      IF(K.EQ.1)THEN; SCL_D=0; SCL_U=5; ENDIF
      IF(K.NE.1)THEN; SCL_D=0; SCL_U=2; ENDIF
     CASE (28)
      SCL_D=1; SCL_U=2
     CASE (29) !## isg - nothing to do here
     
     CASE DEFAULT 
      STOP 'ERROR PMANAGER_SAVEMF2005_PCK'
    END SELECT
    
    !## number of systems
    DO ISYS=1,NSYS 

     ICNST=TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%ICNST
     FCT  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%FCT
     IMP  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%IMP
     ILAY =TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%ILAY
     PCK(K,ISYS)%ILAY=ILAY

     IF(ILAY.EQ.-1.AND..NOT.LTB)THEN
!## cannot be here
     ENDIF

     IF(ICNST.EQ.1)THEN
      CNST=TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%CNST
      PCK(K,ISYS)%X=CNST
     ELSEIF(TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%ICNST.EQ.2)THEN
      PCK(K,ISYS)%FNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(K,ISYS)%FNAME
      !## read/clip/scale idf file
      SELECT CASE (ITOPIC)
       CASE (22:28)
        IF(.NOT.IDFREADSCALE(PCK(K,ISYS)%FNAME,PCK(K,ISYS),SCL_U,SCL_D,1.0,0))RETURN
      END SELECT
     ENDIF
     
     !## rch/evt mm/day -> m/day
     IF(K.EQ.1)THEN
      SELECT CASE (ITOPIC)
       CASE (24,26); FCT=FCT*0.001
      END SELECT
     ENDIF
     !## correct for boundary etc.   
     SELECT CASE (ITOPIC)
      CASE (22:27)
       CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,PCK(K,ISYS),HNOFLOW,FCT,IMP)
       CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,PCK(K,ISYS),1,ITOPIC)
      CASE (28)
       CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,PCK(K,ISYS),HNOFLOW,FCT,IMP)
     END SELECT   

    ENDDO
   ENDDO
   
   ALLOCATE(IEQUAL(NTOP))

   !## prepare for export into modflow 2005
   SELECT CASE (ITOPIC)
    CASE (21) !## wel
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    
    CASE (22) !## drn
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/2,1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    CASE (23) !## riv
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/2,1,3,4/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    CASE (24) !## evt
     CALL PMANAGER_SAVEMF2005_PCK_COLLECT(PCK,NSYS,NTOP,(/1,2,2/),HNOFLOW,IEQUAL,IPER)
     LINE=TRIM(ITOS(IEQUAL(2)))//','//TRIM(ITOS(IEQUAL(1)))//','//TRIM(ITOS(IEQUAL(3)))
     WRITE(IU,'(A)') TRIM(LINE)
     IF(IEQUAL(2).EQ.1)THEN
      EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_surf_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
      IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,PCK(2,0),IU,HNOFLOW))RETURN
     ENDIF
     IF(IEQUAL(1).EQ.1)THEN
      EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_evtr_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG) 
      IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,PCK(1,0),IU,HNOFLOW))RETURN
     ENDIF
     IF(IEQUAL(3).EQ.1)THEN
      EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_exdp_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
      IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,PCK(3,0),IU,HNOFLOW))RETURN
     ENDIF
    CASE (25) !## ghb
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/2,1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    CASE (26) !## rch
     CALL PMANAGER_SAVEMF2005_PCK_COLLECT(PCK,NSYS,NTOP,(/1/),HNOFLOW,IEQUAL,IPER)
     LINE=TRIM(ITOS(IEQUAL(1))); WRITE(IU,'(A)') TRIM(LINE)
     IF(IEQUAL(1).EQ.1)THEN
      EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_rech_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
      IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,PCK(1,0),IU,HNOFLOW))RETURN
     ENDIF
    CASE (27) !## olf
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    CASE (28) !## chd
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
    CASE (29) !## isg
     EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_t'//TRIM(ITOS(IPER))//FEXT(IIDEBUG)
     IF(.NOT.PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU,HNOFLOW,(/1/),NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC))RETURN
     
   END SELECT

   SELECT CASE (ITOPIC)
    CASE (21,22,23,25,27,28,29) !## wel,drn,riv,ghb,chd,olf,isg
     !## clean up
     DO K=1,NTOP; DO ISYS=1,NSYS; CALL IDFDEALLOCATEX(PCK(K,ISYS)); ENDDO; ENDDO; DEALLOCATE(PCK)
   END SELECT
   DEALLOCATE(IEQUAL)
   
  ENDIF
 ENDDO
 
 PMANAGER_SAVEMF2005_PCK=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_PCK

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_PCK_COLLECT(PCK,NSYS,NTOP,ISUM,HNOFLOW,IEQUAL,IPER)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NSYS,NTOP,IPER
 INTEGER,DIMENSION(NTOP) :: ISUM,IEQUAL
 REAL,INTENT(IN) :: HNOFLOW
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(NTOP,0:NSYS) :: PCK 
 INTEGER :: IROW,ICOL,ISYS,ITOP
 REAL :: MTOP
 REAL,DIMENSION(:,:,:),ALLOCATABLE :: X
 
 !## copy previous results ...
 IF(IPER.GT.1)THEN
  ALLOCATE(X(PCK(1,0)%NCOL,PCK(1,0)%NROW,NTOP))
  DO ITOP=1,NTOP; DO IROW=1,PCK(1,0)%NROW; DO ICOL=1,PCK(1,0)%NCOL
   X(ICOL,IROW,ITOP)=PCK(ITOP,0)%X(ICOL,IROW)
  ENDDO; ENDDO; ENDDO
 ENDIF
 
 DO IROW=1,PCK(1,0)%NROW; DO ICOL=1,PCK(1,0)%NCOL
  DO ITOP=1,NTOP
   MTOP=0.0; PCK(ITOP,0)%X(ICOL,IROW)=0.0
   DO ISYS=1,NSYS   
    IF(PCK(ITOP,ISYS)%X(ICOL,IROW).NE.HNOFLOW)THEN
     PCK(ITOP,0)%X(ICOL,IROW)=PCK(ITOP,0)%X(ICOL,IROW)+PCK(ITOP,ISYS)%X(ICOL,IROW)
     MTOP=MTOP+1.0
    ENDIF
   ENDDO
   IF(ISUM(ITOP).EQ.2)PCK(ITOP,0)%X(ICOL,IROW)=PCK(ITOP,0)%X(ICOL,IROW)/MTOP
  ENDDO
 ENDDO; ENDDO

 !## non equal unless proven otherwise
 IEQUAL=1

 IF(IPER.GT.1)THEN
  !## equal proven otherwise
  IEQUAL=-1
  DO ITOP=1,NTOP; IROWLOOP: DO IROW=1,PCK(1,0)%NROW; DO ICOL=1,PCK(1,0)%NCOL
   IF(X(ICOL,IROW,ITOP).NE.PCK(ITOP,0)%X(ICOL,IROW))THEN; IEQUAL(ITOP)=1; EXIT IROWLOOP; ENDIF
  ENDDO; ENDDO IROWLOOP; ENDDO
  DEALLOCATE(X)
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEMF2005_PCK_COLLECT

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK_ULSTRD(EXFNAME,PCK,NSYS,NTOP,IU, &
            HNOFLOW,JTOP,NP,BND,TOP,BOT,KD,IPER,KPER,ITOPIC)
 !###======================================================================
 USE MOD_ISG_PAR, ONLY :  XMIN,YMIN,XMAX,YMAX, & !## area to be gridded (x1,y1,x2,y2)'
                          ISS, & !## (1) mean over all periods, (2) mean over given period'
                          SDATE,EDATE, & !## startdate,enddate,ddate (yyyymmdd,yyyymmdd,dd)'
                          STIME,ETIME, & !## starttime,endtime,ddate (yyyymmddmmhhss,yyyymmddmmhhss,dd)'
                          IDIM, & !## (0) give area (2) entire domain of isg (3) selected isg'
                          CS, & !## cellsize'
                          MINDEPTH, & !## minimal waterdepth for computing conductances (m)'
                          WDEPTH, & !## waterdepth only used in combination with isimgro>0'
                          ICDIST, & !## (0) do not compute effect of weirs (1) do compute effect of weirs'
                          ISIMGRO, & !## ISIMGRO'
                          IEXPORT, & !## (0) idf (1) modflow river file
                          ROOT, &  !## resultmap'
                          POSTFIX, &  !## POSTFIX {POSTFIX}_stage.idf etc.'
                          NODATA, & !## nodatavalue in ISG
                          ISAVE, &
                          MAXWIDTH, & !#3 maximum widht for computing rivier-width (in case cross-sections are rubbish)
                          IAVERAGE, & !## (1) mean (2) median value
                          NISGFILES, &
                          ISGIU, &
                          MAXFILES
 IMPLICIT NONE
 REAL,PARAMETER :: COLF=1.0
 INTEGER,INTENT(IN) :: IU,NSYS,NTOP,IPER,KPER,ITOPIC
 INTEGER,INTENT(INOUT) :: NP
 INTEGER,INTENT(IN),DIMENSION(NTOP) :: JTOP
 CHARACTER(LEN=*),INTENT(IN) :: EXFNAME
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(NTOP,NSYS) :: PCK
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(:) :: BND,TOP,BOT,KD
 REAL,INTENT(IN) :: HNOFLOW
 REAL :: X,Y,Q,Z1,Z2,FCT,IMP,OLFCOND
 CHARACTER(LEN=256) :: SFNAME,LINE,ID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=30) :: FRM
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: STRING
 INTEGER :: JU,KU,ILAY,IROW,ICOL,I,J,ITOP,ISYS,NROWIPF,NCOLIPF,IEXT,MP,IOS,IBATCH
 LOGICAL :: LIPF,LISG,LEX
 REAL,ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
 INTEGER(KIND=8) :: ITIME,JTIME
 REAL,PARAMETER :: MINKH=0.0
 INTEGER,PARAMETER :: ICLAY=1 !## shift to nearest aquifer
  
 PMANAGER_SAVEMF2005_PCK_ULSTRD=.FALSE.

 CALL UTL_CREATEDIR(EXFNAME(:INDEX(EXFNAME,'\',.TRUE.)-1))
 
 LIPF=.FALSE.; LISG=.FALSE.
 !## wel
 IF(ITOPIC.EQ.21)LIPF=.TRUE.
 !## isg
 IF(ITOPIC.EQ.29)LISG=.TRUE.
  
 !## fill tlp for each modellayer
 ALLOCATE(TLP(NLAY),KH(NLAY),TP(NLAY),BT(NLAY))
 
 !## start- and enddate of simulation period
 IF(SIM(IPER)%DELT.EQ.0.0)THEN
  ITIME=INT(0,8); JTIME=INT(0,8) !## mean value
 ELSE
  ITIME=SIM(IPER  )%IYR*10000000000+SIM(IPER  )%IMH*100000000+SIM(IPER  )%IDY*1000000+SIM(IPER  )%IHR*10000+SIM(IPER  )%IMT*100+SIM(IPER  )%ISC
  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

  !## ISG not yet supports timescales less than 1 day
  SDATE=SIM(IPER)%IYR*10000+SIM(IPER)%IMH*100+SIM(IPER)%IDY
  SDATE=UTL_IDATETOJDATE(SDATE)
  EDATE=SDATE+MAX(1,INT(SIM(IPER)%DELT))
 ENDIF
 
 IF(LISG)THEN
  XMIN=BND(1)%XMIN; YMIN=BND(1)%YMIN
  XMAX=BND(1)%XMAX; YMAX=BND(1)%YMAX
  ISS=2; IF(SDATE.EQ.0.AND.EDATE.EQ.0)ISS=1
  IDIM=0
  CS=BND(1)%DX !## cellsize
  MINDEPTH=0.1
  WDEPTH=0.0
  ICDIST=1     !## compute influence of structures
  ISIMGRO=0    !## no simgro
  IEXPORT=1    !## modflow river files
  ROOT=EXFNAME(1:INDEX(EXFNAME,'\',.TRUE.)-1)  !## output folder
  POSTFIX=''
  NODATA=-999.99
  ISAVE=1
  MAXWIDTH=1000.0
  IAVERAGE=1
  IBATCH=0
 ENDIF
 
 IF(TRIM(EXFNAME(INDEX(EXFNAME,'.',.TRUE.)+1:)).EQ.'ASC')THEN

  DO ISYS=1,NSYS
   DO ITOP=1,NTOP
    SFNAME=UTL_SUBST(EXFNAME,'.ASC',TRIM(ITOS(ISYS))//'_'//TRIM(ITOS(ITOP))//'.ASC')
    JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=SFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN

    WRITE(JU,'(A14,I10)')   'NCOLS'       ,PCK(ITOP,ISYS)%NCOL
    WRITE(JU,'(A14,I10)')   'NROWS'       ,PCK(ITOP,ISYS)%NROW
    WRITE(JU,'(A14,F15.7)') 'XLLCORNER'   ,PCK(ITOP,ISYS)%XMIN
    WRITE(JU,'(A14,F15.7)') 'YLLCORNER'   ,PCK(ITOP,ISYS)%YMIN
    WRITE(JU,'(A14,F15.7)') 'CELLSIZE'    ,PCK(ITOP,ISYS)%DX
    WRITE(JU,'(A14,F15.7)') 'NODATA_VALUE',PCK(ITOP,ISYS)%NODATA
    DO IROW=1,PCK(ITOP,ISYS)%NROW; WRITE(JU,*) (PCK(ITOP,ISYS)%X(ICOL,IROW),ICOL=1,PCK(ITOP,ISYS)%NCOL); ENDDO
    CLOSE(JU)
   ENDDO
  ENDDO
  
 ELSE

  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
  MP=0

  DO ISYS=1,NSYS
   
   FCT   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FCT
   IMP   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%IMP
   SFNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FNAME
   
   !## open isg file
   IF(LISG)THEN

    !## deallocate memory
    CALL ISGDEAL()
    NISGFILES=1; IF(ALLOCATED(ISGIU))DEALLOCATE(ISGIU); ALLOCATE(ISGIU(MAXFILES,NISGFILES))
    CALL UTL_GETUNITSISG(ISGIU(:,1),SFNAME,'OLD')
    IF(MINVAL(ISGIU(:,1)).LE.0)EXIT
    !## read complete ISG file
    CALL ISGREAD()

    !## export isg to riv package
    ILAY=PCK(1,ISYS)%ILAY
    !## translate again to idate as it will be convered to jdate in next subroutine
    SDATE=UTL_JDATETOIDATE(SDATE); EDATE=UTL_JDATETOIDATE(EDATE)-1  !<- edate is equal to sdate if one day is meant
    IF(.NOT.ISG2GRID(POSTFIX,BND(1)%NROW,BND(1)%NCOL,NLAY,ILAY,TOP,BOT,IBATCH,MP,JU))EXIT
    
   !## open ipf file
   ELSEIF(LIPF)THEN

    ALLOCATE(STRING(5))
    WRITE(FRM,'(A9,I2.2,A14)') '(3(I5,1X),',1,'(F15.7,1X),I5)'

    CDIR=PCK(1,ISYS)%FNAME(:INDEX(PCK(1,ISYS)%FNAME,'\',.TRUE.)-1)
    KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,PCK(1,ISYS)%FNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)RETURN
    READ(KU,*) NROWIPF; READ(KU,*) NCOLIPF
    DO I=1,NCOLIPF; READ(KU,*); ENDDO; READ(KU,*) IEXT,EXT
    DO I=1,NROWIPF

     ILAY=PCK(1,ISYS)%ILAY
     !## assign to several layer
     IF(ILAY.EQ.0)THEN
      READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,5)
      IF(IOS.EQ.0)THEN
       READ(STRING(1),*,IOSTAT=IOS) X
       READ(STRING(2),*,IOSTAT=IOS) Y
      ENDIF

      !## get correct cell-indices
      CALL IDFIROWICOL(BND(1),IROW,ICOL,X,Y)
      !## outside current model
      IF(IROW.EQ.0.OR.ICOL.EQ.0)CYCLE
      
      IF(IEXT.EQ.0)READ(STRING(3),*,IOSTAT=IOS) Q
      IF(IEXT.EQ.3)READ(STRING(3),*,IOSTAT=IOS) ID
      READ(STRING(4),*,IOSTAT=IOS) Z1
      READ(STRING(5),*,IOSTAT=IOS) Z2

      !## get filter fractions
      DO ILAY=1,NLAY; TP(ILAY)=TOP(ILAY)%X(ICOL,IROW); ENDDO
      DO ILAY=1,NLAY; BT(ILAY)=BOT(ILAY)%X(ICOL,IROW); ENDDO
      DO ILAY=1,NLAY; KH(ILAY)=KD (ILAY)%X(ICOL,IROW); ENDDO  
      DO ILAY=1,NLAY; KH(ILAY)=KH(ILAY)/(TP(ILAY)-BT(ILAY)); ENDDO
      CALL UTL_PCK_GETTLP(NLAY,TLP,KH,TP,BT,Z1,Z2,MINKH,ICLAY) 

      DO ILAY=1,NLAY; IF(BND(ILAY)%X(ICOL,IROW).LE.0)TLP(ILAY)=0; ENDDO

     !## find uppermost layer
     ELSE

      READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,3)
      IF(IOS.EQ.0)THEN
       READ(STRING(1),*,IOSTAT=IOS) X
       READ(STRING(2),*,IOSTAT=IOS) Y
      ENDIF

      !## get correct cell-indices
      CALL IDFIROWICOL(BND(1),IROW,ICOL,X,Y)
      !## outside current model
      IF(IROW.EQ.0.OR.ICOL.EQ.0)CYCLE

      IF(IEXT.EQ.0)READ(STRING(3),*,IOSTAT=IOS) Q
      IF(IEXT.EQ.3)READ(STRING(3),*,IOSTAT=IOS) ID

      IF(ILAY.EQ.-1)THEN; DO ILAY=1,NLAY; IF(BND(ILAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO; ENDIF
      !## outside current model dimensions, set ilay=0
      IF(ILAY.GT.NLAY)ILAY=0; TLP=0.0; IF(ILAY.NE.0)TLP(ILAY)=1.0

     ENDIF
     IF(IOS.NE.0)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading IPF file'//CHAR(13)//TRIM(PCK(1,ISYS)%FNAME)//CHAR(13)// &
         'Linenumber '//TRIM(ITOS(I)),'Error')
      CLOSE(JU); CLOSE(KU); RETURN
     ENDIF     
     
     IF(IEXT.GT.0)THEN
      IF(.NOT.UTL_PCK_READTXT(2,ITIME,JTIME,Q,TRIM(CDIR)//'\'//TRIM(ID)//'.'//TRIM(EXT)))THEN
       CLOSE(JU); CLOSE(KU); RETURN
      ENDIF
     ENDIF
         
     !## use factor/impulse
     Q=Q*FCT  !## use factor
     Q=Q+IMP  !## use impulse     

     IF(Q.NE.0.0)THEN
      DO ILAY=1,NLAY
       IF(TLP(ILAY).GT.0.0)THEN
        WRITE(JU,FRM) ILAY,IROW,ICOL,Q*TLP(ILAY),ISYS
        MP=MP+1
       ENDIF
      ENDDO
     ENDIF
     
    ENDDO
    DEALLOCATE(STRING); CLOSE(KU)
    
   ELSE 

    TLP=0.0; IF(PCK(1,ISYS)%ILAY.NE.0)TLP(PCK(1,ISYS)%ILAY)=1.0

    !## chd/olf
    IF(ITOPIC.EQ.28.OR.ITOPIC.EQ.27)THEN
     WRITE(FRM,'(A10,I2.2,A14)') '(3(I5,1X),',NTOP+1,'(F15.7,1X),I5)'
    ELSE
     WRITE(FRM,'(A10,I2.2,A14)') '(3(I5,1X),',NTOP,'(F15.7,1X),I5)'
    ENDIF
    DO IROW=1,PCK(1,1)%NROW; DO ICOL=1,PCK(1,1)%NCOL
     DO ITOP=1,NTOP; IF(PCK(JTOP(ITOP),ISYS)%X(ICOL,IROW).EQ.HNOFLOW)EXIT; ENDDO
     IF(ITOP.LE.NTOP)CYCLE
     
     !## assign to several layer
     IF(PCK(1,ISYS)%ILAY.EQ.0)THEN
      !## get filter fractions
      DO ILAY=1,NLAY; TP(ILAY)=TOP(ILAY)%X(ICOL,IROW); ENDDO
      DO ILAY=1,NLAY; BT(ILAY)=BOT(ILAY)%X(ICOL,IROW); ENDDO
      DO ILAY=1,NLAY; KH(ILAY)=KD (ILAY)%X(ICOL,IROW); ENDDO  
      DO ILAY=1,NLAY; KH(ILAY)=KH(ILAY)/(TP(ILAY)-BT(ILAY)); ENDDO
      SELECT CASE (ITOPIC)
       CASE (22) !## drn
        Z1=PCK(2,ISYS)%X(ICOL,IROW); Z2=Z1
       CASE (23) !## riv
        Z1=PCK(2,ISYS)%X(ICOL,IROW); Z2=PCK(3,ISYS)%X(ICOL,IROW)
       CASE (27) !## olf
        Z1=PCK(2,ISYS)%X(ICOL,IROW); Z2=Z1
       CASE DEFAULT
        STOP 'not yet defined!'
      END SELECT
      CALL UTL_PCK_GETTLP(NLAY,TLP,KH,TP,BT,Z1,Z2,MINKH,ICLAY) 
      DO ILAY=1,NLAY; IF(BND(ILAY)%X(ICOL,IROW).LE.0)TLP(ILAY)=0; ENDDO

     !## find uppermost layer
     ELSE
      IF(PCK(1,ISYS)%ILAY.EQ.-1)THEN
       DO ILAY=1,NLAY; IF(BND(ILAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO
       !## outside current model dimensions, set ilay=0
       IF(ILAY.GT.NLAY)ILAY=0;
      ENDIF
! TLP=0.0; IF(ILAY.NE.0)TLP(ILAY)=1.0
     ENDIF
     
!     !## single entry eq nodata, skip it
!     LEX=.TRUE.; DO ITOP=1,NTOP      
!      IF(PCK(ITOP,ISYS)%X(ICOL,IROW).EQ.PCK(ITOP,ISYS)%NODATA)THEN; LEX=.FALSE.; EXIT; ENDIF
!     ENDDO
!     IF(.NOT.LEX)CYCLE

     !## correct rivers whenever bottom is higher than stage
     IF(ITOPIC.EQ.23)PCK(3,ISYS)%X(ICOL,IROW)=MIN(PCK(2,ISYS)%X(ICOL,IROW),PCK(3,ISYS)%X(ICOL,IROW))

     IF(PCK(1,ISYS)%ILAY.GT.0)THEN
      !## chd - specify head twice
      IF(ITOPIC.EQ.28)THEN
       IF(BND(PCK(1,ISYS)%ILAY)%X(ICOL,IROW).LT.0)THEN
        WRITE(JU,FRM) PCK(1,ISYS)%ILAY,IROW,ICOL,PCK(JTOP(1),ISYS)%X(ICOL,IROW),PCK(JTOP(1),ISYS)%X(ICOL,IROW),ISYS
        MP=MP+1
       ENDIF
      !## olf
      ELSEIF(ITOPIC.EQ.27)THEN
       OLFCOND=(IDFGETAREA(PCK(JTOP(1),ISYS),ICOL,IROW)/COLF)   !## drainage conductance
       WRITE(JU,FRM) PCK(1,ISYS)%ILAY,IROW,ICOL,PCK(JTOP(1),ISYS)%X(ICOL,IROW),OLFCOND,ISYS
       MP=MP+1
      ELSE
       WRITE(JU,FRM) PCK(1,ISYS)%ILAY,IROW,ICOL,(PCK(JTOP(ITOP),ISYS)%X(ICOL,IROW),ITOP=1,NTOP),ISYS
       MP=MP+1
      ENDIF
     ELSE
      DO ILAY=1,NLAY
       !## not put into model layer
       IF(TLP(ILAY).LE.0.0)CYCLE
       !## chd - specify head twice
       IF(ITOPIC.EQ.28)THEN
        IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
         WRITE(JU,FRM) PCK(1,ISYS)%ILAY,IROW,ICOL,PCK(JTOP(1),ISYS)%X(ICOL,IROW),PCK(JTOP(1),ISYS)%X(ICOL,IROW),ISYS
         MP=MP+1
        ENDIF
       !## olf
       ELSEIF(ITOPIC.EQ.27)THEN
        OLFCOND=(IDFGETAREA(PCK(JTOP(1),ISYS),ICOL,IROW)/COLF)   !## drainage conductance
        WRITE(JU,FRM) PCK(JTOP(1),ISYS)%ILAY,IROW,ICOL,PCK(JTOP(1),ISYS)%X(ICOL,IROW),OLFCOND,ISYS
        MP=MP+1
       ELSE
        WRITE(JU,FRM) PCK(JTOP(1),ISYS)%ILAY,IROW,ICOL,(PCK(JTOP(ITOP),ISYS)%X(ICOL,IROW),ITOP=1,NTOP),ISYS
        MP=MP+1
       ENDIF
      ENDDO 
     ENDIF

    ENDDO; ENDDO
   ENDIF
  
  ENDDO
 
 ENDIF

 CLOSE(JU)

 DEALLOCATE(TLP,TP,BT,KH)
 LINE=TRIM(ITOS(MP)); WRITE(IU,*) TRIM(LINE)

 !## storage of maximum number of package elements
 NP=MAX(NP,MP)
 
 IF(MP.GT.0)THEN
  SFNAME=EXFNAME; DO I=1,3; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
  I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
  WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
 ENDIF
 
 PMANAGER_SAVEMF2005_PCK_ULSTRD=.TRUE.
 !## something went wrong
 IF(ISYS.LE.NSYS)PMANAGER_SAVEMF2005_PCK_ULSTRD=.FALSE.
   
 END FUNCTION PMANAGER_SAVEMF2005_PCK_ULSTRD

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,IDF,IU,HNOFLOW)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: EXFNAME
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 REAL,INTENT(IN) :: HNOFLOW
 CHARACTER(LEN=256) :: SFNAME
 INTEGER,INTENT(IN) :: IU
 INTEGER :: JU,IROW,ICOL,I
 REAL :: MINV,MAXV
 
 PMANAGER_SAVEMF2005_PCK_U2DREL=.FALSE.

 MINV=10.0E10; MAXV=-10.0E10
 DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
  IF(IDF%X(ICOL,IROW).NE.HNOFLOW)THEN 
   MINV=MIN(MINV,IDF%X(ICOL,IROW))
   MAXV=MAX(MAXV,IDF%X(ICOL,IROW))
  ENDIF
 ENDDO; ENDDO
 
 !## constant value
 IF(MAXV.EQ.MINV)THEN

  WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(MAXV,'E',7))

 ELSE
  
  CALL UTL_CREATEDIR(EXFNAME(:INDEX(EXFNAME,'\',.TRUE.)-1))
  SFNAME=EXFNAME; DO I=1,3; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
  I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
 
  WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
 
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN

  IF(TRIM(EXFNAME(INDEX(EXFNAME,'.',.TRUE.)+1:)).EQ.'ASC')THEN
   WRITE(JU,'(A14,I10)')   'NCOLS'       ,IDF%NCOL
   WRITE(JU,'(A14,I10)')   'NROWS'       ,IDF%NROW
   WRITE(JU,'(A14,F15.7)') 'XLLCORNER'   ,IDF%XMIN
   WRITE(JU,'(A14,F15.7)') 'YLLCORNER'   ,IDF%YMIN
   WRITE(JU,'(A14,F15.7)') 'CELLSIZE'    ,IDF%DX
   WRITE(JU,'(A14,F15.7)') 'NODATA_VALUE',IDF%NODATA
  ENDIF

  DO IROW=1,IDF%NROW; WRITE(JU,*) (IDF%X(ICOL,IROW),ICOL=1,IDF%NCOL); ENDDO

  CLOSE(JU)

 ENDIF
 
 PMANAGER_SAVEMF2005_PCK_U2DREL=.TRUE.
   
 END FUNCTION PMANAGER_SAVEMF2005_PCK_U2DREL
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_HFB(IDF,ITOPIC,IU,IUGEN,TOP,BOT,BND,KD) 
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITOPIC,IU
 INTEGER,INTENT(IN),DIMENSION(:) :: IUGEN
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 TYPE(IDFOBJ),DIMENSION(NLAY),INTENT(INOUT) :: TOP,BOT,BND,KD
 REAL :: FCT,IMP
 INTEGER :: ILAY,JLAY,ISYS,IWRITE,MXFB,NPHFB
 INTEGER(KIND=1),ALLOCATABLE,DIMENSION(:,:,:) :: IPC
 INTEGER,ALLOCATABLE,DIMENSION(:) :: NHFBNP
 TYPE(IDFOBJ) :: TIDF,BIDF
 
 PMANAGER_SAVEMF2005_HFB=.TRUE.
 
 CALL ASC2IDF_INT_NULLIFY(); ALLOCATE(XP(100),YP(100),ZP(100),FP(100),WP(100))

 !## is the number of horizontal-flow barrier parameters
 NPHFB=0 
 !## is the number of HFB barriers not defined by parameters
 MXFB=0
 
 !## compute block-faces
 ALLOCATE(IPC(IDF%NCOL,IDF%NROW,2),NHFBNP(NLAY)); NHFBNP=0
 CALL IDFNULLIFY(TIDF); CALL IDFNULLIFY(BIDF)
 CALL IDFCOPY(IDF,TIDF); CALL IDFCOPY(IDF,BIDF) 

 !## two cycles, first to determine number of boundaries, second to write them
 DO IWRITE=0,1

  !## MXFB—is the maximum number of HFB barriers that will be defined using parameters.
  IF(IWRITE.EQ.1)WRITE(IU,'(3I10,A)') NPHFB,MXFB,SUM(NHFBNP),' NOPRINT' !to be included yet HFBFCT/HFBRESIS !!!
  
!      if(dis%settop .and. dis%setbot) then
!         n = n + 1
!         write(str(n),*) 'hfbresis'
!      else
!         n = n + 1
!         write(str(n),*) 'hfbfact'
!      end if
  
  
  !## process per system
  DO ISYS=1,SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
   IPC=INT(0,1)
   
   ILAY     =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ILAY
   FCT      =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FCT
   IMP      =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%IMP
   IDF%FNAME=TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FNAME

   IF(LEN_TRIM(IDF%FNAME).GT.0)THEN
    CALL ASC2IDF_HFB(IDF,IDF%NROW,IDF%NCOL,IPC,IDF%FNAME,ILAY,TIDF,BIDF)
    CALL PMANAGER_SAVEMF2005_HFBEXPORT(IPC,IDF%NROW,IDF%NCOL,FCT+IMP,NHFBNP,IWRITE,IU,IUGEN,IDF,TOP,BOT,BND,KD,ILAY,TIDF,BIDF)
   ENDIF
   
  ENDDO
 ENDDO

! !## read/clip/scale idf file
! PMANAGER_SAVEMF2005_HFB=IDFREADSCALE(IDF%FNAME,IDF,SCL_U,SCL_D,1.0,0)
! IF(PMANAGER_SAVEMF2005_HFB)CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,IDF,HNOFLOW,FCT,IMP)

 CALL ASC2IDF_INT_DEALLOCATE() 
 DEALLOCATE(IPC); CALL IDFDEALLOCATEX(TIDF); CALL IDFDEALLOCATEX(BIDF) 
 
 END FUNCTION PMANAGER_SAVEMF2005_HFB
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_HFBEXPORT(IPC,NROW,NCOL,HFBFCT,NHFB,IWRITE,IU,IUGEN,IDF,TOP,BOT,BND,KD,ITB,TIDF,BIDF) 
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NROW,NCOL,IWRITE,IU,ITB
 INTEGER,INTENT(IN),DIMENSION(:) :: IUGEN
 INTEGER,INTENT(INOUT),DIMENSION(:) :: NHFB
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF,TIDF,BIDF
 TYPE(IDFOBJ),DIMENSION(NLAY),INTENT(INOUT) :: TOP,BOT,BND,KD
 REAL,INTENT(IN) :: HFBFCT
 INTEGER(KIND=1),INTENT(IN),DIMENSION(NCOL,NROW,2) :: IPC
 INTEGER :: IROW,ICOL,I,IL1,IL2,ILAY
 REAL :: FCT,DZ,DX,DY,C,T1,T2,CR,NODATA
 
 NODATA=HUGE(1.0)
 
 DO IROW=1,NROW; DO ICOL=1,NCOL

  !## place vertical wall
  IF(IPC(ICOL,IROW,1).EQ.INT(1,1))THEN
   IF(ICOL.LT.NCOL)THEN

    !## determine what layer(s)
    IF(ITB.EQ.0)THEN
     IL1=1; IL2=NLAY
    ELSE
     IL1=ITB; IL2=IL1
    ENDIF

    !## x-direction
    DO ILAY=IL1,IL2
 
     FCT=HFBFCT

     IF(ITB.EQ.0)THEN
      FCT=PMANAGER_SAVEMF2005_HFBGETFACTOR(TOP,BOT,HFBFCT,TIDF%X,BIDF%X,ICOL,IROW,ICOL+1,IROW,NODATA,ILAY) 
      !## take the next no fault on this modellayer
      IF(FCT.EQ.0.0)CYCLE
     ENDIF
 
     IF(IWRITE.EQ.1)CALL PMANAGER_SAVEMF2005_HFBGENFILES(IUGEN(ILAY),IPC,IDF,NROW,NCOL,IROW,ICOL,ILAY)

     !## reconstruct to a factor to be multiplied with the conductance, input is a resistance
     T1=KD(ILAY)%X(ICOL,IROW); T2=KD(ILAY)%X(ICOL+1,IROW)
     IF(T1.GT.0.0.AND.T2.GT.0.0)THEN

      CR=2.0*T2*T1*(IDF%SY(IROW-1)-IDF%SY(IROW))/(T1*(IDF%SX(ICOL+1)-IDF%SX(ICOL))+T2*(IDF%SX(ICOL)-IDF%SX(ICOL-1)))
      DX=(IDF%SX(ICOL+1)-IDF%SX(ICOL-1))/2.0
      DY= IDF%SY(IROW-1)-IDF%SY(IROW)
      DZ= 0.5*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW))+0.5*(TOP(ILAY)%X(ICOL+1,IROW)-BOT(ILAY)%X(ICOL+1,IROW))
      IF(DZ.GT.0.0)THEN
       C = DX*(CR/(DY*DZ))
       FCT=C/HFBFCT
       !## not to become less than original
       FCT=MIN(1.0,FCT)
      ELSE
       FCT=0.0
      ENDIF
     ELSE
      FCT=0.0 
     ENDIF
     IF(FCT.NE.0.0)THEN
      NHFB(ILAY)=NHFB(ILAY)+1
      IF(IWRITE.EQ.1)WRITE(IU,'(5(I10,1X),G10.4)') ILAY,IROW,ICOL,IROW,ICOL+1,FCT !## x-direction
     ENDIF
    ENDDO
    
   ENDIF
  ENDIF

  !## place horizontal wall
  IF(IPC(ICOL,IROW,2).EQ.INT(1,1))THEN
   IF(IROW.LT.NROW)THEN
   
    !## determine what layer(s)
    IF(ITB.EQ.0)THEN
     IL1=1; IL2=NLAY 
    ELSE
     IL1=ITB; IL2=IL1
    ENDIF

    !## y-direction 
    DO ILAY=IL1,IL2

     FCT=HFBFCT

     IF(ITB.EQ.0)THEN
      FCT=PMANAGER_SAVEMF2005_HFBGETFACTOR(TOP,BOT,HFBFCT,TIDF%X,BIDF%X,ICOL,IROW,ICOL,IROW+1,NODATA,ILAY) 
      !## take the next no fault on this modellayer
      IF(FCT.EQ.0.0)CYCLE
     ENDIF
   
     !## write line in genfile
     IF(IWRITE.EQ.1)CALL PMANAGER_SAVEMF2005_HFBGENFILES(IUGEN(ILAY),IPC,IDF,NROW,NCOL,IROW,ICOL,ILAY) 

     T1=KD(ILAY)%X(ICOL,IROW); T2=KD(ILAY)%X(ICOL,IROW+1)
     IF(T1.GT.0.0.AND.T2.GT.0.0)THEN
      CR=2.0*T2*T1*(IDF%SY(ICOL)-IDF%SY(ICOL-1))/(T1*(IDF%SY(IROW)-IDF%SY(IROW+1))+T2*(IDF%SY(IROW-1)-IDF%SY(IROW)))
      DX= IDF%SY(ICOL)-IDF%SY(ICOL-1)
      DY=(IDF%SY(IROW-1)-IDF%SY(IROW+1))/2.0
      DZ= 0.5*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW))+0.5*(TOP(ILAY)%X(ICOL,IROW+1)-BOT(ILAY)%X(ICOL,IROW+1))
      IF(DZ.GT.0.0)THEN
       C = DY*(CR/(DX*DZ))
       FCT=C/HFBFCT
       !## not to become less than original
       FCT=MIN(1.0,FCT)
      ELSE
       FCT=0.0
      ENDIF
     ELSE
      FCT=0.0 
     ENDIF
     IF(FCT.NE.0.0)THEN
      NHFB(ILAY)=NHFB(ILAY)+1
      IF(IWRITE.EQ.1)WRITE(IU,'(5(I10,1X),G10.4)') ILAY,IROW,ICOL,IROW,ICOL+1,FCT !## y-direction
     ENDIF
    ENDDO
   ENDIF
  ENDIF
 
 ENDDO; ENDDO

 END SUBROUTINE PMANAGER_SAVEMF2005_HFBEXPORT
 
 !###====================================================================
 REAL FUNCTION PMANAGER_SAVEMF2005_HFBGETFACTOR(TOP,BOT,FCT,TF,BF,IC1,IR1,IC2,IR2,NODATA,ILAY)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),DIMENSION(NLAY),INTENT(INOUT) :: TOP,BOT
 REAL,INTENT(IN) :: FCT,NODATA
 REAL,INTENT(IN),DIMENSION(:,:) :: TF,BF
 INTEGER,INTENT(IN) :: IC1,IR1,IC2,IR2,ILAY
 REAL :: DZ,TFV,BFV,TPV,BTV,FFCT

 PMANAGER_SAVEMF2005_HFBGETFACTOR=0.0

 !## determine values
 IF(TF(IC1,IR1).NE.NODATA.AND.TF(IC2,IR2).NE.NODATA)THEN
  TFV=(TF(IC1,IR1)+TF(IC2,IR2))/2.0
 ELSEIF(TF(IC1,IR1).NE.NODATA)THEN
  TFV=TF(IC1,IR1)
 ELSE
  TFV=TF(IC2,IR2)
 ENDIF
 IF(BF(IC1,IR1).NE.NODATA.AND.BF(IC2,IR2).NE.NODATA)THEN
  BFV=(BF(IC1,IR1)+BF(IC2,IR2))/2.0
 ELSEIF(BF(IC1,IR1).NE.NODATA)THEN
  BFV=BF(IC1,IR1)
 ELSE
  BFV=BF(IC2,IR2)
 ENDIF

 TPV=(TOP(ILAY)%X(IC1,IR1)+TOP(ILAY)%X(IC2,IR2))/2.0
 BTV=(BOT(ILAY)%X(IC1,IR1)+BOT(ILAY)%X(IC2,IR2))/2.0

 !## nett appearance of fault in modellayer
 DZ=MIN(TFV,TPV)-MAX(BFV,BTV)
 !## not in current modellayer
 IF(DZ.LE.0.0)RETURN
 !## fraction of fault in modellayer
 DZ=DZ/(TPV-BTV)
 !## resistance of fault
 FFCT=FCT; IF(FCT.EQ.0.0)FFCT=10.0E10
 !## factor declines quadratically with layer occupation
 PMANAGER_SAVEMF2005_HFBGETFACTOR=FFCT*DZ**4.0

 END FUNCTION PMANAGER_SAVEMF2005_HFBGETFACTOR

 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_HFBGENFILES(IU,IPC,IDF,NROW,NCOL,IROW,ICOL,ILAY) 
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 INTEGER,INTENT(IN) :: NROW,NCOL,IROW,ICOL,ILAY,IU
 INTEGER(KIND=1),INTENT(IN),DIMENSION(NCOL,NROW,2) :: IPC 

 !## place vertical wall
 IF(IPC(ICOL,IROW,1).EQ.INT(1,1).AND.ICOL.LT.NCOL)THEN
  WRITE(IU,'(I10)') 1 
  WRITE(IU,'(2(F10.2,A1))') IDF%SX(ICOL),',',IDF%SY(IROW-1)
  WRITE(IU,'(2(F10.2,A1))') IDF%SX(ICOL),',',IDF%SY(IROW)
  WRITE(IU,'(A)') 'END'
 ENDIF
 !## place horizontal wall
 IF(IPC(ICOL,IROW,2).EQ.INT(1,1).AND.IROW.LT.NROW)THEN
  WRITE(IU,'(I10)') 1 
  WRITE(IU,'(2(F10.2,A1))') IDF%SX(ICOL-1),',',IDF%SY(IROW)
  WRITE(IU,'(2(F10.2,A1))') IDF%SX(ICOL  ),',',IDF%SY(IROW)
  WRITE(IU,'(A)') 'END'
 ENDIF

 END SUBROUTINE PMANAGER_SAVEMF2005_HFBGENFILES
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MOD(IDF,ITOPIC,IPER,ISYS,ILAY,SCL_D,SCL_U,HNOFLOW,IINV) 
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITOPIC,IPER,ISYS,ILAY,SCL_D,SCL_U,IINV
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 REAL,INTENT(IN) :: HNOFLOW
 INTEGER :: ICNST,IOPT
 REAL :: FCT,IMP
 
 PMANAGER_SAVEMF2005_MOD=.TRUE.

 IOPT=0
 
 !## no associated --- use default for kva
 IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
  SELECT CASE (ITOPIC)
   !## optional, use default values
   CASE (8); FCT=1.0; IMP=0.0; ICNST=1; IOPT=1
  END SELECT
 ELSE
  FCT  =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%FCT
  IMP  =TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%IMP
  ICNST=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%ICNST
 ENDIF
 
 IF(ICNST.EQ.1)THEN
  IF(IOPT.EQ.0)THEN
   IDF%X=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%CNST
  ELSE
   IDF%X=FCT
  ENDIF
 ELSEIF(ICNST.EQ.2)THEN
  IDF%FNAME=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%FNAME
  !## read/clip/scale idf file
  PMANAGER_SAVEMF2005_MOD=IDFREADSCALE(IDF%FNAME,IDF,SCL_U,SCL_D,1.0,0)
 ENDIF
 IF(PMANAGER_SAVEMF2005_MOD)CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,IDF,HNOFLOW,FCT,IMP)

 END FUNCTION PMANAGER_SAVEMF2005_MOD
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,IDF,IINT,IU,HNOFLOW)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: EXFNAME
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 REAL,INTENT(IN) :: HNOFLOW 
 CHARACTER(LEN=256) :: SFNAME,LINE
 INTEGER,INTENT(IN) :: IINT,IU
 INTEGER :: JU,IROW,ICOL,I
 REAL :: MINV,MAXV
 
 PMANAGER_SAVEMF2005_MOD_U2DREL=.FALSE.

 MINV=10.0E10; MAXV=-10.0E10
 DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
  IF(IDF%X(ICOL,IROW).NE.HNOFLOW)THEN 
   MINV=MIN(MINV,IDF%X(ICOL,IROW))
   MAXV=MAX(MAXV,IDF%X(ICOL,IROW))
  ENDIF
 ENDDO; ENDDO
 
 !## constant value
 IF(MAXV.EQ.MINV)THEN
  
  IF(IINT.EQ.0)WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(MAXV,'E',7))
  LINE='CONSTANT '//TRIM(ITOS(INT(MAXV)))
  IF(IINT.EQ.1)WRITE(IU,'(A)') TRIM(LINE)
  
 ELSE
 
  CALL UTL_CREATEDIR(EXFNAME(:INDEX(EXFNAME,'\',.TRUE.)-1))
  SFNAME=EXFNAME; DO I=1,3; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
  I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
 
  IF(IINT.EQ.0)WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
  IF(IINT.EQ.1)WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1   (FREE) -1'
 
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN

  IF(TRIM(EXFNAME(INDEX(EXFNAME,'.',.TRUE.)+1:)).EQ.'ASC')THEN
   WRITE(JU,'(A14,I10)')   'NCOLS'       ,IDF%NCOL
   WRITE(JU,'(A14,I10)')   'NROWS'       ,IDF%NROW
   WRITE(JU,'(A14,F15.7)') 'XLLCORNER'   ,IDF%XMIN
   WRITE(JU,'(A14,F15.7)') 'YLLCORNER'   ,IDF%YMIN
   WRITE(JU,'(A14,F15.7)') 'CELLSIZE'    ,IDF%DX
   WRITE(JU,'(A14,F15.7)') 'NODATA_VALUE',IDF%NODATA
  ENDIF
  
  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)
 
 ENDIF
 
 PMANAGER_SAVEMF2005_MOD_U2DREL=.TRUE.
   
 END FUNCTION PMANAGER_SAVEMF2005_MOD_U2DREL
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,IDF,HNOFLOW,FCT,IMP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IINV,ICNST
 REAL,INTENT(IN) :: HNOFLOW,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
   IDF%X(ICOL,IROW)=HNOFLOW
  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.0.AND.IDF%X(ICOL,IROW).NE.HNOFLOW)IDF%X(ICOL,IROW)=1.0/IDF%X(ICOL,IROW) 
  ENDIF
 ENDDO; ENDDO
 
 IDF%NODATA=HNOFLOW
 
 END SUBROUTINE PMANAGER_SAVEMF2005_FCTIMP

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_BND(BND,HNOFLOW)
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(INOUT) :: BND
 REAL,INTENT(IN) :: HNOFLOW
 INTEGER :: IROW,ICOL
 
 !## if bound equal to hnoflow, turn inactive, before correcting due to submodel potential
 DO IROW=1,BND%NROW
  DO ICOL=1,BND%NCOL
   IF(BND%X(ICOL,IROW).EQ.HNOFLOW)BND%X(ICOL,IROW)=0
  ENDDO
 ENDDO
 
 !## replace ibound for boundaries
 DO IROW=1,BND%NROW
  IF(IFULL(1).EQ.1)THEN; ICOL=1;        IF(BND%X(ICOL,IROW).GT.0)BND%X(ICOL,IROW)=-1; ENDIF
  IF(IFULL(3).EQ.1)THEN; ICOL=BND%NCOL; IF(BND%X(ICOL,IROW).GT.0)BND%X(ICOL,IROW)=-1; ENDIF
 ENDDO
 DO ICOL=1,BND%NCOL
  IF(IFULL(4).EQ.1)THEN; IROW=1;        IF(BND%X(ICOL,IROW).GT.0)BND%X(ICOL,IROW)=-1; ENDIF
  IF(IFULL(2).EQ.1)THEN; IROW=BND%NROW; IF(BND%X(ICOL,IROW).GT.0)BND%X(ICOL,IROW)=-1; ENDIF
 ENDDO
    
 END SUBROUTINE PMANAGER_SAVEMF2005_BND

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,IDF,ITYPE,ITOPIC)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITOPIC,ILAY,ITYPE
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(:) :: BND
 INTEGER :: IROW,ICOL
  
 IF(ILAY.GT.0)THEN 
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
   !## blank out inactive cells
   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)IDF%X(ICOL,IROW)=IDF%NODATA
   !## blank out layer below in case of vertical conductance
   IF(ITOPIC.EQ.4)THEN
    IF(BND(ILAY+1)%X(ICOL,IROW).EQ.0)IDF%X(ICOL,IROW)=IDF%NODATA
   ENDIF
  ENDDO; ENDDO
 ENDIF
 
 !## blank out negative values for 'KDW','KHV','KVA','VCW','KVV','STO','SSC'
 SELECT CASE (ITOPIC)
  CASE (6:12)
   DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
    IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)CYCLE
    IF(IDF%X(ICOL,IROW).LT.0.0)IDF%X(ICOL,IROW)=0.0 
   ENDDO; ENDDO
 END SELECT
 
 !## remove packages on constant head cells
 IF(ITYPE.EQ.1.AND.ILAY.GT.0)THEN
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
   !## blank out constant head cells
   IF(BND(ILAY)%X(ICOL,IROW).LT.0)IDF%X(ICOL,IROW)=IDF%NODATA
  ENDDO; ENDDO
 ENDIF
  
 END SUBROUTINE PMANAGER_SAVEMF2005_CORRECT

 !###======================================================================
 SUBROUTINE PMANAGER_GETNLAY()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,IPER,ITOPIC
 
 !## get maximal number of layers
 MXNLAY=9999
 DO ITOPIC=2,12
  IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))CYCLE
  NLAY=-999
  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)
     NLAY=MAX(NLAY,TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,J)%ILAY)
    ENDDO
   ENDDO   
  ENDDO
  SELECT CASE (ITOPIC)
   !## kvv or vcw
   CASE (9,10)
    NLAY=NLAY+1
  END SELECT
  MXNLAY=MIN(MXNLAY,NLAY)
 ENDDO
 IF(MXNLAY.EQ.9999)MXNLAY=0
 
 END SUBROUTINE PMANAGER_GETNLAY

 !###======================================================================
 SUBROUTINE PMANAGER_GETNPER(JD1,IHMS1,JD2,IHMS2)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: JD1,IHMS1,JD2,IHMS2
 INTEGER :: I,II,J,K,IYR,IMH,IDY,IHR,IMT,ISC,JDP1,JDP2,IPER
 INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME
 INTEGER(KIND=8) :: STIME,ETIME
 
 ALLOCATE(ITIME(100)); ITIME=INT(0,8)
 CALL UTL_GDATE(JD1,IYR,IMH,IDY); CALL ITIMETOHMS(IHMS1,IHR,IMT,ISC)
 ITIME(1)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC
 CALL UTL_GDATE(JD2,IYR,IMH,IDY); CALL ITIMETOHMS(IHMS2,IHR,IMT,ISC)
 ITIME(2)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC

 !## fill in list
 IPER=2
 DO I=1,MAXTOPICS  
  IF(.NOT.TOPICS(I)%TIMDEP)CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE
  DO J=1,SIZE(TOPICS(I)%STRESS)
   !## skip steady-state
   IF(TRIM(UTL_CAP(TOPICS(I)%STRESS(J)%CDATE,'U')).EQ.'STEADY-STATE')CYCLE
   
   IYR=TOPICS(I)%STRESS(J)%IYR; IMH=TOPICS(I)%STRESS(J)%IMH; IDY=TOPICS(I)%STRESS(J)%IDY
   IHR=TOPICS(I)%STRESS(J)%IHR; IMT=TOPICS(I)%STRESS(J)%IMT; ISC=TOPICS(I)%STRESS(J)%ISC
   !## true date specified
   IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN
    IPER=IPER+1; CALL PMANAGER_GETNPER_ITIME(ITIME,IPER)
    ITIME(IPER)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC
   ELSE
    !## include used periods
    DO K=1,NPERIOD
     IF(TRIM(UTL_CAP(TOPICS(I)%STRESS(J)%CDATE,'U')).EQ.TRIM(UTL_CAP(PERIOD(K)%NAME,'U')))EXIT
    ENDDO
    !## see whether the current stress is within mentioned period
    IF(K.LE.NPERIOD)THEN
     IYR=PERIOD(K)%IYR; IMH=PERIOD(K)%IMH; IDY=PERIOD(K)%IDY; IHR=PERIOD(K)%IHR; IMT=PERIOD(K)%IMT; ISC=PERIOD(K)%ISC
     !## true date specified
     IF(IYR+IMH+IDY+IHR+IMT+ISC.GT.0)THEN
      IPER=IPER+1; CALL PMANAGER_GETNPER_ITIME(ITIME,IPER)
      ITIME(IPER)=IYR*10000000000+IMH*100000000+IDY*1000000+IHR*10000+IMT*100+ISC
     ENDIF
    ELSE
     !## not known period specified
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot find the definition for the specified'//CHAR(13)// &
        'period called: '//TRIM(TOPICS(I)%STRESS(J)%CDATE),'Error')
     NPER=0; RETURN
    ENDIF
   ENDIF
  ENDDO
 ENDDO

 STIME=ITIME(1); ETIME=ITIME(2)
 CALL PMANAGER_SORTTIMES(ITIME,STIME,ETIME)
 
 DEALLOCATE(ITIME)
 
 END SUBROUTINE PMANAGER_GETNPER
 
 !###======================================================================
 SUBROUTINE PMANAGER_SORTTIMES(ITIME,STIME,ETIME)
 !###======================================================================
 IMPLICIT NONE
 INTEGER(KIND=8),INTENT(IN) :: STIME,ETIME
 INTEGER(KIND=8),DIMENSION(:),POINTER,INTENT(IN) :: ITIME
 INTEGER(KIND=8),DIMENSION(:),POINTER :: JTIME
 INTEGER :: IPER,I
   
 CALL SHELLSORT_DOUBLEINT(SIZE(ITIME),ITIME)

 ALLOCATE(JTIME(SIZE(ITIME)))
 
 NPER=1
 
 !## start time
 JTIME(1)=STIME
 !## get first date inside time window
 DO IPER=1,SIZE(ITIME)
  !## too early
  IF(ITIME(IPER).LE.STIME)CYCLE; EXIT
 ENDDO
 
 !## get number of unique dates
 DO I=IPER,SIZE(ITIME)
  !## too late - stop
  IF(ITIME(I).GT.ETIME)EXIT
  IF(I.GT.1)THEN
   IF(ITIME(I).NE.ITIME(I-1))THEN
    NPER=NPER+1; JTIME(NPER)=ITIME(I)
   ENDIF
  ENDIF
 ENDDO
   
 IF(NPER.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No stress-periods found in the packages.','Warning')
 ELSE
  ALLOCATE(SIM(NPER))
  DO I=1,NPER
   WRITE(SIM(I)%CDATE,'(I14)') JTIME(I)
   READ(SIM(I)%CDATE,'(I4,5I2)') SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC  
   SIM(I)%ISAVE=1; SIM(I)%ISUM=0
  ENDDO
 ENDIF
 
 DEALLOCATE(JTIME)
 
 END SUBROUTINE PMANAGER_SORTTIMES

 !###======================================================================
 SUBROUTINE PMANAGER_GETNPER_ITIME(ITIME,IPER)
 !###======================================================================
 IMPLICIT NONE
 INTEGER(KIND=8),INTENT(INOUT),DIMENSION(:),POINTER :: ITIME
 INTEGER,INTENT(IN) :: IPER
 INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME_C
 INTEGER :: N,I
 
 !## check size of the SIM vector
 IF(SIZE(ITIME).LT.IPER)THEN
  N=SIZE(ITIME)+100; ALLOCATE(ITIME_C(N)); ITIME_C=INT(0,8)
  DO I=1,SIZE(ITIME); ITIME_C(I)=ITIME(I); ENDDO
  DEALLOCATE(ITIME); ITIME=>ITIME_C
 ENDIF

 END SUBROUTINE PMANAGER_GETNPER_ITIME

 !###======================================================================
 INTEGER FUNCTION PMANAGER_GETCURRENTIPER(IPER,ITOPIC)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPER,ITOPIC
 INTEGER(KIND=8) :: ITIME,JTIME,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.0)THEN !## transient
  !## previous timestep
  IF(IPER.GT.1)THEN
   IF(SIM(IPER-1)%DELT.GT.0.0)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
!  KPER=PMANAGER_GETIPER(IPER,KTIME,ITIME,JTIME,TOPICS(ITOPIC)%STRESS)
 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=10E14; 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
  PMANAGER_GETIPER=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.0)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

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_INITSIM(FNAME,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(OUT) :: FNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: ITYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: IDY,IYR,IMH,ITOPIC,IPER,I,J,K,MINJD,MAXJD,IDATE,IHR,IMT,ISC,IHMS,MINHMS,MAXHMS,ISTEADY,ISTEP
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 LOGICAL :: LEX
 
 PMANAGER_INITSIM=.FALSE.
 
 CALL WDIALOGLOAD(ID_DPMANAGER_SIM,ID_DPMANAGER_SIM)

 !## default packages
 CALL WDIALOGPUTMENU(IDF_MENU4,TMENU1,SIZE(TMENU1),8)

 CALL PMANAGER_GETNLAY()
 
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MXNLAY)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,1,MXNLAY)
 
 ISTEADY=0; MINJD=10E7; MAXJD=-10E7; MINHMS=246060; MAXHMS=0.0
 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(TOPICS(ITOPIC)%STRESS(IPER)%CDATE).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
     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
      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,'Can not convert date ['//TRIM(TOPICS(ITOPIC)%STRESS(IPER)%CDATE)//'] for'//CHAR(13)// &
         'Topic '//TRIM(TOPICS(ITOPIC)%TNAME),'Warning')
     ENDIF
    ENDIF
   ENDIF

  ENDDO
 ENDDO
 
 !## no transient data found
 IF(MINJD.GT.MAXJD.AND.MINHMS.GT.MAXHMS)THEN
  IF(ISTEADY.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No steady-state or transient data found','Warning')
  IMH=3; IYR=1970; IDY=8; IHR=0; IMT=0; ISC=0
  CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
  CALL WDIALOGFIELDSTATE(IDF_RADIO2,0)
  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)
  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)

  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)
 ENDIF
  
 I=0
 IF(ASSOCIATED(TOPICS(2)%STRESS).AND.ASSOCIATED(TOPICS(3)%STRESS).AND.ASSOCIATED(TOPICS(7)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(2)%STRESS(1)%FILES).AND. & !## top
     ASSOCIATED(TOPICS(3)%STRESS(1)%FILES).AND. & !## bot
     ASSOCIATED(TOPICS(7)%STRESS(1)%FILES))I=1    !## khv
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_CHECK1,I)             !## iunconf
 
 I=0
 IF(ASSOCIATED(TOPICS(6)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(6)%STRESS(1)%FILES))THEN   !## kdw
   I=1
   IF(NLAY.GT.1)THEN
    IF(ASSOCIATED(TOPICS(9)%STRESS))THEN
     IF(.NOT.ASSOCIATED(TOPICS(9)%STRESS(1)%FILES))I=0    !## vcw
    ELSE
     I=0
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_RADIO5,I)             !## bcf
 IF(I.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO5)
 LBCF=.FALSE.; IF(I.EQ.1)LBCF=.TRUE.
 
 J=0
 IF(ASSOCIATED(TOPICS(2)%STRESS).AND. &
    ASSOCIATED(TOPICS(3)%STRESS).AND. &
    ASSOCIATED(TOPICS(7)%STRESS))THEN
  IF(ASSOCIATED(TOPICS(2)%STRESS(1)%FILES).AND. & !## top
     ASSOCIATED(TOPICS(3)%STRESS(1)%FILES).AND. & !## bot
     ASSOCIATED(TOPICS(7)%STRESS(1)%FILES))THEN   !## khv
   J=1
   IF(NLAY.GT.1)THEN
    IF(ASSOCIATED(TOPICS(10)%STRESS))THEN
     IF(.NOT.ASSOCIATED(TOPICS(10)%STRESS(1)%FILES))J=0    !## kvv
    ELSE
     J=0
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_RADIO6,J)              !## lpf
 IF(J.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO6)
 LLPF=.FALSE.; IF(J.EQ.1)LLPF=.TRUE.
 IF(I.EQ.0.AND.J.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Missing data to (a) convert to BCF6 or (b) convert to LPF package','Warning')
  CALL WDIALOGUNLOAD(); RETURN
 ENDIF

 ALLOCATE(IDF(1)); CALL IDFNULLIFY(IDF(1))
 IF(.NOT.IDFREAD(IDF(1),TOPICS(4)%STRESS(1)%FILES(1,1)%FNAME,0))THEN
  CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF); RETURN
 ENDIF
 CALL WDIALOGPUTREAL(IDF_REAL5,IDF(1)%DX,'(G15.7)') 
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)

 !## modflow2005 does not allow thickness of zero
 CALL WDIALOGPUTREAL(IDF_REAL6,MINTHICKNESS,'(G15.7)') 

 CALL WDIALOGPUTREAL(IDF_REAL1,MPW%XMIN,'(G15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL2,MPW%YMIN,'(G15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL3,MPW%XMAX,'(G15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL4,MPW%YMAX,'(G15.7)') 

 CALL WDIALOGPUTSTRING(IDF_STRING1,MODELNAME)

 CALL PMANAGER_INITSIM_FIELDS()
 
 CALL WDIALOGGETMENU(IDF_MENU4,I)
 CALL PMANAGER_TIMESTEPS_GETISTEP(I,J,ISTEP)    
 CALL WDIALOGPUTINTEGER(IDF_INTEGER12,ISTEP) 
 CALL WDIALOGFIELDSTATE(IDF_INTEGER12,J)

 !## start dialog
 IF(IBATCH.EQ.0)THEN
  CALL WDIALOGSHOW(-1,-1,0,3)

  DO
   CALL WMESSAGE(ITYPE,MESSAGE)
   SELECT CASE (ITYPE)
    CASE(FIELDCHANGED)
     SELECT CASE (MESSAGE%VALUE2)
      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_RADIO1,IDF_RADIO2,IDF_RADIO3,IDF_RADIO4,IDF_CHECK3,IDF_CHECK1,IDF_INTEGER1)
       CALL PMANAGER_INITSIM_FIELDS()
       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)
       CALL PMANAGER_TIMESTEPS()
       CALL WDIALOGPUTOPTION(IDF_MENU4,9)
      CASE (ID_PACKAGE)
       CALL PMANAGER_INITSIM_PACKAGES()
       CALL PMANAGER_INITSIM_FIELDS()
      CASE (IDOK)

       !## fill timesteps - if not yet done
       LEX=.TRUE.; IF(.NOT.ASSOCIATED(SIM))LEX=PMANAGER_FILLTIMESTEPS()
       IF(LEX)THEN
        !## get file format
        CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,IFORMAT)
        IF(IFORMAT.EQ.1)THEN
         FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.run'
         LEX=UTL_WSELECTFILE('iMOD Run Files (*.run)|*.run|',  &
             SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Run File')
        ELSEIF(IFORMAT.EQ.2)THEN
         CALL UTL_CREATEDIR(TRIM(PREFVAL(1))//'\RUNFILES\MF2005')
         FNAME=TRIM(PREFVAL(1))//'\RUNFILES\MF2005\*.nam'
         LEX=UTL_WSELECTFILE('Modflow 2005 Nam Files (*.nam)|*.nam|',  &
            SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save Modflow 2005 Files')
        ENDIF
        IF(LEX)EXIT
       ENDIF
      CASE (IDCANCEL)
       EXIT
     END SELECT
   END SELECT

  ENDDO
 
 ELSE
  !## 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
  
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,PBMAN%IWINDOW)
  CALL WDIALOGPUTREAL(IDF_REAL1,PBMAN%XMIN)     !## xmin
  CALL WDIALOGPUTREAL(IDF_REAL2,PBMAN%YMIN)     !## ymin
  CALL WDIALOGPUTREAL(IDF_REAL3,PBMAN%XMAX)     !## xmax
  CALL WDIALOGPUTREAL(IDF_REAL4,PBMAN%YMAX)     !## ymax
  CALL WDIALOGPUTREAL(IDF_REAL5,PBMAN%CELLSIZE) !## cellsize
  CALL WDIALOGPUTREAL(IDF_REAL7,PBMAN%BUFFER)   !## buffer

  IF(PBMAN%IFORMAT.EQ.1)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3) !## runfile
  IF(PBMAN%IFORMAT.EQ.2)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO4) !## modflow2005

  IF(LEN_TRIM(PBMAN%TIMFNAME).NE.0)THEN
   CALL PMANAGER_SAVETIMESTEPS(ID_OPEN,1,PBMAN%TIMFNAME)     
  ELSE
   LEX=.TRUE.; IF(.NOT.ASSOCIATED(SIM))LEX=PMANAGER_FILLTIMESTEPS()
  ENDIF
  
 ENDIF

 IF(ASSOCIATED(SIM))SIM%ISUM=1
 
 !## get file format of export
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,IFORMAT)
 !## apply submodelling
 CALL WDIALOGGETCHECKBOX(IDF_CHECK3,ISUBMODEL)
 SUBMODEL=0.0; IF(ISUBMODEL.EQ.1)THEN
  CALL WDIALOGGETREAL(IDF_REAL1,SUBMODEL(1)) !## xmin
  CALL WDIALOGGETREAL(IDF_REAL2,SUBMODEL(2)) !## ymin
  CALL WDIALOGGETREAL(IDF_REAL3,SUBMODEL(3)) !## xmax
  CALL WDIALOGGETREAL(IDF_REAL4,SUBMODEL(4)) !## ymax
  CALL WDIALOGGETREAL(IDF_REAL5,SUBMODEL(5)) !## cellsize
  CALL WDIALOGGETREAL(IDF_REAL7,SUBMODEL(6)) !## buffer
 ENDIF
 CALL WDIALOGGETREAL(IDF_REAL6,MINTHICKNESS)
 !## number of modellayers
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,NLAY)
 !## apply unconfinedness
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IUNCONF)
 !## get subsoil format
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO5,I)
 LBCF=.FALSE.; IF(I.EQ.1)LBCF=.TRUE.
 LLPF=.FALSE.; IF(I.EQ.2)LLPF=.TRUE.
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO7,I)
 LQBD=.TRUE.; IF(I.EQ.1)LQBD=.FALSE.

 !## number of modellayers
 CALL WDIALOGGETSTRING(IDF_STRING1,MODELNAME)

 CALL WDIALOGUNLOAD(); IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
   
 PMANAGER_INITSIM=.TRUE.

 END FUNCTION PMANAGER_INITSIM

 !###======================================================================
 SUBROUTINE PMANAGER_TIMESTEPS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ITYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: DID,I,J,ISTEP,IROW,IROW1,IROW2,ION,ITG
 
 !## fill timesteps
 IF(.NOT.PMANAGER_FILLTIMESTEPS())RETURN

 DID=WINFODIALOG(CURRENTDIALOG)
 CALL WDIALOGLOAD(ID_DPMANAGER_TIMES,ID_DPMANAGER_TIMES)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
 CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVEAS,1)
 CALL WDIALOGPUTMENU(IDF_MENU1,TMENU1,SIZE(TMENU1),2)

 CALL WDIALOGTITLE('Time Discretization Manager for Simulation')

 CALL WDIALOGFIELDOPTIONS(IDF_INTEGER1,EDITFIELDCHANGED,1)
 CALL WDIALOGFIELDOPTIONS(IDF_INTEGER2,EDITFIELDCHANGED,1)
 CALL PMANAGER_PUTTIMEINGRID()
! CALL WDIALOGGETINTEGER(IDF_INTEGER1,IROW1)
! CALL WDIALOGGETINTEGER(IDF_INTEGER2,IROW2)
! CALL WGRIDCOLOURCOLUMN(IDF_GRID1,1,-1,-1)
! DO IROW=MIN(IROW1,IROW2),MAX(IROW1,IROW2)
!  CALL WGRIDCOLOURCELL(IDF_GRID1,1,IROW,-1,WRGB(255,0,0))
! ENDDO

 CALL WDIALOGGETMENU(IDF_MENU1,I)
 CALL PMANAGER_TIMESTEPS_GETISTEP(I,J,ISTEP)    
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3,ISTEP) 
 CALL WDIALOGFIELDSTATE(IDF_INTEGER3,J)
 CALL WGRIDSTATE(IDF_GRID1,1,2)
 CALL WGRIDSTATE(IDF_GRID1,2,2)
 CALL WDIALOGFIELDSTATE(IDF_RADIO3,0); CALL WDIALOGFIELDSTATE(IDF_RADIO4,0)

 CALL WDIALOGSHOW(-1,-1,0,3)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_RADIO1,IDF_RADIO2)
      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
      IF(I.EQ.1)THEN
       CALL WDIALOGPUTSTRING(ID_APPLY,'Modify Time Steps')
       CALL WDIALOGFIELDSTATE(IDF_RADIO3,0); CALL WDIALOGFIELDSTATE(IDF_RADIO4,0); CALL WDIALOGFIELDSTATE(IDF_LABEL6,0)
       CALL WDIALOGPUTMENU(IDF_MENU1,TMENU1,SIZE(TMENU1),2)
      ENDIF
      IF(I.EQ.2)THEN
       CALL WDIALOGPUTSTRING(ID_APPLY,'Modify Save Intervals')
       CALL WDIALOGFIELDSTATE(IDF_RADIO3,1); CALL WDIALOGFIELDSTATE(IDF_RADIO4,1); CALL WDIALOGFIELDSTATE(IDF_LABEL6,1)
       CALL WDIALOGPUTMENU(IDF_MENU1,TMENU2,SIZE(TMENU2),9)
      ENDIF
     CASE (IDF_MENU1)
      CALL WDIALOGGETMENU(IDF_MENU1,I)
      CALL PMANAGER_TIMESTEPS_GETISTEP(I,J,ISTEP)    
      CALL WDIALOGPUTINTEGER(IDF_INTEGER3,ISTEP) 
      CALL WDIALOGFIELDSTATE(IDF_INTEGER3,J)
     CASE (IDF_INTEGER1,IDF_INTEGER2)
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,IROW1)
      CALL WDIALOGGETINTEGER(IDF_INTEGER2,IROW2)
      CALL WGRIDCOLOURCOLUMN(IDF_GRID1,1,-1,-1)
      DO IROW=MIN(IROW1,IROW2),MAX(IROW1,IROW2)
       CALL WGRIDCOLOURCELL(IDF_GRID1,1,IROW,-1,WRGB(255,0,0))
      ENDDO
    END SELECT
      
   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_SELECTALL)
      I=1; IF(SIM(1)%DELT.LE.0.0)I=2
      CALL WDIALOGPUTINTEGER(IDF_INTEGER1,I)
      CALL WDIALOGPUTINTEGER(IDF_INTEGER2,NPER)
      CALL WGRIDCOLOURCOLUMN(IDF_GRID1,1,-1,-1)
      DO IROW=I,NPER; CALL WGRIDCOLOURCELL(IDF_GRID1,1,IROW,-1,WRGB(255,0,0)); ENDDO
     CASE (ID_APPLY)
      CALL WDIALOGGETMENU(IDF_MENU1,I)           !## period
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,IROW1)
      CALL WDIALOGGETINTEGER(IDF_INTEGER2,IROW2)
      CALL WDIALOGGETINTEGER(IDF_INTEGER3,ISTEP) !## number of repetitions
      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ITG) 
      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,ION) 
      CALL PMANAGER_INSERTTIMES(IROW1,IROW2,I,ISTEP,ITG,ION)
     CASE (ID_SAVE,ID_OPEN)
      !## store saving (done manually)
      I=SIZE(SIM); CALL WGRIDGETINTEGER(IDF_GRID1,3,SIM%ISAVE,I)
      CALL PMANAGER_SAVETIMESTEPS(MESSAGE%VALUE1,0,'')     
     CASE (IDOK)
      EXIT
     CASE (IDHELP)

     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 !## store saving (done manually)
 I=SIZE(SIM); CALL WGRIDGETINTEGER(IDF_GRID1,3,SIM%ISAVE,I)

 CALL WDIALOGFIELDOPTIONS(IDF_INTEGER1,EDITFIELDCHANGED,0)
 CALL WDIALOGFIELDOPTIONS(IDF_INTEGER2,EDITFIELDCHANGED,0)
 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(DID)
 
 END SUBROUTINE PMANAGER_TIMESTEPS

 !###======================================================================
 SUBROUTINE PMANAGER_TIMESTEPS_GETISTEP(IPERIOD,ISTATE,ISTEP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPERIOD
 INTEGER,INTENT(OUT) :: ISTATE,ISTEP
 
 SELECT CASE (IPERIOD)
  CASE (1,2,6,7) !## hourly,daily,monthly,yearly
   ISTATE=1; ISTEP=1
  CASE (3) !## weekly
   ISTATE=1; ISTEP=1
!   ISTATE=0; ISTEP=7
  CASE (4) !## decade
   ISTATE=1; ISTEP=1
!   ISTATE=0; ISTEP=10
  CASE (5) !## 14/28
   ISTATE=0; ISTEP=14
  CASE (8,9) !## all
   ISTATE=0; ISTEP=0
 END SELECT
 
 END SUBROUTINE PMANAGER_TIMESTEPS_GETISTEP
 
 !###======================================================================
 SUBROUTINE PMANAGER_PUTTIMEINGRID()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 
 IF(NPER.GT.WINFOGRID(IDF_GRID1,GRIDROWSMAX))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'There is a maximum of '// &
     TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX)))//' timesteps in this iMOD version'//CHAR(13)// &
     'iMOD displays '//TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX)))//' records only of '//TRIM(ITOS(NPER)),'Warning')
  NPER=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
  ALLOCATE(SIM_C(NPER)); DO I=1,NPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C
 ENDIF
 
 CALL WGRIDROWS(IDF_GRID1,NPER)
 DO I=1,NPER; CALL WGRIDLABELROW(IDF_GRID1,I,TRIM(ITOS(I))); ENDDO
 CALL WGRIDPUTSTRING (IDF_GRID1,1,SIM%CDATE,NPER)
 CALL WGRIDPUTREAL   (IDF_GRID1,2,SIM%DELT ,NPER)
 CALL WGRIDPUTINTEGER(IDF_GRID1,3,SIM%ISAVE,NPER)
 CALL WGRIDSTATE(IDF_GRID1,1,2)
 CALL WGRIDSTATE(IDF_GRID1,2,2)

 I=1; IF(SIM(1)%DELT.LE.0.0)I=2
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,I,NPER)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER2,I,NPER)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,I)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,I)
 CALL WGRIDCOLOURCOLUMN(IDF_GRID1,1,-1,-1)
 CALL WGRIDCOLOURCELL(IDF_GRID1,1,I,-1,WRGB(255,0,0))

 CALL WDIALOGPUTINTEGER(IDF_INTEGER4,NPER)

 END SUBROUTINE PMANAGER_PUTTIMEINGRID

 !###======================================================================
 SUBROUTINE PMANAGER_INSERTTIMES(IROW1,IROW2,IPERIOD,ISTEP,ITG,ION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IROW1,IROW2,IPERIOD,ISTEP,ITG,ION
 INTEGER :: IR1,IR2,IHMS1,IHMS2,JD1,JD2,I,J
 INTEGER(KIND=8),POINTER,DIMENSION(:) :: ITIME
 INTEGER(KIND=8) :: STIME,ETIME
  
 !## get the hours,minutes,seconds
 IR1=MAX(1,IROW1); IR2=MIN(SIZE(SIM),IROW2+1)
 IHMS1=HMSTOITIME(SIM(IR1)%IHR,SIM(IR1)%IMT,SIM(IR1)%ISC)
 IHMS2=HMSTOITIME(SIM(IR2)%IHR,SIM(IR2)%IMT,SIM(IR2)%ISC)
 JD1=JD(SIM(IR1)%IYR,SIM(IR1)%IMH,SIM(IR1)%IDY)
 JD2=JD(SIM(IR2)%IYR,SIM(IR2)%IMH,SIM(IR2)%IDY)
 
 ALLOCATE(SIM_C2(SIZE(SIM))); SIM_C2=SIM; DEALLOCATE(SIM)
  
 !## all selected between irow1 and irow2
 IF(ITG.EQ.2.AND.IPERIOD.EQ.9)THEN
  NPER=IROW2-IROW1+1; ALLOCATE(SIM(NPER))
  DO I=1,NPER; SIM(I)=SIM_C2(I+IROW1-1); ENDDO
 ELSE
  !## create new timesteps in between
  ALLOCATE(SIM(100))
  CALL PMANAGER_ASSIGNTIMESTEPS(1,2,JD1,JD2,IHMS1,IHMS2,IPERIOD,ISTEP)
 ENDIF
 
 !## adjust time-steps
 IF(ITG.EQ.1)THEN
  J=NPER+IR1+(SIZE(SIM_C2)-IR2+1)  
  ALLOCATE(ITIME(J))
 
  !## fill in previous timesteps before ir1 - skip steady-state
  J=0; DO I=1,IR1
   J=J+1
   ITIME(J)=SIM_C2(I)%IYR*10000000000+SIM_C2(I)%IMH*100000000+SIM_C2(I)%IDY*1000000+SIM_C2(I)%IHR*10000+SIM_C2(I)%IMT*100+SIM_C2(I)%ISC
  ENDDO
  STIME=ITIME(1)

  !## fill in previous timesteps after ir2
  DO I=IR2,SIZE(SIM_C2)
   J=J+1
   ITIME(J)=SIM_C2(I)%IYR*10000000000+SIM_C2(I)%IMH*100000000+SIM_C2(I)%IDY*1000000+SIM_C2(I)%IHR*10000+SIM_C2(I)%IMT*100+SIM_C2(I)%ISC
  ENDDO
  ETIME=ITIME(J)
 
  !## fill in the renewed timsteps
  DO I=1,NPER
   J=J+1
   ITIME(J)=SIM(I)%IYR*10000000000+SIM(I)%IMH*100000000+SIM(I)%IDY*1000000+SIM(I)%IHR*10000+SIM(I)%IMT*100+SIM(I)%ISC
  ENDDO

  CALL PMANAGER_SORTTIMES(ITIME,STIME,ETIME); DEALLOCATE(ITIME)
 
  !## recompute delt 
  CALL PMANAGER_COMPUTEDELT()
 
 !## adjust saving interval
 ELSE
  DO I=1,NPER
   DO J=1,SIZE(SIM_C2)
    IF(SIM(I)%IYR.EQ.SIM_C2(J)%IYR.AND. &
       SIM(I)%IMH.EQ.SIM_C2(J)%IMH.AND. &
       SIM(I)%IDY.EQ.SIM_C2(J)%IDY.AND. &
       SIM(I)%IHR.EQ.SIM_C2(J)%IHR.AND. &
       SIM(I)%IMT.EQ.SIM_C2(J)%IMT.AND. &
       SIM(I)%ISC.EQ.SIM_C2(J)%ISC)THEN; SIM_C2(J)%ISAVE=ION-1; EXIT; ENDIF
   ENDDO
  ENDDO
  DEALLOCATE(SIM); SIM=>SIM_C2; NPER=SIZE(SIM)
 ENDIF
 
 !## put in the menu
 CALL PMANAGER_PUTTIMEINGRID()
 
 END SUBROUTINE PMANAGER_INSERTTIMES

 !###======================================================================
 SUBROUTINE PMANAGER_ASSIGNTIMESTEPS(I1,I2,JD1,JD2,IHMS1,IHMS2,IPERIOD,JSTEP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: I1,I2,IPERIOD,JD1,JD2,IHMS1,IHMS2,JSTEP
 INTEGER :: I,ISTEP
 
 ISTEP=JSTEP
  
 !## fill in final date on position(1)
 CALL UTL_GDATE(JD2,SIM(I1)%IYR,SIM(I1)%IMH,SIM(I1)%IDY)
 CALL ITIMETOHMS(IHMS2,SIM(I1)%IHR,SIM(I1)%IMT,SIM(I1)%ISC)

 !## fill in start date on position(1)
 CALL UTL_GDATE(JD1,SIM(I2)%IYR,SIM(I2)%IMH,SIM(I2)%IDY)
 CALL ITIMETOHMS(IHMS1,SIM(I2)%IHR,SIM(I2)%IMT,SIM(I2)%ISC)

 !## overrule in case istep=0
 IF(ISTEP.EQ.0)THEN
  SELECT CASE (IPERIOD)
   CASE (1,2,6,7) !## hourly,daily,monthly,yearly
    ISTEP=1
   CASE (3) !## weekly
    ISTEP=7
   CASE (4) !## decade
    ISTEP=10
   CASE (5) !## 14/28
    ISTEP=14
  END SELECT
 ENDIF

 SELECT CASE (IPERIOD)
  CASE (3) !## weekly
   ISTEP=JSTEP*7
  CASE (4) !## decade
   ISTEP=JSTEP*10
 END SELECT

 !## fill in intermediate timesteps
 SELECT CASE (IPERIOD)
  CASE (1) !## hourly
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,4))EXIT; ENDDO; NPER=I
  CASE (2) !## daily
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; NPER=I
  CASE (3) !## weekly
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; NPER=I
!   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, 7,3))EXIT; ENDDO; NPER=I
  CASE (4) !## decade
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,3))EXIT; ENDDO; NPER=I
!   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1,10,3))EXIT; ENDDO; NPER=I
  CASE (5) !## 14/28
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1,10,7))EXIT; ENDDO; NPER=I
  CASE (6) !## monthly
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,2))EXIT; ENDDO; NPER=I
  CASE (7) !## yearly
   I=I2; DO; I=I+1; IF(.NOT.PMANAGER_ADDTIMESTEP(I,I1, ISTEP,1))EXIT; ENDDO; NPER=I
  CASE (8) !## packages
   CALL PMANAGER_GETNPER(JD1,IHMS1,JD2,IHMS2)
 END SELECT

 !## remove first "temporary" timestep
 SELECT CASE (IPERIOD)
  CASE (1:7)
   !## make sure size(sim) is equal to nper
   ALLOCATE(SIM_C(NPER-1)); DO I=1,NPER-1; SIM_C(I)=SIM(I+1); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C; NPER=NPER-1
 END SELECT
 
 DO I=1,NPER
  WRITE(SIM(I)%CDATE,'(I4.4,5(A1,I2.2))') SIM(I)%IYR,'-',SIM(I)%IMH,'-',SIM(I)%IDY,' ',SIM(I)%IHR,':',SIM(I)%IMT,':',SIM(I)%ISC
  SIM(I)%ISAVE=1; SIM(I)%ISUM =0
 ENDDO

 !## make sure size(sim) is equal to nper
 IF(NPER.LT.SIZE(SIM))THEN
  ALLOCATE(SIM_C(NPER)); DO I=1,NPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C
 ENDIF

 END SUBROUTINE PMANAGER_ASSIGNTIMESTEPS
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVETIMESTEPS(ID,IBATCH,FNAME_IN)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IBATCH
 CHARACTER(LEN=*),INTENT(IN) :: FNAME_IN
 INTEGER :: I,N,IOS,IU
 CHARACTER(LEN=256) :: FNAME,LINE
 INTEGER(KIND=8) :: IDATE
 
 IF(ID.EQ.ID_OPEN)THEN

  IF(LEN_TRIM(FNAME_IN).EQ.0)THEN
   FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.tim'
   IF(.NOT.UTL_WSELECTFILE('iMOD Time Files (*.tim)|*.tim|',     &
        LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,&
        'Load iMOD Time File'))RETURN
  ELSE
   FNAME=FNAME_IN
  ENDIF

  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED')
  IF(IU.EQ.0)RETURN
  N=100; IF(ASSOCIATED(SIM))DEALLOCATE(SIM); ALLOCATE(SIM(N))
  NPER=1; DO
   READ(IU,*,IOSTAT=IOS) SIM(NPER)%CDATE,SIM(NPER)%ISAVE
   IF(IOS.NE.0)EXIT
   NPER=NPER+1
   IF(NPER.GE.N)THEN
    ALLOCATE(SIM_C(N+100)); DO I=1,N; SIM_C(I)=SIM(I); ENDDO
    DEALLOCATE(SIM); SIM=>SIM_C; N=SIZE(SIM)
   ENDIF
  ENDDO   
  NPER=NPER-1
  !## make sure lenght is equal to nper
  IF(NPER.LT.SIZE(SIM))THEN
   ALLOCATE(SIM_C(NPER)); DO I=1,NPER; SIM_C(I)=SIM(I); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C
  ENDIF
  DO I=1,NPER
   READ(SIM(I)%CDATE,'(I14)') IDATE
   CALL ITIMETOGDATE(IDATE,SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC)
  ENDDO
  CALL PMANAGER_COMPUTEDELT()
  !## put in the menu
  IF(IBATCH.EQ.0)CALL PMANAGER_PUTTIMEINGRID()

  CLOSE(IU) 
 
 ELSEIF(ID.EQ.ID_SAVE)THEN

  IF(LEN_TRIM(FNAME_IN).EQ.0)THEN
   FNAME=TRIM(PREFVAL(1))//'\RUNFILES\*.tim'
   IF(.NOT.UTL_WSELECTFILE('iMOD Time Files (*.tim)|*.tim|',  &
          SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Time File'))RETURN
  ELSE
   FNAME=FNAME_IN
  ENDIF
  
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED')
  IF(IU.EQ.0)RETURN

  DO I=1,SIZE(SIM)
   WRITE(LINE,'(I4.4,5I2.2,A1,I2)') SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY,SIM(I)%IHR,SIM(I)%IMT,SIM(I)%ISC,',',SIM(I)%ISAVE
   WRITE(IU,'(A)') TRIM(LINE)
  ENDDO   
  CLOSE(IU)
  
  CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written project tim-file:'//CHAR(13)//TRIM(FNAME),'Information')

 ENDIF
 
 END SUBROUTINE PMANAGER_SAVETIMESTEPS
 
 !###======================================================================
 SUBROUTINE PMANAGER_INITSIM_PACKAGES()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ITYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: DID,I,N
 CHARACTER(LEN=MAXLEN),ALLOCATABLE,DIMENSION(:) :: PLIST
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IPLIST,JPLIST
 
 DID=WINFODIALOG(CURRENTDIALOG)

 CALL WDIALOGLOAD(ID_DPMANAGER_PACKAGES,ID_DPMANAGER_PACKAGES)

 ALLOCATE(PLIST(SIZE(TOPICS)),IPLIST(SIZE(TOPICS)),JPLIST(SIZE(TOPICS)))
 PLIST=''; IPLIST=0; JPLIST=0
 N=0; DO I=1,SIZE(TOPICS)
  IF(ASSOCIATED(TOPICS(I)%STRESS))THEN
   N=N+1; PLIST(N)=TOPICS(I)%TNAME; IPLIST(N)=TOPICS(I)%IACT_MODEL; JPLIST(N)=I
  ENDIF
 ENDDO

 CALL WDIALOGPUTMENU(IDF_MENU1,PLIST,N,IPLIST)
 CALL WDIALOGSHOW(-1,-1,0,3)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    !## previous field
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDF_MENU1)
    END SELECT
    !## next field
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_MENU1)
    END SELECT
    
   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETMENU(IDF_MENU1,IPLIST)
      DO I=1,N; TOPICS(JPLIST(I))%IACT_MODEL=IPLIST(I); ENDDO
      EXIT
     CASE (IDHELP)

     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(DID)
 
 DEALLOCATE(PLIST,IPLIST,JPLIST)

 END SUBROUTINE PMANAGER_INITSIM_PACKAGES

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_FILLTIMESTEPS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: JD1,JD2,IPERIOD,I,ISS,IHR,IMT,ISC,IHMS1,IHMS2,ISTEADY,ISTEP

 PMANAGER_FILLTIMESTEPS=.FALSE.
 
 !## get timestep configurations
 CALL WDIALOGGETMENU(IDF_MENU4,IPERIOD)
 CALL WDIALOGGETINTEGER(IDF_INTEGER12,ISTEP)
 
 !## custom settings
 IF(IPERIOD.GE.9)THEN
  IF(.NOT.ASSOCIATED(SIM))THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No time step configuration set found','Error')
  ELSE
   PMANAGER_FILLTIMESTEPS=.TRUE.
  ENDIF
  RETURN
 ENDIF
 
 !## get steady-transient simulation option, ISS=1 steady, ISS=2 transient
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ISS)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,ISTEADY)
  
 IF(ASSOCIATED(SIM))DEALLOCATE(SIM)
 
 !## transient
 IF(ISS.EQ.2)THEN
 
  !## get the dates
  CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2,JD1)
  CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU3,IDF_INTEGER4,JD2)
  !## get the hours,minutes,seconds
  CALL WDIALOGGETINTEGER(IDF_INTEGER6,IHR)
  CALL WDIALOGGETINTEGER(IDF_INTEGER7,IMT)
  CALL WDIALOGGETINTEGER(IDF_INTEGER8,ISC)
  IHMS1=HMSTOITIME(IHR,IMT,ISC)
  CALL WDIALOGGETINTEGER(IDF_INTEGER9,IHR)
  CALL WDIALOGGETINTEGER(IDF_INTEGER10,IMT)
  CALL WDIALOGGETINTEGER(IDF_INTEGER11,ISC)
  IHMS2=HMSTOITIME(IHR,IMT,ISC)
 
  ALLOCATE(SIM(100))
  CALL PMANAGER_ASSIGNTIMESTEPS(1,2,JD1,JD2,IHMS1,IHMS2,IPERIOD,ISTEP)

  CALL PMANAGER_COMPUTEDELT()
 
  !## add first steady-state step
  IF(ISTEADY.EQ.1)THEN

   ALLOCATE(SIM_C(NPER+1)); DO I=2,NPER+1; SIM_C(I)=SIM(I-1); ENDDO; DEALLOCATE(SIM); SIM=>SIM_C
   !## first is always a steady-state - potentially
   SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0
   SIM(1)%IYR=0; SIM(1)%IMH=0; SIM(1)%IDY=0; SIM(1)%IHR=0; SIM(1)%IMT=0; SIM(1)%ISC=0
   NPER=NPER+1

  ENDIF
      
 ELSE
 
  NPER=1; ALLOCATE(SIM(1))
  SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0
  SIM(1)%IYR=0; SIM(1)%IMH=0; SIM(1)%IDY=0; SIM(1)%IHR=0; SIM(1)%IMT=0; SIM(1)%ISC=0

 ENDIF
 
 PMANAGER_FILLTIMESTEPS=.TRUE.

 END FUNCTION PMANAGER_FILLTIMESTEPS

 !###======================================================================
 SUBROUTINE PMANAGER_COMPUTEDELT()   
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: SDAY=60*60*24
 INTEGER :: JD1,JD2,I,ISC1,ISC2
 
 DO I=1,NPER-1
   
  !## skip steady-state
  IF(SIM(I)%DELT.EQ.0.0.OR.SIM(I)%CDATE.EQ.'STEADY-STATE')CYCLE
  IF(SIM(I)%IYR+SIM(I)%IMH+SIM(I)%IDY+SIM(I)%IHR+SIM(I)%IMT+SIM(I)%ISC.LE.0)THEN
   SIM(I)%DELT=0.0; SIM(I)%CDATE='STEADY-STATE'
   CYCLE
  ENDIF
  
  !## compute delta-t for previous timestep
  JD1=JD(SIM(I  )%IYR,SIM(I  )%IMH,SIM(I  )%IDY)
  JD2=JD(SIM(I+1)%IYR,SIM(I+1)%IMH,SIM(I+1)%IDY)
  SIM(I)%DDAY=JD2-JD1-1

  !## compute net seconds between timesteps
  ISC1=SIM(I)%IHR*3600+SIM(I)%IMT*60+SIM(I)%ISC
  ISC1=SDAY-ISC1
  ISC2=SIM(I+1)%IHR*3600+SIM(I+1)%IMT*60+SIM(I+1)%ISC
  SIM(I)%DSEC=ISC1+ISC2

  DO   
   IF(SIM(I)%DSEC.LT.SDAY)EXIT
   SIM(I)%DDAY=SIM(I)%DDAY+1
   SIM(I)%DSEC=SIM(I)%DSEC-SDAY
  ENDDO
  SIM(I)%DELT=REAL(SIM(I)%DDAY)+SIM(I)%DSEC/REAL(SDAY)
 ENDDO
  
 !## last timestep is zero 0 will not be part of the model
 SIM(NPER)%DELT =0.0
 SIM(NPER)%ISAVE=0.0
 SIM(NPER)%ISUM =0.0
  
 END SUBROUTINE PMANAGER_COMPUTEDELT

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_ADDTIMESTEP(ISIM,ESIM,ISTEP,TSTEP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISIM,ESIM,TSTEP,ISTEP
 INTEGER :: IDAY,IHMS1,IHMS2,JD1,JD2,I,N
 
 !## added a step, or otherwise not
 PMANAGER_ADDTIMESTEP=.TRUE.
 
 !## check size of the SIM vector
 IF(SIZE(SIM).LE.ISIM)THEN
  N=SIZE(SIM)+100; ALLOCATE(SIM_C(N))
  DO I=1,SIZE(SIM); SIM_C(I)=SIM(I); ENDDO
  DEALLOCATE(SIM); SIM=>SIM_C
 ENDIF
 
 !## copy previous timestep
 SIM(ISIM)=SIM(ISIM-1)

 !## add a timestep to it according to the type of the timestep
 SELECT CASE (TSTEP)
  CASE (1) !## iyear
   SIM(ISIM)%IYR=SIM(ISIM-1)%IYR+ISTEP
  CASE (2) !## imonth
   SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+ISTEP
  CASE (3) !## iday
   SIM(ISIM)%IDY=SIM(ISIM-1)%IDY+ISTEP
  CASE (4) !## ihour
   SIM(ISIM)%IHR=SIM(ISIM-1)%IHR+ISTEP
  CASE (5) !## iminute
   SIM(ISIM)%IMT=SIM(ISIM-1)%IMT+ISTEP
  CASE (6) !## isecond
   SIM(ISIM)%ISC=SIM(ISIM-1)%ISC+ISTEP
  CASE (7) !## 14/28
   IF(SIM(ISIM-1)%IDY.EQ.14)THEN
    SIM(ISIM)%IDY=28
   ELSEIF(SIM(ISIM-1)%IDY.EQ.28)THEN
    SIM(ISIM)%IDY=14; SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+1
   ELSEIF(SIM(ISIM-1)%IDY.GT.14.AND.SIM(ISIM-1)%IDY.LT.28)THEN
    SIM(ISIM)%IDY=28
   ELSE
    SIM(ISIM)%IDY=14; IF(SIM(ISIM-1)%IDY.GT.28)SIM(ISIM)%IMH=SIM(ISIM-1)%IMH+1
   ENDIF
 END SELECT
 
 !## correct seconds
 DO 
  IF(SIM(ISIM)%ISC.LT.60)EXIT
  SIM(ISIM)%ISC=SIM(ISIM)%ISC-60; SIM(ISIM)%IMT=SIM(ISIM)%IMT+1
 ENDDO
 !## correct minutes
 DO 
  IF(SIM(ISIM)%IMT.LT.60)EXIT
  SIM(ISIM)%IMT=SIM(ISIM)%IMT-60; SIM(ISIM)%IHR=SIM(ISIM)%IHR+1
 ENDDO
 !## correct hours
 DO 
  IF(SIM(ISIM)%IHR.LT.24)EXIT
  SIM(ISIM)%IHR=SIM(ISIM)%IHR-24; SIM(ISIM)%IDY=SIM(ISIM)%IDY+1
 ENDDO

 !## no minutes available ihms1=0 otherwise ihms1=1
 IHMS1=HMSTOITIME(SIM(ISIM)%IHR,SIM(ISIM)%IMT,SIM(ISIM)%ISC)
 IHMS1=MIN(IHMS1,1)
 
 !## correct days
 DO 
  IDAY=WDATEDAYSINMONTH(SIM(ISIM)%IYR,SIM(ISIM)%IMH)
  IF(SIM(ISIM)%IDY.LE.IDAY)EXIT
  SIM(ISIM)%IDY=SIM(ISIM)%IDY-IDAY; SIM(ISIM)%IMH=SIM(ISIM)%IMH+1
 ENDDO
 !## correct month
 DO 
  IF(SIM(ISIM)%IMH.LE.12)EXIT
  SIM(ISIM)%IMH=SIM(ISIM)%IMH-12; SIM(ISIM)%IYR=SIM(ISIM)%IYR+1
 ENDDO
 
 !## evaluate whether the new date is greater or equal esim - trim on it alternatively
 JD1=JD(SIM(ISIM)%IYR,SIM(ISIM)%IMH,SIM(ISIM)%IDY)
 JD2=JD(SIM(ESIM)%IYR,SIM(ESIM)%IMH,SIM(ESIM)%IDY)
 IHMS1=HMSTOITIME(SIM(ISIM)%IHR,SIM(ISIM)%IMT,SIM(ISIM)%ISC)
 IHMS2=HMSTOITIME(SIM(ESIM)%IHR,SIM(ESIM)%IMT,SIM(ESIM)%ISC)

 !## not yet finished - return
 IF(JD1.LT.JD2)THEN
  RETURN
 !## trim and finish
 ELSEIF(JD1.GT.JD2)THEN
  SIM(ISIM)=SIM(ESIM)
 ELSE
  !## not yet finished - return
  IF(IHMS1.LT.IHMS2)THEN
   RETURN
  !## trim and finish
  ELSE
   SIM(ISIM)=SIM(ESIM)  
  ENDIF
 ENDIF

 PMANAGER_ADDTIMESTEP=.FALSE.
 
 END FUNCTION PMANAGER_ADDTIMESTEP
 
 !###======================================================================
 SUBROUTINE PMANAGER_INITSIM_FIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 CHARACTER(LEN=256) :: STRING

 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
 IF(I.EQ.1)THEN; CALL WDIALOGPUTSTRING(IDF_LABEL12,'Transmissivity as a function of head')
 ELSE; CALL WDIALOGPUTSTRING(IDF_LABEL12,''); ENDIF
 
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,I)
 IF(I.LT.MXNLAY)THEN; CALL WDIALOGPUTSTRING(IDF_LABEL13,'Model layer '//TRIM(ITOS(I))//' is simulated by a constant head boundary.')
 ELSE; CALL WDIALOGPUTSTRING(IDF_LABEL13,'')
 ENDIF

 STRING='Active: '
 DO I=1,SIZE(TOPICS); IF(TOPICS(I)%IACT_MODEL.EQ.1)STRING=TRIM(STRING)//'; '//TOPICS(I)%TNAME(2:4); ENDDO
 CALL WDIALOGPUTSTRING(IDF_LABEL21,TRIM(STRING))
 
 CALL WDIALOGGETCHECKBOX(IDF_CHECK3,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL1,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL2,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL3,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL4,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL5,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL7,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL9,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL10,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL11,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL19,I)

 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL4,I-1)
 CALL WDIALOGFIELDSTATE(IDF_LABEL6,I-1)
 CALL WDIALOGFIELDSTATE(IDF_LABEL7,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER2,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER3,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER4,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER5,I-1)

 CALL WDIALOGFIELDSTATE(IDF_INTEGER6 ,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER7 ,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER8 ,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER9 ,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER10,I-1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER11,I-1)

 CALL WDIALOGFIELDSTATE(IDF_MENU2,I-1)
 CALL WDIALOGFIELDSTATE(IDF_MENU3,I-1)
 CALL WDIALOGFIELDSTATE(IDF_MENU4,I-1)
 CALL WDIALOGFIELDSTATE(IDF_CHECK2,I-1)
 CALL WDIALOGFIELDSTATE(ID_SIMCUSTOMIZE,I-1)

 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,I); I=I-1
 CALL WDIALOGFIELDSTATE(IDF_REAL6,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL14,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL22,I)
 CALL WDIALOGFIELDSTATE(IDF_RADIO7,I)
 CALL WDIALOGFIELDSTATE(IDF_RADIO8,I)
 CALL WDIALOGFIELDSTATE(IDF_STRING1,ABS(I-1))

 IF(LBCF)CALL WDIALOGFIELDSTATE(IDF_RADIO5,I)
 IF(LLPF)CALL WDIALOGFIELDSTATE(IDF_RADIO6,I)

 END SUBROUTINE PMANAGER_INITSIM_FIELDS

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_GETKEYS(IU)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU
 INTEGER :: I,J,IOS
 CHARACTER(LEN=256) :: LINE
 
 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) NLAY,NLAY,NPER,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
 
 !## 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(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=256) :: LINE
 CHARACTER(LEN=52) :: CDATE,C
 REAL :: 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.1)THEN
     MSYS=NSYS; NSYS=1 
    ENDIF
      
    !## pst module
    IF(ITOPIC.EQ.20)THEN
     !## create new system
     IPER=0; CALL PMANAGER_STRESSES(ITOPIC,IPER)
     ISYS=0; CALL PMANAGER_SYSTEMS(ITOPIC,IPER,ISYS)
     CALL PMANAGER_LOADPST(IU,NSYS,0); 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)%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 (1,13)  !## 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.1.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(1)%SNAME(7) ='Recharge-ID (IDF)'
          TOPICS(1)%SNAME(8) ='Extraction (IPF)'
          TOPICS(1)%SNAME(9) ='<not neccessary>'
          I=I+1; IARMWP=1
          TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FNAME=''
          TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%FCT=1.0
          TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,ISYS)%IMP=0.0
          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(1)%SNAME(7) ='Artificial discharge (IDF)'
          TOPICS(1)%SNAME(8) ='Artificial layer (IDF)'
          TOPICS(1)%SNAME(9) ='Artificial location (IDF)'
         ENDIF
        ENDIF

       CASE (29) !## 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.1)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 PMANAGERDELETE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ID,ITOPIC,IPER,ISYS,ISUBTOPIC,I,II,J,K,N,M
 CHARACTER(LEN=256) :: CNAME,STRING
 CHARACTER(LEN=4) :: EXT
 
 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGGETTREEVIEW(ID_TREEVIEW1,ID,CNAME)
 
 !## get the right topics and attribute from the treeview
 IF(.NOT.PMANAGER_GETSELECTED(ID,ITOPIC,IPER,ISYS,ISUBTOPIC,1))RETURN

 !## remove/clean entire topic
 IF(IPER+ISYS+ISUBTOPIC.EQ.0)THEN

  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to delete the content'//CHAR(13)// &
   'for the topic ['//TRIM(TOPICS(ITOPIC)%TNAME)//']','Question'); IF(WINFODIALOG(4).NE.1)RETURN
  CALL PMANAGER_DEALLOCATE(ITOPIC)
  !## update the project manager for changes
  CALL PMANAGERUPDATE(0,0,0)

 ELSEIF(IPER.NE.0.AND.ISYS.NE.0.AND.ISUBTOPIC.NE.0)THEN
 
  STRING='ilay='//TRIM(ITOS(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ILAY))
  STRING=TRIM(STRING)//CHAR(13)//'fct='//TRIM(RTOS(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%FCT,'*',3))
  STRING=TRIM(STRING)//CHAR(13)//'imp='//TRIM(RTOS(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%IMP,'*',3))
  !## constant value
  IF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.1)THEN
   STRING=TRIM(STRING)//CHAR(13)//'cnst='//TRIM(RTOS(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%CNST,'*',3))
  !## filename
  ELSEIF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ICNST.EQ.2)THEN
   CNAME=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ALIAS
   EXT=CNAME(INDEX(CNAME,'.',.TRUE.)+1:)
   STRING=TRIM(STRING)//CHAR(13)//TRIM(EXT)//'='//TRIM(CNAME) !TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISUBTOPIC,ISYS)%ALIAS)
  ENDIF

  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to remove the selected entry:'//CHAR(13)//TRIM(STRING),'Question')
  IF(WINFODIALOG(4).NE.1)RETURN

  !## file selected, selected system will be deleted, thus conductance removes stage,bottom and inffactor as well.
  !## delete selected file and decrease size of files().
  N=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,1) !## number of subtopics 
  M=SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2) !## number of systems
  IF(M.GT.1)THEN
   ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(N,M-1)) !## decrease size of the systems
   DO I=1,N; K=0; DO J=1,M
    IF(J.NE.ISYS)THEN
     K=K+1
     TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP(I,K)=TOPICS(ITOPIC)%STRESS(IPER)%FILES(I,J)
    ENDIF
   ENDDO; ENDDO
   DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES)
   TOPICS(ITOPIC)%STRESS(IPER)%FILES=>TOPICS(ITOPIC)%STRESS(IPER)%FILES_TMP
  ELSE
   !## remove current date - nothing left
   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))
    II=0; DO I=1,N
     IF(I.EQ.IPER)CYCLE
     II=II+1
     J=SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,1)
     K=SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,2)
     NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(II)%FILES)
     NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(II)%INPFILES)
     ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(II)%FILES(J,K))
     TOPICS(ITOPIC)%STRESS_TMP(II)%FILES=TOPICS(ITOPIC)%STRESS(I)%FILES
     TOPICS(ITOPIC)%STRESS_TMP(II)%CDATE=TOPICS(ITOPIC)%STRESS(I)%CDATE
     TOPICS(ITOPIC)%STRESS_TMP(II)%IYR=TOPICS(ITOPIC)%STRESS(I)%IYR
     TOPICS(ITOPIC)%STRESS_TMP(II)%IMH=TOPICS(ITOPIC)%STRESS(I)%IMH
     TOPICS(ITOPIC)%STRESS_TMP(II)%IDY=TOPICS(ITOPIC)%STRESS(I)%IDY
     TOPICS(ITOPIC)%STRESS_TMP(II)%IHR=TOPICS(ITOPIC)%STRESS(I)%IHR
     TOPICS(ITOPIC)%STRESS_TMP(II)%IMT=TOPICS(ITOPIC)%STRESS(I)%IMT
     TOPICS(ITOPIC)%STRESS_TMP(II)%ISC=TOPICS(ITOPIC)%STRESS(I)%ISC
     DEALLOCATE(TOPICS(ITOPIC)%STRESS(I)%FILES)
    ENDDO
    TOPICS(ITOPIC)%STRESS=>TOPICS(ITOPIC)%STRESS_TMP
   ENDIF
  ENDIF
  
  !## if pest associated, remove number of pest parameters
  IF(ITOPIC.EQ.20)CALL PMANAGER_DEALLOCATE_PEST()
  
  !## update the project manager for changes - on topic level, other is not possible
  CALL PMANAGERUPDATE(ITOPIC,IPER,ISUBTOPIC)

 !## remove selected date
 ELSEIF(IPER.NE.0.AND.ISYS.EQ.0.AND.ISUBTOPIC.EQ.0)THEN

  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to delete the selected date ['//TRIM(TOPICS(ITOPIC)%STRESS(IPER)%CDATE)//']'//CHAR(13)// &
   ' for the topic ['//TRIM(TOPICS(ITOPIC)%TNAME)//']','Question'); IF(WINFODIALOG(4).NE.1)RETURN
  
  !## make copy of current memory
  N=SIZE(TOPICS(ITOPIC)%STRESS)
  IF(N.GT.1)THEN
   NULLIFY(TOPICS(ITOPIC)%STRESS_TMP)
   ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(N-1))
   M=0
   DO I=1,N
    !## skip selected period (do not copy)
    IF(I.EQ.IPER)CYCLE
    M=M+1
    J =SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,1)
    K =SIZE(TOPICS(ITOPIC)%STRESS(I)%FILES,2)
    NULLIFY(TOPICS(ITOPIC)%STRESS_TMP(M)%FILES)
    ALLOCATE(TOPICS(ITOPIC)%STRESS_TMP(M)%FILES(J,K))
    TOPICS(ITOPIC)%STRESS_TMP(M)%FILES=TOPICS(ITOPIC)%STRESS(I)%FILES
    TOPICS(ITOPIC)%STRESS_TMP(M)%CDATE=TOPICS(ITOPIC)%STRESS(I)%CDATE
    TOPICS(ITOPIC)%STRESS_TMP(M)%IYR=TOPICS(ITOPIC)%STRESS(I)%IYR
    TOPICS(ITOPIC)%STRESS_TMP(M)%IMH=TOPICS(ITOPIC)%STRESS(I)%IMH
    TOPICS(ITOPIC)%STRESS_TMP(M)%IDY=TOPICS(ITOPIC)%STRESS(I)%IDY
    TOPICS(ITOPIC)%STRESS_TMP(M)%IHR=TOPICS(ITOPIC)%STRESS(I)%IHR
    TOPICS(ITOPIC)%STRESS_TMP(M)%IMT=TOPICS(ITOPIC)%STRESS(I)%IMT
    TOPICS(ITOPIC)%STRESS_TMP(M)%ISC=TOPICS(ITOPIC)%STRESS(I)%ISC
    DEALLOCATE(TOPICS(ITOPIC)%STRESS(I)%FILES)
   ENDDO
   TOPICS(ITOPIC)%STRESS=>TOPICS(ITOPIC)%STRESS_TMP
  ELSE
   DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES)
   DEALLOCATE(TOPICS(ITOPIC)%STRESS)
  ENDIF
  
  CALL PMANAGERUPDATE(ITOPIC,0,0)
 
 ELSE

  CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'You should select a topic or a individual filename','Question')
  IF(WINFODIALOG(4).NE.1)RETURN

 ENDIF
 
 END SUBROUTINE PMANAGERDELETE

 !###======================================================================
 SUBROUTINE PMANAGERFIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,ID
 
 CALL WDIALOGSELECT(ID_DPMANAGER)
 CALL WDIALOGUNDEFINED(IVALUE=-1); CALL UTL_DEBUGLEVEL(0)
 CALL WDIALOGGETTREEVIEW(ID_TREEVIEW1,ID); CALL UTL_DEBUGLEVEL(1)
 !## nothing selected
 IF(ID.EQ.-1)ID=0; ID=MAX(ID,0); I=1; IF(ID.EQ.0)I=0

 CALL WDIALOGFIELDSTATE(ID_DRAW,I)
 CALL WDIALOGFIELDSTATE(ID_PROPERTIES,I)

 END SUBROUTINE PMANAGERFIELDS

 !###======================================================================
 SUBROUTINE PMANAGERUPDATE(IDITOPIC,IDIPER,IDISUBS)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IDITOPIC,IDIPER,IDISUBS
 INTEGER :: IPER,I,J,K,N,IDTOPIC,IDSUBTC,IFILES,NF,MF,JD
 CHARACTER(LEN=256) :: STRING,CNAME
 CHARACTER(LEN=4) :: EXT
 
 I=INFOERROR(1)

 JD=0
 CALL PMANAGER_ALLOCATE()
 
 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGCLEARFIELD(ID_TREEVIEW1)
#if (defined(WINTERACTER9))
  CALL WDIALOGTREEVIEWCHECK(0)
#endif
 
 IDTOPIC=1000-1; IDSUBTC=2000-1

 IFILES=0; DO I=1,SIZE(TOPICS)

  IDTOPIC     =IDTOPIC+1
  TOPICS(I)%ID=IDTOPIC

  !## create main topics
  CALL WDIALOGINSERTTREEVIEWITEM(ID_TREEVIEW1,TOPICS(MAX(1,I-1))%ID,INSERTAFTER, &
                                 TOPICS(I)%ID,TRIM(TOPICS(I)%TNAME))
  !## stress periods available
  N=0; IF(ASSOCIATED(TOPICS(I)%STRESS))N=SIZE(TOPICS(I)%STRESS)

  IF(N.GT.0)THEN

   !## create timestamps
   DO IPER=1,SIZE(TOPICS(I)%STRESS)
         
    NF=0; MF=0
    IF(ASSOCIATED(TOPICS(I)%STRESS(IPER)%FILES))THEN
     NF=SIZE(TOPICS(I)%STRESS(IPER)%FILES,1); MF=SIZE(TOPICS(I)%STRESS(IPER)%FILES,2)
    ENDIF
    
    !## create timestamp - only whenever files are active
    IF(TOPICS(I)%TIMDEP.AND.NF.GT.0)THEN
     IDSUBTC            =IDSUBTC+1
     TOPICS(I)%IDT(IPER)=IDSUBTC
     
     IF(TOPICS(I)%STRESS(IPER)%IYR+TOPICS(I)%STRESS(IPER)%IMH+TOPICS(I)%STRESS(IPER)%IDY+ &
        TOPICS(I)%STRESS(IPER)%IHR+TOPICS(I)%STRESS(IPER)%IMT+TOPICS(I)%STRESS(IPER)%ISC.GT.0)THEN
      WRITE(STRING,'(I4.4,5(A1,I2.2))') TOPICS(I)%STRESS(IPER)%IYR,'-', &
                                        TOPICS(I)%STRESS(IPER)%IMH,'-', &
                                        TOPICS(I)%STRESS(IPER)%IDY,' ', &
                                        TOPICS(I)%STRESS(IPER)%IHR,':', &
                                        TOPICS(I)%STRESS(IPER)%IMT,':', &
                                        TOPICS(I)%STRESS(IPER)%ISC
     ELSE
      STRING=TRIM(TOPICS(I)%STRESS(IPER)%CDATE)
     ENDIF
     CALL WDIALOGINSERTTREEVIEWITEM(ID_TREEVIEW1,TOPICS(I)%ID,INSERTCHILD, &
                                    TOPICS(I)%IDT(IPER),TRIM(STRING))
    ELSE
     TOPICS(I)%IDT(IPER)=TOPICS(I)%ID
    ENDIF
    
    !## create subtopics names - only whenever files are active
    IF(TOPICS(I)%NSUBTOPICS.GT.1.AND.NF.GT.0)THEN
     DO J=1,TOPICS(I)%NSUBTOPICS
      IDSUBTC              =IDSUBTC+1
      TOPICS(I)%ISD(IPER,J)=IDSUBTC
      CALL WDIALOGINSERTTREEVIEWITEM(ID_TREEVIEW1,TOPICS(I)%IDT(IPER),INSERTCHILD, &
                                     TOPICS(I)%ISD(IPER,J),TRIM(TOPICS(I)%SNAME(J)))
     END DO
    ELSE
     TOPICS(I)%ISD(IPER,1)=TOPICS(I)%IDT(IPER)
    ENDIF
      
    DO J=1,NF   !## number of periods (types)
     DO K=1,MF  !## number of files (systems)
      IDSUBTC=IDSUBTC+1
      IFILES=IFILES+1
      TOPICS(I)%STRESS(IPER)%FILES(J,K)%ID=IDSUBTC
      STRING=''
      IF(TOPICS(I)%STRESS(IPER)%FILES(J,K)%IACT.EQ.0)THEN
       STRING='* inactive *;'
      ENDIF
      !## pst is a special case
      IF(I.EQ.20)THEN
       IF(ASSOCIATED(PEST%MEASURES))THEN
        STRING=TRIM(STRING)//'nmeasures='//TRIM(ITOS(SIZE(PEST%MEASURES)))
       ELSE
        STRING=TRIM(STRING)//'nmeasures=0'
       ENDIF
       IF(ASSOCIATED(PEST%PARAM))THEN
        STRING=TRIM(STRING)//';nparam='//TRIM(ITOS(SIZE(PEST%PARAM)))
       ELSE
        STRING=TRIM(STRING)//';nparam=0'
       ENDIF
       IF(ASSOCIATED(PEST%S_PERIOD))THEN
        STRING=TRIM(STRING)//';nperiods='//TRIM(ITOS(SIZE(PEST%S_PERIOD)))
       ELSE
        STRING=TRIM(STRING)//';nperiods=0'
       ENDIF
       IF(ASSOCIATED(PEST%B_FRACTION))THEN
        STRING=TRIM(STRING)//';nbatchfiles='//TRIM(ITOS(SIZE(PEST%B_FRACTION)))
       ELSE
        STRING=TRIM(STRING)//';nbatchfiles=0'
       ENDIF
       IF(ASSOCIATED(PEST%IDFFILES))THEN
        STRING=TRIM(STRING)//';nzones='//TRIM(ITOS(SIZE(PEST%IDFFILES)))
       ELSE
        STRING=TRIM(STRING)//';nzones=0'
       ENDIF
      ELSE
       STRING=TRIM(STRING)//'ilay='//TRIM(ITOS(TOPICS(I)%STRESS(IPER)%FILES(J,K)%ILAY))
       IF(TOPICS(I)%STRESS(IPER)%FILES(J,K)%ICNST.EQ.1)THEN
        STRING=TRIM(STRING)//';cnst='//TRIM(RTOS(TOPICS(I)%STRESS(IPER)%FILES(J,K)%CNST,'*',3))
       ELSEIF(TOPICS(I)%STRESS(IPER)%FILES(J,K)%ICNST.EQ.2)THEN
        CNAME=TOPICS(I)%STRESS(IPER)%FILES(J,K)%ALIAS
        EXT=UTL_CAP(CNAME(INDEX(CNAME,'.',.TRUE.)+1:),'L')
        STRING=TRIM(STRING)//';'//CHAR(13)//TRIM(EXT)//'='//TRIM(CNAME) 
       ENDIF
       STRING=TRIM(STRING)//';fct='//TRIM(RTOS(TOPICS(I)%STRESS(IPER)%FILES(J,K)%FCT,'*',3))
       STRING=TRIM(STRING)//';imp='//TRIM(RTOS(TOPICS(I)%STRESS(IPER)%FILES(J,K)%IMP,'*',3))
      ENDIF
      CALL WDIALOGINSERTTREEVIEWITEM(ID_TREEVIEW1,TOPICS(I)%ISD(IPER,J),INSERTCHILD, &
                                     TOPICS(I)%STRESS(IPER)%FILES(J,K)%ID,TRIM(STRING))

      !## select file of first type
      IF(J.EQ.1.AND.IDITOPIC.EQ.I.AND.IDIPER.EQ.IPER.AND.IDISUBS.EQ.K)THEN
       JD=TOPICS(I)%STRESS(IPER)%FILES(J,K)%ID
      ENDIF

     END DO
    END DO
    
   ENDDO
  ENDIF
 END DO
#if (defined(WINTERACTER9))
  CALL WDIALOGTREEVIEWCHECK(1)
#endif
  
! !## expand the last selected id of filename
! IF(IDITOPIC.NE.0.AND.IDIPER.NE.0.AND.IDISUBS.NE.0)THEN
!  CALL WDIALOGSETTREEVIEWSTATE(IDF_TREEVIEW1,TOPICS(I)%ID,BranchCollapsed)
!  CALL WDIALOGPUTTREEVIEW(ID_TREEVIEW1,TOPICS(IDITOPIC)%ISD(IDIPER,IDISUBS)) !,BRANCHEXPANDED)
! ELSEIF(IDITOPIC.NE.0.AND.IDIPER.NE.0)THEN 
!  CALL WDIALOGPUTTREEVIEW(ID_TREEVIEW1,TOPICS(IDITOPIC)%IDT(IDIPER)) !,BRANCHEXPANDED)
! ELSEIF(IDITOPIC.NE.0)THEN
!  CALL WDIALOGPUTTREEVIEW(ID_TREEVIEW1,TOPICS(IDITOPIC)%ID) !,BranchCollapsed)
! ENDIF      

 !## select appropriate id's
 IF(JD.NE.0)CALL WDIALOGPUTTREEVIEW(ID_TREEVIEW1,JD)
 I=INFOERROR(1)
 
 END SUBROUTINE PMANAGERUPDATE

 !###======================================================================
 SUBROUTINE PMANAGERSHOW(ICODE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICODE
 
 CALL WINDOWSELECT(0)
 IF(WMENUGETSTATE(ID_PMANAGER,2).EQ.1)THEN
  IF(ICODE.EQ.0)THEN; CALL PMANAGERCLOSE(); RETURN; ENDIF
 ENDIF
 CALL WMENUSETSTATE(ID_PMANAGER,2,1)

 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGSHOW(0,65,0,2)

 END SUBROUTINE PMANAGERSHOW

 !###======================================================================
 SUBROUTINE PMANAGERINIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 
 TOPICS(1)%TNAME ='(CAP) MetaSwap [-]'
 TOPICS(2)%TNAME ='(TOP) Top Elevation [DIS]'
 TOPICS(3)%TNAME ='(BOT) Bottom Elevation [DIS]'
 TOPICS(4)%TNAME ='(BND) Boundary Condition [BAS]'
 TOPICS(5)%TNAME ='(SHD) Starting Heads [BAS]'
 TOPICS(6)%TNAME ='(KDW) Transmissivity [BCF/LPF]'
 TOPICS(7)%TNAME ='(KHV) Horizontal Permeability [BCF/LPF]'
 TOPICS(8)%TNAME ='(KVA) Vertical Anisotropy [LPF]'
 TOPICS(9)%TNAME ='(VCW) Vertical Resistance [LPF]'
 TOPICS(10)%TNAME='(KVV) Vertical Permeability [BCF/LPF]'
 TOPICS(11)%TNAME='(STO) Storage Coefficient [BCF/LPF]'
 TOPICS(12)%TNAME='(SSC) Secundary Storage Coefficient [BCF/LPF]'
 TOPICS(13)%TNAME='(PWT) Perched Water Table [-]'
 TOPICS(14)%TNAME='(ANI) Anisotropy [LPF]'
 TOPICS(15)%TNAME='(HFB) Horizontal Flow Boundary [HFB]'
 TOPICS(16)%TNAME='(IBS) Interbed Storage [IBS]'
 TOPICS(17)%TNAME='(SFT) StreamFlow Thickness [-]'
 TOPICS(18)%TNAME='(CPP) Common Pointer Package [-]'
 TOPICS(19)%TNAME='(CON) Concentration [-]'
 TOPICS(20)%TNAME='(PST) Parameter Estimation [-]'
 TOPICS(21)%TNAME='(WEL) Wells [WEL]'
 TOPICS(22)%TNAME='(DRN) Drainage [DRN]'
 TOPICS(23)%TNAME='(RIV) Rivers [RIV]'
 TOPICS(24)%TNAME='(EVT) Evapotranspiration [EVT]'
 TOPICS(25)%TNAME='(GHB) General Head Boundary [GHB]'
 TOPICS(26)%TNAME='(RCH) Recharge [RCH]'
 TOPICS(27)%TNAME='(OLF) Overland Flow [DRN]'
 TOPICS(28)%TNAME='(CHD) Constant Head Boundary [CHD]'
 TOPICS(29)%TNAME='(ISG) iMOD SeGment Rivers [-]'
 !TOPICS(30)%TNAME='(SCR) Subsidence [SWT]'

 TOPICS(1)%NSUBTOPICS =22 !CAP
 TOPICS(2)%NSUBTOPICS =1  !TOP
 TOPICS(3)%NSUBTOPICS =1  !BOT
 TOPICS(4)%NSUBTOPICS =1  !BND
 TOPICS(5)%NSUBTOPICS =1  !SHD
 TOPICS(6)%NSUBTOPICS =1  !KDW
 TOPICS(7)%NSUBTOPICS =1  !KHV
 TOPICS(8)%NSUBTOPICS =1  !KHA
 TOPICS(9)%NSUBTOPICS =1  !VCW
 TOPICS(10)%NSUBTOPICS=1  !KVV
 TOPICS(11)%NSUBTOPICS=1  !STO
 TOPICS(12)%NSUBTOPICS=2  !SSC
 TOPICS(13)%NSUBTOPICS=6  !PWT
 TOPICS(14)%NSUBTOPICS=2  !ANI
 TOPICS(15)%NSUBTOPICS=1  !HFB
 TOPICS(16)%NSUBTOPICS=4  !IBS
 TOPICS(17)%NSUBTOPICS=2  !SFT
 TOPICS(18)%NSUBTOPICS=1  !CPP
 TOPICS(19)%NSUBTOPICS=1  !CON
 TOPICS(20)%NSUBTOPICS=1  !PST
 TOPICS(21)%NSUBTOPICS=1  !WEL
 TOPICS(22)%NSUBTOPICS=2  !DRN
 TOPICS(23)%NSUBTOPICS=4  !RIV
 TOPICS(24)%NSUBTOPICS=3  !EVT
 TOPICS(25)%NSUBTOPICS=2  !GHB
 TOPICS(26)%NSUBTOPICS=1  !RCH
 TOPICS(27)%NSUBTOPICS=1  !OLF
 TOPICS(28)%NSUBTOPICS=1  !CHD
 TOPICS(29)%NSUBTOPICS=1  !ISG
 !TOPICS(30)%NSUBTOPICS=1 !SUB

 TOPICS(1)%TIMDEP =.FALSE. !CAP
 TOPICS(2)%TIMDEP =.FALSE. !TOP
 TOPICS(3)%TIMDEP =.FALSE. !BOT
 TOPICS(4)%TIMDEP =.FALSE. !BND
 TOPICS(5)%TIMDEP =.FALSE. !SHD
 TOPICS(6)%TIMDEP =.FALSE. !KDW
 TOPICS(7)%TIMDEP =.FALSE. !KHV
 TOPICS(8)%TIMDEP =.FALSE. !KVA
 TOPICS(9)%TIMDEP =.FALSE. !VCW
 TOPICS(10)%TIMDEP=.FALSE. !KVV
 TOPICS(11)%TIMDEP=.FALSE. !STO
 TOPICS(12)%TIMDEP=.FALSE. !SSC
 TOPICS(13)%TIMDEP=.FALSE. !PWT
 TOPICS(14)%TIMDEP=.FALSE. !ANI
 TOPICS(15)%TIMDEP=.FALSE. !HFB
 TOPICS(16)%TIMDEP=.FALSE. !IBS
 TOPICS(17)%TIMDEP=.FALSE. !SFT
 TOPICS(18)%TIMDEP=.FALSE. !CPP
 TOPICS(19)%TIMDEP=.FALSE. !CON
 TOPICS(20)%TIMDEP=.FALSE. !PST
 TOPICS(21)%TIMDEP=.TRUE.  !WEL
 TOPICS(22)%TIMDEP=.TRUE.  !DRN
 TOPICS(23)%TIMDEP=.TRUE.  !RIV
 TOPICS(24)%TIMDEP=.TRUE.  !EVT
 TOPICS(25)%TIMDEP=.TRUE.  !GHB
 TOPICS(26)%TIMDEP=.TRUE.  !RCH
 TOPICS(27)%TIMDEP=.TRUE.  !OLF
 TOPICS(28)%TIMDEP=.TRUE.  !CHD
 TOPICS(29)%TIMDEP=.TRUE.  !ISG
 
 TOPICS(1)%SNAME(1) ='Boundary (IDF)'
 TOPICS(1)%SNAME(2) ='Landuse (IDF)'
 TOPICS(1)%SNAME(3) ='Rootzone (IDF)'
 TOPICS(1)%SNAME(4) ='Soiltype (IDF)'
 TOPICS(1)%SNAME(5) ='Meteostation (IDF)'
 TOPICS(1)%SNAME(6) ='Surfacelevel (IDF)'
 TOPICS(1)%SNAME(7) ='Artificial discharge (IDF)'
 TOPICS(1)%SNAME(8) ='Artificial layer (IDF)'
 TOPICS(1)%SNAME(9) ='Artificial location' 
 TOPICS(1)%SNAME(10)='Wetted Rural Area (IDF)'
 TOPICS(1)%SNAME(11)='Wetted Urban Area (IDF)'
 TOPICS(1)%SNAME(12)='Pondingdepth Urban Area (IDF)'
 TOPICS(1)%SNAME(13)='Pondingdepth Rural Area (IDF)'
 TOPICS(1)%SNAME(14)='Runoff Resistance Urban Area (IDF)'
 TOPICS(1)%SNAME(15)='Runoff Resistance Rural Area (IDF)'
 TOPICS(1)%SNAME(16)='Runon Resistance Urban Area (IDF)'
 TOPICS(1)%SNAME(17)='Runon Resistance Rural Area (IDF)'
 TOPICS(1)%SNAME(18)='Infiltration Capacity Urban Area (IDF)'
 TOPICS(1)%SNAME(19)='Infiltration Capacity Rural Area (IDF)'
 TOPICS(1)%SNAME(20)='Purgewater Depth (IDF)'
 TOPICS(1)%SNAME(21)='Soil Moisture Factor (IDF)'
 TOPICS(1)%SNAME(22)='Soild Permeability Factor (IDF)'
 TOPICS(2)%SNAME(1) ='Top of Modellayer (IDF)'
 TOPICS(3)%SNAME(1) ='Bottom of Modellayer (IDF)'
 TOPICS(4)%SNAME(1) ='Boundary Settings (IDF)'
 TOPICS(5)%SNAME(1) ='Starting Heads (IDF)'
 TOPICS(6)%SNAME(1) ='Transmissivity (IDF)'
 TOPICS(7)%SNAME(1) ='Horizontal Permeability (IDF)'
 TOPICS(8)%SNAME(1) ='Vertical Anisotropy (IDF)'
 TOPICS(9)%SNAME(1) ='Vertical Resistance (IDF)'
 TOPICS(10)%SNAME(1)='Vertical Permeability (IDF)'
 TOPICS(11)%SNAME(1)='Storage Coefficient (IDF)'
 TOPICS(12)%SNAME(1)='Unconfined Storage Coefficient (IDF)'
 TOPICS(12)%SNAME(2)='Confined Storage Coefficient (IDF)'
 TOPICS(13)%SNAME(1)='Layer Identification (IDF)'
 TOPICS(13)%SNAME(2)='Phreatic Storage Coefficient (IDF)'
 TOPICS(13)%SNAME(3)='Top of Aquifer above PWT-layer (IDF)'
 TOPICS(13)%SNAME(4)='Top of Aquitard PWT-layer (IDF)'
 TOPICS(13)%SNAME(5)='Top of Aquifer beneath PWT-layer (IDF)'
 TOPICS(13)%SNAME(6)='Vertical Resistance of PWT-clay (IDF)'
 TOPICS(14)%SNAME(1)='Factor (IDF)'
 TOPICS(14)%SNAME(2)='Angle (IDF)'
 TOPICS(15)%SNAME(1)='Horizontal Barrier Flow (GEN)'
 TOPICS(16)%SNAME(1)='Preconsolidation Head (IDF)'
 TOPICS(16)%SNAME(2)='Elastic Storage Coefficient (IDF)'
 TOPICS(16)%SNAME(3)='Inelastic Storage Coefficient (IDF)'
 TOPICS(16)%SNAME(4)='Starting Compaction (IDF)'
 TOPICS(17)%SNAME(1)='Stream Flow Thickness (IDF)'
 TOPICS(17)%SNAME(2)='Permeability (IDF)'
 TOPICS(18)%SNAME(1)='Common Pointer (IDF)'
 TOPICS(19)%SNAME(1)='Concentration (IDF)'
 TOPICS(20)%SNAME(1)='Parameters Estimation'
 TOPICS(21)%SNAME(1)='Well Rate (IPF)'
 TOPICS(22)%SNAME(1)='Conductance (IDF)'
 TOPICS(22)%SNAME(2)='Drainage Level (IDF)'
 TOPICS(23)%SNAME(1)='Conductance (IDF)'
 TOPICS(23)%SNAME(2)='River Stage (IDF)'
 TOPICS(23)%SNAME(3)='River Bottom (IDF)'
 TOPICS(23)%SNAME(4)='Infiltration Factor (IDF)'
 TOPICS(24)%SNAME(1)='Evapotranspiration Rate (IDF)'
 TOPICS(24)%SNAME(2)='Surface Level (IDF)'
 TOPICS(24)%SNAME(3)='Extinction Depth (IDF)'
 TOPICS(25)%SNAME(1)='Conductance (IDF)'
 TOPICS(25)%SNAME(2)='Reference Level (IDF)'
 TOPICS(26)%SNAME(1)='Recharge Rate (IDF)'
 TOPICS(27)%SNAME(1)='Overland Flow Level (IDF)'
 TOPICS(28)%SNAME(1)='Constant Head (IDF)'
 TOPICS(29)%SNAME(1)='Segment River (ISG)'
 
 CALL WDIALOGLOAD(ID_DPMANAGER)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
 CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVE,1)
 CALL WDIALOGPUTIMAGE(ID_PROPERTIES,ID_ICONPROPERTIES,1)
 CALL WDIALOGPUTIMAGE(ID_DRAW,ID_ICONDRAW,1)
 CALL WDIALOGPUTIMAGE(ID_DRAW2,ID_ICONDRAWPLUS,1)
 CALL WDIALOGPUTIMAGE(ID_OPENRUN,ID_ICONOPENRUN,1)
 CALL WDIALOGPUTIMAGE(ID_SAVERUN,ID_ICONSAVERUN,1)
 CALL WDIALOGPUTIMAGE(ID_CLEAN,ID_ICONNEW,1)
 CALL WDIALOGPUTIMAGE(ID_DELETE,ID_ICONDELETE,1)
 ALLOCATE(PERIOD(MAXPERIODS)); NPERIOD=0
 
 DO I=1,SIZE(TOPICS)
  NULLIFY(TOPICS(I)%STRESS)
  NULLIFY(TOPICS(I)%STRESS_TMP)
 ENDDO

 END SUBROUTINE PMANAGERINIT

 !###======================================================================
 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)
 
 END SUBROUTINE PMANAGER_DEALLOCATE
 
 !#####=================================================================
 SUBROUTINE PMANAGER_DEALLOCATE_PEST()
 !#####=================================================================
 IMPLICIT NONE
 
 IF(ASSOCIATED(PEST%PARAM))      DEALLOCATE(PEST%PARAM)
 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)

 END SUBROUTINE PMANAGER_DEALLOCATE_PEST
 
 !#####=================================================================
 INTEGER FUNCTION PMANAGER_FIND_KEYWORD(LINE)
 !#####=================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: LINE
 INTEGER :: I,J
 CHARACTER(LEN=3) :: CKEY

 PMANAGER_FIND_KEYWORD=0

 I=INDEX(LINE,'('); J=INDEX(LINE,')')
 IF(I.EQ.0.OR.J.EQ.0)RETURN; IF(J-I.NE.4)RETURN

 CKEY=LINE(I+1:J-1); CKEY=UTL_CAP(CKEY,'U')

 DO I=1,SIZE(CMOD)
  IF(CKEY.EQ.CMOD(I))THEN; PMANAGER_FIND_KEYWORD=I; RETURN; ENDIF
 END DO

 END FUNCTION PMANAGER_FIND_KEYWORD

 !#####=================================================================
 SUBROUTINE PMANAGERCLOSE()
 !#####=================================================================
 IMPLICIT NONE

 CALL WINDOWSELECT(0); CALL WMENUSETSTATE(ID_PMANAGER,2,0)
 CALL WDIALOGSELECT(ID_DPMANAGER); CALL WDIALOGHIDE()

 END SUBROUTINE PMANAGERCLOSE

END MODULE