!!  Copyright (C) Stichting Deltares, 2005-2014.
!!
!!  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
USE MOD_IDF, ONLY : IDFREAD,IDFDEALLOCATE,IDFNULLIFY,IDFREADSCALE,IDFCOPY,IDFDEALLOCATEX,IDFIROWICOL,IDFALLOCATEX,IDFGETAREA
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_OSD, ONLY : OSD_OPEN
USE IMODVAR, ONLY : RVERSION
USE MOD_PMANAGER_PAR
USE MOD_MANAGER, ONLY : MANAGERDELETE
USE MODPLOT, ONLY : MP
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

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 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,''))THEN; ENDIF
    CASE (ID_OPEN,ID_SAVE)
     IF(PMANAGERPRJ(MESSAGE%VALUE1,''))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,ITYPE,ID,IPER,ITOPIC,IOS,IST,IYR,IMH,IDY,ISUBTOPIC,IDATE,ISYS,IOPTION,IH,IM,IS
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=256) :: CNAME
 CHARACTER(LEN=3) :: EXT
 LOGICAL :: LEX,LNEW
 CHARACTER(LEN=MAXLEN) :: CD
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILAY,ISORT
   
 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

 N=TOPICS(ITOPIC)%NSUBTOPICS; ALLOCATE(PRJ(N))

 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=1
  PRJ%FNAME=''
  PRJ%IACT =1
  CALL IOSDATE(IYR,IMH,IDY)
  CALL WDIALOGPUTSTRING(IDOK,'Add New Parameter')
  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 Existing Parameter')
  LNEW=.FALSE.
 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
   READ(TOPICS(ITOPIC)%STRESS(IPER)%CDATE,*,IOSTAT=IOS) IDATE
   IF(IOS.EQ.0)THEN
    IH=TOPICS(ITOPIC)%STRESS(IPER)%IH
    IM=TOPICS(ITOPIC)%STRESS(IPER)%IM
    IS=TOPICS(ITOPIC)%STRESS(IPER)%IS
    CALL IDATETOGDATE(IDATE,IYR,IMH,IDY)
    CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO4)
    IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO4,1)
   ELSE
    CALL IOSDATE(IYR,IMH,IDY)
    IH=0; IM=0; IS=0
    !## 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)
     IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO5,1)
    ELSE
     CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO3)
     IF(.NOT.LNEW)CALL WDIALOGFIELDSTATE(IDF_RADIO3,1)
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 
 SELECT CASE (ITOPIC)
  CASE (21)
    EXT='IPF'
  CASE (29)
    EXT='ISG'
  CASE (15)
    EXT='GEN'
  CASE DEFAULT
    EXT='IDF'
 END SELECT
 
 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)
 ENDIF
 
 CALL WDIALOGPUTMENU(IDF_MENU2,CDATE,12,IMH)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,IDY)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3,IYR)

 CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IH)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IM)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER6,IS)
 
 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 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(TOPICS(1)%STRESS(1)%INPFILES)
     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'; IH=0; IM=0; IS=0
       ELSEIF(I.EQ.2)THEN !## date
        CALL WDIALOGGETINTEGER(IDF_INTEGER2,IDY)
        CALL WDIALOGGETINTEGER(IDF_INTEGER3,IYR)
        CALL WDIALOGGETMENU(IDF_MENU2,IMH)
        WRITE(CD,'(I4.4,2I2.2)') IYR,IMH,IDY

        CALL WDIALOGGETINTEGER(IDF_INTEGER4,IH)
        CALL WDIALOGGETINTEGER(IDF_INTEGER5,IM)
        CALL WDIALOGGETINTEGER(IDF_INTEGER6,IS)

       ELSEIF(I.EQ.3)THEN !## period
        CALL WDIALOGGETMENU(IDF_MENU3,I)
        WRITE(CD,'(A)') PERIOD(I)%NAME
        IH=0; IM=0; IS=0
       ENDIF

       IF(LNEW)THEN
        !## test whether date has been defined allready
        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 allready
          CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Entered date ['//TRIM(CD)//'] has been defined allready.','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)%IH=IH
  TOPICS(ITOPIC)%STRESS(IPER)%IM=IM
  TOPICS(ITOPIC)%STRESS(IPER)%IS=IS

  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
   
  CALL PMANAGERUPDATE(ITOPIC,IPER,ISYS)

 ENDIF
  
 DEALLOCATE(PRJ)

 END SUBROUTINE PMANAGEROPEN
 
 !###======================================================================
 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)
     CASE (IDF_MENU2)
      CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU2,IDF_INTEGER2)
    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(1)=4; PERIOD(IOPTION)%IDY(1)=1;  PERIOD(IOPTION)%IYR(1)=2014
  PERIOD(IOPTION)%IMH(2)=9; PERIOD(IOPTION)%IDY(2)=31; PERIOD(IOPTION)%IYR(2)=2014
  PERIOD(IOPTION)%IH(1)=0;  PERIOD(IOPTION)%IM(1)=0;   PERIOD(IOPTION)%IS(1)=0
  PERIOD(IOPTION)%IH(2)=0;  PERIOD(IOPTION)%IM(2)=0;   PERIOD(IOPTION)%IS(2)=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 allready.'//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(1))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1   ,PERIOD(IOPTION)%IDY(1))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3   ,PERIOD(IOPTION)%IYR(1))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER6   ,PERIOD(IOPTION)%IH(1))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER7   ,PERIOD(IOPTION)%IM(1))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER8   ,PERIOD(IOPTION)%IS(1))

 CALL WDIALOGPUTMENU(IDF_MENU2,CDATE,12,PERIOD(IOPTION)%IMH(2))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2   ,PERIOD(IOPTION)%IDY(2))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER5   ,PERIOD(IOPTION)%IYR(2))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER9   ,PERIOD(IOPTION)%IH(2))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER10  ,PERIOD(IOPTION)%IM(2))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER11  ,PERIOD(IOPTION)%IS(2))
 
 CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU1,IDF_INTEGER1)
 CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU2,IDF_INTEGER2)
 
 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(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER1 ,PERIOD(IOPTION)%IDY(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER3 ,PERIOD(IOPTION)%IYR(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER6 ,PERIOD(IOPTION)%IH(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER7 ,PERIOD(IOPTION)%IM(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER8 ,PERIOD(IOPTION)%IS(1))
  CALL WDIALOGGETMENU(IDF_MENU2       ,PERIOD(IOPTION)%IMH(2))
  CALL WDIALOGGETINTEGER(IDF_INTEGER2 ,PERIOD(IOPTION)%IDY(2))
  CALL WDIALOGGETINTEGER(IDF_INTEGER5 ,PERIOD(IOPTION)%IYR(2))
  CALL WDIALOGGETINTEGER(IDF_INTEGER9 ,PERIOD(IOPTION)%IH(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER10,PERIOD(IOPTION)%IM(1))
  CALL WDIALOGGETINTEGER(IDF_INTEGER11,PERIOD(IOPTION)%IS(1))
 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,INFORMATIONICON,COMMONOK,'You should select a MAIN TOPIC, a DATE or an individual FILENAME.','Information')
      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,INFORMATIONICON,COMMONOK,'You should select a MAIN TOPIC at least','Information')
  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(OUT) :: 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)
    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
    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(OUT) :: 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)CALL WDIALOGPUTSTRING(IDF_CHECK1,'Package is ACTIVE for coming simulations, deselect to Deactivate Parameter; ')
 IF(II.EQ.0)CALL WDIALOGPUTSTRING(IDF_CHECK1,'Package is INACTIVE for coming simulations, select to Activate Parameter; .')
 
 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 - 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

 END SELECT
 
 KK=0
 DO I=IL1,IL2
  DO J=1,SIZE(ILIST)
   JJ=ILIST(J)
   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
  DO I=1,NFILES; CALL MANAGERDELETE(IQ=0); ENDDO

  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)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 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
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can not read in the Project File','Error')
  ELSE
   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
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Succesfully written project file:'//CHAR(13)//TRIM(FNAME),'Information')
   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
 
 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
  WRITE(IU,'(I4.4,2A)') SIZE(TOPICS(I)%STRESS),',',TRIM(TOPICS(I)%TNAME) 
  DO L=1,SIZE(TOPICS(I)%STRESS)
   IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(L)%FILES))CYCLE
   IF(TOPICS(I)%TIMDEP)WRITE(IU,'(A,1X,3(I2.2,A1))') TRIM(TOPICS(I)%STRESS(L)%CDATE), &
      TOPICS(I)%STRESS(L)%IH,':',TOPICS(I)%STRESS(L)%IM,':',TOPICS(I)%STRESS(L)%IS
   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(1),'-',PERIOD(I)%IMH(1),'-',PERIOD(I)%IYR(1),' ', &
                                           PERIOD(I)%IH(1),':',PERIOD(I)%IM(1),':',PERIOD(I)%IS(1)
  WRITE(IU,'(2(I2.2,A1),I4.4,3(A1,I2.2))') PERIOD(I)%IDY(2),'-',PERIOD(I)%IMH(2),'-',PERIOD(I)%IYR(2),' ', &
                                           PERIOD(I)%IH(2),':',PERIOD(I)%IM(2),':',PERIOD(I)%IS(2)
 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,NPER,L,NSYS
 CHARACTER(LEN=MAXLEN) :: CTOPIC
 CHARACTER(LEN=512) :: LINE
  
 PMANAGER_LOADPRJ=.FALSE.
  
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED')

 !## read modules
 DO
  READ(IU,*,IOSTAT=IOS) NPER,CTOPIC; IF(IOS.NE.0)EXIT; IF(NPER.LE.0)CYCLE
  I=PMANAGER_FIND_KEYWORD(CTOPIC); IF(I.LE.0)CYCLE
  ALLOCATE(TOPICS(I)%STRESS(NPER))
  DO L=1,NPER 
   IF(TOPICS(I)%TIMDEP)THEN
    READ(IU,'(2A)') TOPICS(I)%STRESS(L)%CDATE,LINE
    READ(LINE,'(3(I2,1X))') TOPICS(I)%STRESS(L)%IH,TOPICS(I)%STRESS(L)%IM,TOPICS(I)%STRESS(L)%IS
   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 J=1,NSYS
    DO K=1,TOPICS(I)%NSUBTOPICS
     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(1),PERIOD(I)%IMH(1),PERIOD(I)%IYR(1), &
                                                     PERIOD(I)%IH(1), PERIOD(I)%IM(1), PERIOD(I)%IS(1)
  IF(IOS.NE.0)THEN; I=I-1; EXIT; ENDIF
  READ(IU,'(2(I2.2,1X),I4.4,3(1X,I2.2))',IOSTAT=IOS) PERIOD(I)%IDY(2),PERIOD(I)%IMH(2),PERIOD(I)%IYR(2), &
                                                     PERIOD(I)%IH(2), PERIOD(I)%IM(2), PERIOD(I)%IS(2)
  IF(IOS.NE.0)THEN; I=I-1; EXIT; ENDIF
 ENDDO; NPERIOD=I

 CLOSE(IU)
 
 PMANAGER_LOADPRJ=.TRUE.

 END FUNCTION PMANAGER_LOADPRJ
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGERRUN(ID,RUNFNAME)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 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')

  CALL UTL_MESSAGEHANDLE(0)
  IF(PMANAGER_GETKEYS(IU)) THEN
   IF(PMANAGER_GETFILES(IU,ITOPIC))THEN
    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)
  CALL UTL_MESSAGEHANDLE(1)
  
 ELSEIF(ID.EQ.ID_SAVERUN)THEN

  IF(.NOT.PMANAGER_INITSIM(FNAME))THEN; IF(ALLOCATED(SIM))DEALLOCATE(SIM); RETURN; ENDIF

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

 ENDIF 
 
 END FUNCTION PMANAGERRUN

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVERUN(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=512) :: LINE
 INTEGER :: IU,I,J,K,IPER,KPER,N
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 
 PMANAGER_SAVERUN=.FALSE.
  
 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)') TRIM(PREFVAL(1))//'\MODELS\'//TRIM(MODELNAME)
 WRITE(IU,'(10(I10,A1))') NLAY,',',MXNLAY,',',NPER,',',0,',',1,',',0,',',0,',',0,',',IUNCONF,',0'
 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),',',0.0
 ENDIF
 
 WRITE(IU,'(A)') 'ACTIVE MODULES'

 DO I=1,MAXTOPICS  
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE
  IF(TOPICS(I)%IACT_MODEL.EQ.1)WRITE(IU,'(A)') '1,1,0 '//TRIM(TOPICS(I)%TNAME)
 ENDDO
 
 !## write bndfile
 WRITE(IU,'(A)')TRIM(TOPICS(4)%STRESS(1)%FILES(1,1)%FNAME)   

 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
  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
     IF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.1)THEN
      WRITE(IU,'(1X,I4.4,3(A1,G15.7))') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%ILAY,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%CNST
     ELSEIF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.2)THEN
      WRITE(IU,'(1X,I4.4,2(A1,G15.7),A1,A)') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%ILAY,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,',', &
                   CHAR(39)//TRIM(TOPICS(I)%STRESS(1)%FILES(K,J)%FNAME)//CHAR(39)
     ENDIF
    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 '

 !## write packages
 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
   WRITE(IU,'(I5.5,A1,F15.7,A1,A,2(A1,I1),A)') KPER,',',SIM(KPER)%DELT,',',TRIM(SIM(KPER)%CDATE),',',SIM(KPER)%ISAVE,',',SIM(KPER)%ISUM, &
        ','//TRIM(SIM(KPER+1)%CDATE)
  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

   !## get appropriate stress-period to store in runfile   
   IF(KPER.EQ.1)THEN
    IPER=PMANAGER_GETIPER(SIM(KPER)%CDATE  ,SIM(KPER)%CDATE,TOPICS(I)%STRESS)
   ELSE
    IPER=PMANAGER_GETIPER(SIM(KPER-1)%CDATE,SIM(KPER)%CDATE,TOPICS(I)%STRESS)
   ENDIF
   
   !## reuse previous timestep
   IF(IPER.LE.0)THEN

    WRITE(IU,'(I3,A)') IPER,','//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)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=512) :: DIR,LINE
 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
 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.

 IIDEBUG=0          !## if 1 write asc files instead of arr
 STOPER=0.1         !## stop error of total waterbalance
 HNOFLOW=HUGE(1.0)  !## noflow value
 
 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.  !## optie?
 LPWT =.FALSE.
 
 !## msp
 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
  
 !## 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 iMOD V'//TRIM(RVERSION)
 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'//CHAR(39)
 WRITE(IU,'(A,I3,A)')         'DATA(BINARY) ',IBCFCB,' '//CHAR(39)//TRIM(LINE)//'_FBCF'//CHAR(39) 
 IF(LRCH)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IRCHCB,' '//CHAR(39)//TRIM(LINE)//'_FRCH'//CHAR(39) 
 IF(LEVT)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IEVTCB,' '//CHAR(39)//TRIM(LINE)//'_FEVT'//CHAR(39) 
 IF(LDRN.OR.LOLF)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IDRNCB,' '//CHAR(39)//TRIM(LINE)//'_FDRN'//CHAR(39) 
 IF(LRIV.OR.LISG)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IRIVCB,' '//CHAR(39)//TRIM(LINE)//'_FRIV'//CHAR(39) 
 IF(LGHB)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IGHBCB,' '//CHAR(39)//TRIM(LINE)//'_FGHB'//CHAR(39) 
 IF(LCHD)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',ICHDCB,' '//CHAR(39)//TRIM(LINE)//'_FCHD'//CHAR(39) 
 IF(LWEL)WRITE(IU,'(A,I3,A)') 'DATA(BINARY) ',IWELCB,' '//CHAR(39)//TRIM(LINE)//'_FWEL'//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
  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
 
 IERROR=0
 
 CALL WINDOWOUTSTATUSBAR(4,'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 iMOD V'//TRIM(RVERSION)
 WRITE(IUBAS,'(A,F15.7)') 'STOPERROR ',STOPER
 WRITE(IUBAS,'(A)') 'FREE'
 !## 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))
 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

 CALL WINDOWOUTSTATUSBAR(4,'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 iMOD V'//TRIM(RVERSION)
 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)LINE=TRIM(LINE)//' 1'
  IF(ILAY.EQ.NLAY)LINE=TRIM(LINE)//' 0'
 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
   IF(ILAY.GT.1   )TOP(ILAY)%X(ICOL,IROW)=MIN(BOT(ILAY-1)%X(ICOL,IROW)-MINTHICKNESS,TOP(ILAY)%X(ICOL,IROW))
   IF(ILAY.LT.NLAY)BOT(ILAY)%X(ICOL,IROW)=MIN(TOP(ILAY)%X(ICOL,IROW)-MINTHICKNESS  ,BOT(ILAY)%X(ICOL,IROW))
  ENDDO; ENDDO; 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
  EXFNAME=TRIM(DIR)//'\DIS6\BOTM_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(EXFNAME,BOT(ILAY),IINT,IU,HNOFLOW))RETURN
 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)CALL PMANAGER_SAMEMF2005_METASWAP(IDF%NCOL,IDF%NROW,NLAY,HNOFLOW,BND,IDF)

 !## use bcf6
 IF(LBCF)THEN
  CALL WINDOWOUTSTATUSBAR(4,'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
  CALL WINDOWOUTSTATUSBAR(4,'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 iMOD V'//TRIM(RVERSION)
  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   
   IF(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 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 iMOD V'//TRIM(RVERSION)
  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 iMOD V'//TRIM(RVERSION)
  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 iMOD V'//TRIM(RVERSION)
 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

  CALL WINDOWOUTSTATUSBAR(4,'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 iMOD V'//TRIM(RVERSION)
  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))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 :: ICOL,IROW,I,J,NIDF
 REAL :: DXY,ARND
 REAL,DIMENSION(:),ALLOCATABLE :: NODATA
 INTEGER,DIMENSION(:),ALLOCATABLE :: IERROR
 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')

 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,IERROR)
  
 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,IERROR)
 
 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,IERROR)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER,INTENT(IN) :: NCOL,NROW,NLAY
 REAL,DIMENSION(:),INTENT(IN) :: NODATA
 INTEGER,DIMENSION(:),INTENT(OUT) :: 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
 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); 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
  
 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)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,ITOPIC
 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
 
  !## get appropriate stress-period to store in runfile   
  IF(IPER.EQ.1)THEN
   KPER=PMANAGER_GETIPER(SIM(IPER  )%CDATE,SIM(IPER)%CDATE,TOPICS(ITOPIC)%STRESS)
  ELSE
   KPER=PMANAGER_GETIPER(SIM(IPER-1)%CDATE,SIM(IPER)%CDATE,TOPICS(ITOPIC)%STRESS)
  ENDIF
 
  !## 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,'(A)') '-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)); PCK(K,ISYS)%X=0.0
     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,28) !## 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 (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:28)
       CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,PCK(K,ISYS),HNOFLOW,FCT,IMP)
       CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,PCK(K,ISYS),1,ITOPIC)
     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,0)%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)'
                          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
 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
 CHARACTER(LEN=256) :: SFNAME,LINE,ID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=25) :: FRM
 INTEGER :: JU,KU,ILAY,IROW,ICOL,I,ITOP,ISYS,NROWIPF,NCOLIPF,IEXT,MP,IOS,MTYPE,IBATCH
 LOGICAL :: LIPF,LISG,LEX
 REAL,ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
  
 PMANAGER_SAVEMF2005_PCK_ULSTRD=.FALSE.

 CALL UTL_CREATEDIR(EXFNAME(:INDEX(EXFNAME,'\',.TRUE.)-1))
 
 LIPF=INDEX(EXFNAME,'\WEL7\').GT.0; LISG=INDEX(EXFNAME,'\ISG7\').GT.0
 
 !## 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
  SDATE=0; EDATE=0; MTYPE=1 !## mean value
 ELSE
  READ(SIM(IPER)%CDATE,*) SDATE
  SDATE=  UTL_IDATETOJDATE(SDATE)
  EDATE=SDATE+MAX(1,INT(SIM(IPER)%DELT))
  MTYPE=2  !## median value
 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

    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
      IF(IEXT.EQ.0)THEN
       READ(KU,*,IOSTAT=IOS) X,Y,Q,Z1,Z2
      ELSE
       READ(KU,*,IOSTAT=IOS) X,Y,ID,Z1,Z2
      ENDIF

      !## 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 PMANAGER_SAVEMF2005_PCK_GETTLP(NLAY,TLP,KH,TP,BT,Z1,Z2) 

     !## find uppermost layer
     ELSE

      IF(IEXT.EQ.0)THEN
       READ(KU,*,IOSTAT=IOS) X,Y,Q
      ELSE
       READ(KU,*,IOSTAT=IOS) X,Y,ID
      ENDIF
      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     
     
     !## 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.GT.0)THEN
      IF(.NOT.PMANAGER_SAVEMF2005_PCK_READTXT(2,SDATE,EDATE,MTYPE,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     

     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
     
    ENDDO
    CLOSE(KU)
    
   ELSE 
    
    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
     
     ILAY=PCK(1,ISYS)%ILAY
     !## assign to several layer
     IF(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 PMANAGER_SAVEMF2005_PCK_GETTLP(NLAY,TLP,KH,TP,BT,Z1,Z2) 

     !## find uppermost layer
     ELSE
      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
     
     WRITE(FRM,'(A9,I2.2,A14)') '(3(I5,1X),',NTOP,'(F15.7,1X),I5)'
     DO ILAY=1,NLAY
      !## not put into model layer
      IF(TLP(ILAY).LE.0.0)CYCLE
      !## 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))
       
      WRITE(JU,FRM) ILAY,IROW,ICOL,(PCK(JTOP(ITOP),ISYS)%X(ICOL,IROW),ITOP=1,NTOP),ISYS
      MP=MP+1
     
     ENDDO

    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_READTXT(ICOL,SDATE,EDATE,MTYPE,Q,FNAME) 
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: SDATE,EDATE,ICOL,MTYPE
 REAL,DIMENSION(:),ALLOCATABLE :: QSORT
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 REAL,INTENT(OUT) :: Q
 INTEGER :: IR,I,I1,I2,IU,NR,NC,IDATE,JDATE,NDATE,NAJ,N,IOS,TTIME,ITYPE,IZ,IZMIN,IZMAX,LUNIT,DIZ
 REAL :: FRAC,Q1,QQ,Z
 CHARACTER(LEN=8) :: ATTRIB
 CHARACTER(LEN=256) :: LINE
 REAL,DIMENSION(:),ALLOCATABLE :: NODATA,QD
 
 IF(EDATE.GT.SDATE)THEN
  TTIME=EDATE-SDATE
 ELSE
  LUNIT=1
  TTIME=ABS((EDATE*LUNIT)-(SDATE*LUNIT))
 ENDIF
 !## transient(2)/steady-state(1)
 ALLOCATE(QSORT(TTIME)); Q=0.0

 !## open textfiles with pump information
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ')
 
 READ(IU,*) NR
 IF(NR.GT.0.0)THEN
  READ(IU,'(A256)') LINE
  READ(LINE,*,IOSTAT=IOS) NC,ITYPE
  IF(IOS.NE.0)ITYPE=1
  ITYPE=MAX(ITYPE,1)
  
  ALLOCATE(NODATA(NC),QD(NC)); QD=0.0
  
  DO I=1,NC; READ(IU,*) ATTRIB,NODATA(I); ENDDO 

  QSORT=NODATA(ICOL)

  !## timeseries
  IF(ITYPE.EQ.1)THEN  

   I1=1
   DO IR=1,NR

    IF(IR.EQ.1)THEN
     READ(IU,*) IDATE,(QD(I),I=2,NC)
     QQ=QD(ICOL)
    ELSE
     QQ   =Q1
     IDATE=JDATE
    ENDIF

    !## edate=end date of current simulation period
    NDATE=EDATE
    IF(IR.LT.NR)THEN
     READ(IU,*) NDATE,(QD(I),I=2,NC) 
     Q1=QD(ICOL)
     JDATE=NDATE
     NDATE=UTL_IDATETOJDATE(NDATE) !## fname=optional for error message
    ENDIF
    !## ndate is min of end date in txt file or simulation period
    NDATE=MIN(NDATE,EDATE)

    !## is begin date read from txt file
    IDATE=UTL_IDATETOJDATE(IDATE)  !## fname=optional for error message

    !## stop searching for data, outside modeling window!
    IF(IDATE.GT.EDATE)EXIT

    !## within modeling window
    IF(NDATE.GT.SDATE)THEN

     !### defintions ($ time window current stressperiod)
     !  $        |---------|         $ 
     !sdate    idate     ndate     edate
    
     N=NDATE-SDATE
     !## if startingdate (read from txt file) greater than start date of current stressperiod
     IF(IDATE.GT.SDATE)N=N-(IDATE-SDATE)
     I2=I1+N-1
    
     IF(I2.GE.I1)QSORT(I1:I2)=QQ

     I1=I2+1

    ENDIF
   END DO
  
  ELSEIF(ITYPE.EQ.2.OR.ITYPE.EQ.3)THEN
   
   QQ=0.0; IZMAX=SDATE*LUNIT; IZMIN=EDATE*LUNIT; DIZ=(IZMAX-IZMIN)*LUNIT
   READ(IU,*) Z,(QD(I),I=2,NC)
   IZ=INT(Z*LUNIT); I1=IZMAX-IZ+1; Q1=QD(ICOL)
   DO IR=2,NR

    READ(IU,*) Z,(QD(I),I=2,NC)
    IZ=INT(Z*LUNIT)
    I2=IZMAX-IZ
    IF(I1.LE.DIZ.AND.I2.GT.0)THEN
     I2=MIN(DIZ,I2)
     I1=MAX(1,I1)
     QSORT(I1:I2)=Q1 
    ENDIF
    I1=I2+1; Q1=QD(ICOL)
    IF(I1.GT.DIZ)EXIT
       
   ENDDO
    
  ENDIF
  
  IF(MTYPE.EQ.1)THEN
   Q=0.0; I1=0
   DO I=1,TTIME
    IF(QSORT(I).NE.NODATA(ICOL))THEN; Q=Q+QSORT(I); I1=I1+1; ENDIF
   ENDDO
   IF(I1.GT.0)THEN
    Q=Q/REAL(I1)
   ELSE
    Q=NODATA(ICOL)
   ENDIF
  ELSEIF(MTYPE.EQ.2)THEN
   CALL UTL_GETMED(QSORT,TTIME,NODATA(ICOL),(/0.5/),1,NAJ,QD)
   Q=QD(1)
   !## naj becomes zero if no values were found!
   FRAC=REAL(NAJ)/REAL(TTIME)
   Q   =Q*FRAC
  ENDIF
  
 ENDIF
 
 PMANAGER_SAVEMF2005_PCK_READTXT=.TRUE.; IF(Q.EQ.NODATA(ICOL))PMANAGER_SAVEMF2005_PCK_READTXT=.FALSE.
 
 CLOSE(IU); DEALLOCATE(QSORT,NODATA,QD)
 
 END FUNCTION PMANAGER_SAVEMF2005_PCK_READTXT

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_PCK_GETTLP(N,TLP,KH,TOP,BOT,Z1,Z2)
 !###======================================================================
 IMPLICIT NONE
 REAL,PARAMETER :: MINP=0.0, MINKH=0.0
 INTEGER,INTENT(IN) :: N
 REAL,INTENT(INOUT) :: Z1,Z2
 REAL,INTENT(IN),DIMENSION(N) :: KH,TOP,BOT
 REAL,INTENT(INOUT),DIMENSION(N) :: TLP
 INTEGER :: JLAY,ILAY,K,IDIFF
 REAL :: ZM,ZT,ZB,ZC,FC,DZ
 REAL,ALLOCATABLE,DIMENSION(:) :: L,TL
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IL
   
 ALLOCATE(L(N),TL(N),IL(N))
 
 !## make sure thickness is not exactly zero, minimal thickness is 0.01m
 IDIFF=0; IF(Z1.EQ.Z2)THEN; Z1=Z1+0.005; Z2=Z2-0.005; IDIFF=1; ENDIF
 
 !## filterlength for each modellayer
 L=0.0
 DO ILAY=1,N
  ZT=MIN(TOP(ILAY),Z1); ZB=MAX(BOT(ILAY),Z2); L(ILAY)=MAX(0.0,ZT-ZB)
 ENDDO
 
 TLP=0.0
 !## well within any aquifer(s)
 IF(SUM(L).GT.0.0)THEN
  !## compute percentage and include sumkd, only if itype.eq.2
  L=L*KH
  !## percentage (0-1) L*KH
  DO ILAY=1,N; IF(L(ILAY).NE.0.0)TLP=(1.0/SUM(L))*L; ENDDO
 ENDIF

 !## correct for dismatch with centre of modelcell
 DO ILAY=1,N
  IF(TLP(ILAY).GT.0.0)THEN
   DZ= TOP(ILAY)-BOT(ILAY)
   ZC=(TOP(ILAY)+BOT(ILAY))/2.0
   ZT= MIN(TOP(ILAY),Z1)
   ZB= MAX(BOT(ILAY),Z2)
   FC=(ZT+ZB)/2.0
   TLP(ILAY)=TLP(ILAY)*(1.0-(ABS(ZC-FC)/(0.5*DZ)))
  ENDIF
 ENDDO
 
 !## normalize tlp() again
 IF(SUM(TLP).GT.0.0)TLP=(1.0/SUM(TLP))*TLP

 IF(MINP.GT.0.0)THEN
  !## remove small percentages
  DO ILAY=1,N; IF(TLP(ILAY).LT.MINP)TLP(ILAY)=0.0; ENDDO
  !## normalize tlp() again
  IF(SUM(TLP).GT.0.0)TLP=(1.0/SUM(TLP))*TLP
 ENDIF
 
 !## remove small permeabilities
 IF(MINKH.GT.0.0)THEN
  ZT=SUM(TLP) 
  DO ILAY=1,N; IF(KH(ILAY).LT.MINKH)TLP(ILAY)=0.0; ENDDO
  IF(SUM(TLP).GT.0.0)THEN
   ZT=ZT/SUM(TLP); TLP=ZT*TLP
  ENDIF
  !## normalize tlp() again
  IF(SUM(TLP).GT.0.0)TLP=(1.0/SUM(TLP))*TLP
 ENDIF

 !## if no layers has been used for the assignment, try to allocate it to the nearest 
 IF(SUM(TLP).EQ.0.0)THEN
  ZM=(Z1+Z2)/2.0; DZ=99999.0; JLAY=0
  DO ILAY=1,N
   ZT=TOP(ILAY); ZB=BOT(ILAY)
   IF(ABS(ZT-ZM).LT.DZ.OR.ABS(ZB-ZM).LT.DZ)THEN
    DZ  =MIN(ABS(ZT-ZM),ABS(ZB-ZM))
    JLAY=ILAY
   ENDIF
  ENDDO
  IF(JLAY.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'JLAY.EQ.0, Not able to assign proper modellayer','Error')
  TLP(JLAY)=-1.0
 ENDIF
 
 !## make sure only one layer is assigned whenever z1.eq.z2
 IF(IDIFF.EQ.1)THEN
  K=0; ZT=0.0; DO ILAY=1,N
   IF(ABS(TLP(ILAY)).GT.ZT)THEN
    ZT=ABS(TLP(ILAY)); K=ILAY
   ENDIF
  ENDDO
  IF(K.GT.0)THEN
   ZT=TLP(K)
   TLP=0.0; TLP(K)=1.0 
   IF(ZT.LT.0.0)TLP(K)=-1.0*TLP(K)
  ELSE
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'K.EQ.0, Not able to assign proper modellayer','Error')
  ENDIF
 ENDIF
 
 !## nothing in model, whenever system on top of model, put them in first modellayer
 IF(SUM(TLP).EQ.0.0)THEN
  IF(Z2.GE.TOP(1))TLP(1)=1.0
 ENDIF

 DEALLOCATE(L,TL,IL)
 
 END SUBROUTINE PMANAGER_SAVEMF2005_PCK_GETTLP

 !###======================================================================
 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_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
 REAL :: FCT,IMP
 
 PMANAGER_SAVEMF2005_MOD=.TRUE.

 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

 IF(ICNST.EQ.1)THEN
  IDF%X=TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%CNST
 ELSEIF(ICNST.EQ.2)THEN
!  EXFNAME=TRIM(DIR)//'\'//TRIM(EXT)//'_L'//TRIM(ITOS(ILAY))//FEXT(IIDEBUG)
  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
 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))
  IF(IINT.EQ.1)WRITE(IU,'(A)') 'CONSTANT '//TRIM(ITOS(INT(MAXV)))
  
 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
  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
 
 END SUBROUTINE PMANAGER_SAVEMF2005_FCTIMP

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_BND(BND)
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(INOUT) :: BND
 INTEGER :: IROW,ICOL
 
 !## 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
  
 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
 
 !## remove packages on constant head cells
 IF(ITYPE.EQ.1)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,JD2)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: JD1,JD2
 INTEGER :: I,II,J,K,IOS,IDATE,ID,IYR,JDP1,JDP2
 INTEGER,ALLOCATABLE,DIMENSION(:) :: JLIST

 NPER=JD2-JD1+1; ALLOCATE(JLIST(NPER)); JLIST=0
 !## fill in jd1 as first stressperiod and jd2 as last stressperiod
 JLIST(1)=1; JLIST(NPER)=1
  
 !## fill in list
 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
   !## check whether a period is available
   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(J)%IYR(1)-1
    DO II=PERIOD(J)%IYR(1),PERIOD(J)%IYR(2)
     IYR=IYR+1
     !## construct julian day for start of period
     JDP1=JD(IYR,PERIOD(J)%IDY(1),PERIOD(J)%IMH(1))
     ID  =JDP1-JD1+1; IF(ID.GT.0.AND.ID.LE.NPER)JLIST(ID)=1
     IF(PERIOD(J)%IMH(2).LT.PERIOD(J)%IMH(1))THEN
      IYR=IYR+1
     ELSEIF(PERIOD(J)%IMH(1).EQ.PERIOD(J)%IMH(2).AND.PERIOD(J)%IDY(2).LT.PERIOD(J)%IDY(1))THEN
      IYR=IYR+1
     ENDIF
     !## construct julian day for end of period
     JDP2=JD(IYR,PERIOD(J)%IDY(2),PERIOD(J)%IMH(2))
     ID  =JDP2-JD1+2; IF(ID.GT.0.AND.ID.LE.NPER)JLIST(ID)=1
    ENDDO
   ELSE
    READ(TOPICS(I)%STRESS(J)%CDATE,*,IOSTAT=IOS) IDATE; IF(IOS.NE.0)CYCLE
    ID=UTL_IDATETOJDATE(IDATE); ID=ID-JD1+1; IF(ID.GT.0.AND.ID.LE.NPER)JLIST(ID)=1
   ENDIF
  ENDDO
 ENDDO

 !## count dates available
 NPER=0; DO I=1,SIZE(JLIST); IF(JLIST(I).EQ.1)NPER=NPER+1; ENDDO
  
 IF(NPER.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No stress-periods found in the packages.','Warning')
 ELSE
 
  ALLOCATE(IDT(NPER))
  NPER=0; DO I=1,SIZE(JLIST)
   IF(JLIST(I).EQ.1)THEN; NPER=NPER+1; IDT(NPER)=I+JD1-1; ENDIF
  ENDDO
 
 ENDIF
 
 DEALLOCATE(JLIST)
 
 END SUBROUTINE PMANAGER_GETNPER
 
 !###======================================================================
 INTEGER FUNCTION PMANAGER_GETIPER(CDATE1,CDATE2,STRESS)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: CDATE1,CDATE2
 TYPE(STRESSOBJ),INTENT(IN),DIMENSION(:) :: STRESS
 INTEGER :: I,J,K,IDATE,JD1,JD2,JDI,MD,ID,IOS,IYR,JDP1,JDP2

 !## initially nothing found
 PMANAGER_GETIPER=0

 !## look for steady-state
 IF(TRIM(UTL_CAP(CDATE2,'U')).EQ.'STEADY-STATE')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
  JD2=0  ; READ(CDATE2,*,IOSTAT=IOS) IDATE; IF(IOS.EQ.0)JD2=UTL_IDATETOJDATE(IDATE)
  JD1=JD2; READ(CDATE1,*,IOSTAT=IOS) IDATE; IF(IOS.EQ.0)JD1=UTL_IDATETOJDATE(IDATE)
!  !## might be a sequence of steady-state
!  IF(JD1.EQ.JD2)THEN
!   !## apply minus one
!   ID=-1
!  ELSE
  !## look for nearest package to current timestep
  MD=10E5; 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
    !## loop over years
    IYR=PERIOD(J)%IYR(1)-1
    DO K=PERIOD(J)%IYR(1),PERIOD(J)%IYR(2)
     IYR=IYR+1
     !## construct julian day for start of period
     JDP1=JD(IYR,PERIOD(J)%IDY(1),PERIOD(J)%IMH(1))
     IF(PERIOD(J)%IMH(2).LT.PERIOD(J)%IMH(1))THEN
      IYR=IYR+1
     ELSEIF(PERIOD(J)%IMH(1).EQ.PERIOD(J)%IMH(2).AND.PERIOD(J)%IDY(2).LT.PERIOD(J)%IDY(1))THEN
      IYR=IYR+1
     ENDIF
     !## construct julian day for end of period
     JDP2=JD(IYR,PERIOD(J)%IDY(2),PERIOD(J)%IMH(2))
     IF(JD2.GE.JDP1.AND.JD2.LE.JDP2)THEN
      !## if inside period, set equal to start of period
      JDI=JDP1; EXIT
     ELSE
      !## if outside, set equal to stressperiod+1
      JDI=JD2+1
     ENDIF
    ENDDO
   ELSE
    READ(STRESS(I)%CDATE,*,IOSTAT=IOS) IDATE
    !## error reading date
    IF(IOS.NE.0)CYCLE
    !## current date
    JDI=UTL_IDATETOJDATE(IDATE)
   ENDIF
   !## defined before/equal to current timestep and after previous timestep
   IF(JD2-JDI.LE.MD.AND.JD2-JDI.GE.0)THEN
    MD=JD2-JDI
    IF(JDI.GT.JD1.OR.JD1.EQ.JD2)THEN
     ID= I
    ELSE
     ID=-I
    ENDIF
   ENDIF
   ENDDO
 ENDIF
 !## nothing found ???
 IF(ID.EQ.0)THEN
  PMANAGER_GETIPER=0
 !## use previous input
 ELSEIF(ID.LT.0)THEN
  PMANAGER_GETIPER=-1
 !## number of systems for current stress period
 ELSE
  PMANAGER_GETIPER=ID !SIZE(STRESS(ID)%FILES,2)
 ENDIF
 
 END FUNCTION PMANAGER_GETIPER

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_INITSIM(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(OUT) :: FNAME
 INTEGER :: ITYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: IDY,IYR,IMH,ITOPIC,IPER,I,J,MINJD,MAXJD,IOS,IDATE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 LOGICAL :: LEX
 
 PMANAGER_INITSIM=.FALSE.
 
 CALL WDIALOGLOAD(ID_DPMANAGER_SIM,ID_DPMANAGER_SIM)

 CALL WDIALOGPUTMENU(IDF_MENU4,(/'Daily   ','Weekly  ','Monthly ','Yearly  ','Packages'/),5,1)

 CALL PMANAGER_GETNLAY()
 
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MXNLAY)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER1,1,MXNLAY)
 
 ISTEADY=0; MINJD=10E7; MAXJD=-10E7
 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
    READ(TOPICS(ITOPIC)%STRESS(IPER)%CDATE,*,IOSTAT=IOS) IDATE
    IF(IOS.EQ.0)THEN
     CALL IDATETOGDATE(IDATE,IYR,IMH,IDY)
     IDATE=UTL_IDATETOJDATE(IYR*10000+IMH*100+IDY)
     MINJD=MIN(MINJD,IDATE); MAXJD=MAX(MAXJD,IDATE)
    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

  ENDDO
 ENDDO
 
 !## no transient data found
 IF(MINJD.GT.MAXJD)THEN
  IF(ISTEADY.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No steady-state or transient data found','Warning')
  IMH=3; IYR=1970; IDY=8
  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 WDIALOGPUTMENU(IDF_MENU3,CDATE,12,IMH)
  CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IDY)
  CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IYR)
 !## 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 UTL_GDATE(MAXJD,IYR,IMH,IDY)
  CALL WDIALOGPUTMENU(IDF_MENU3,CDATE,12,IMH)
  CALL WDIALOGPUTINTEGER(IDF_INTEGER4,IDY)
  CALL WDIALOGPUTINTEGER(IDF_INTEGER5,IYR)
 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_REAL1,IDF(1)%XMIN,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL2,IDF(1)%YMIN,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL3,IDF(1)%XMAX,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL4,IDF(1)%YMAX,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL5,IDF(1)%DX,'(F15.7)') 
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 !## modflow2005 does not allow thickness of zero
 CALL WDIALOGPUTREAL(IDF_REAL5,MINTHICKNESS,'(F15.7)') 

 CALL WDIALOGPUTREAL(IDF_REAL1,553000.0,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL2,5796000.0,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL3,577000.0,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL4,5808000.0,'(F15.7)') 
 CALL WDIALOGPUTREAL(IDF_REAL5,250.0,'(F15.7)') 

 CALL WDIALOGPUTSTRING(IDF_STRING1,MODELNAME)

 CALL PMANAGER_INITSIM_FIELDS()
 
 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,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_PACKAGE)
      CALL PMANAGER_INITSIM_PACKAGES()
      CALL PMANAGER_INITSIM_FIELDS()
     CASE (IDOK)
      !## fill timesteps
      IF(PMANAGER_FILLTIMESTEPS())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

 !## apply submodelling
 CALL WDIALOGGETCHECKBOX(IDF_CHECK3,ISUBMODEL)
 SUBMODEL=0.0; IF(ISUBMODEL.EQ.1)THEN
  CALL WDIALOGGETREAL(IDF_REAL1,SUBMODEL(1))
  CALL WDIALOGGETREAL(IDF_REAL2,SUBMODEL(2))
  CALL WDIALOGGETREAL(IDF_REAL3,SUBMODEL(3))
  CALL WDIALOGGETREAL(IDF_REAL4,SUBMODEL(4))
  CALL WDIALOGGETREAL(IDF_REAL5,SUBMODEL(5))
 ENDIF
 CALL WDIALOGGETREAL(IDF_REAL6,MINTHICKNESS)
 !## get steady-state in transient mode
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,ISTEADY)
 !## 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.
 !## 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_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,IYR,IMH,IDY,ISS

 PMANAGER_FILLTIMESTEPS=.FALSE.

 IF(ALLOCATED(SIM))DEALLOCATE(SIM)
 
 !## get steady-=transient simulation option, ISS=1 steady, ISS=2 transient
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ISS)

 IF(ISS.EQ.2)THEN
 
  CALL UTL_FILLDATES(IDF_INTEGER3,IDF_MENU2,IDF_INTEGER2,JD1)
  CALL UTL_FILLDATES(IDF_INTEGER5,IDF_MENU3,IDF_INTEGER4,JD2)
  !## get periods 1=Daily,2=Weekly,3=Monthly,4=Yearly
  CALL WDIALOGGETMENU(IDF_MENU4,IPERIOD)
  SELECT CASE (IPERIOD)
   CASE (1) !## daily
    NPER=JD2-JD1; NPER=NPER+1; ALLOCATE(IDT(NPER)); IDT=0
    IDT(1)=JD1; I=1; DO; I=I+1; IDT(I)=IDT(I-1)+1; IF(IDT(I).GE.JD2)EXIT; ENDDO
    IDT(I)=MIN(IDT(I),JD2)
   CASE (2) !## weekly
    NPER=JD2-JD1; NPER=NPER+1; NPER=CEILING(REAL(NPER)/7.0)+1; ALLOCATE(IDT(NPER)); IDT=0
    IDT(1)=JD1; I=1; DO; I=I+1; IDT(I)=IDT(I-1)+7; IF(IDT(I).GE.JD2)EXIT; ENDDO
    IDT(I)=MIN(IDT(I),JD2)
   CASE (3) !## monthly
    NPER=JD2-JD1; NPER=NPER+1; NPER=CEILING(REAL(NPER)/28.0)+1; ALLOCATE(IDT(NPER)); IDT=0
      IDT(1)=JD1; I=1; DO; I=I+1
     CALL UTL_GDATE(IDT(I-1),IYR,IMH,IDY)
      IDT(I)=IDT(I-1)+WDATEDAYSINMONTH(IYR,IMH)
     IF(IDT(I).GE.JD2)EXIT
    ENDDO
    IDT(I)=MIN(IDT(I),JD2)
   CASE (4) !## yearly
    NPER=JD2-JD1; NPER=NPER+1; NPER=CEILING(REAL(NPER)/360.0)+1; ALLOCATE(IDT(NPER)); IDT=0
    IDT(1)=JD1; I=1; DO; I=I+1
     CALL UTL_GDATE(IDT(I-1),IYR,IMH,IDY)
     IDT(I)=IDT(I-1); DO I=1,12
      IDT(I)=IDT(I-1)+WDATEDAYSINMONTH(IYR,IMH)
      IF(IDT(I).GE.JD2)EXIT
      IMH=IMH+1; IF(IMH.GT.12)THEN; IMH=1; IYR=IYR+1; ENDIF
     ENDDO
    ENDDO
    IDT(I)=MIN(IDT(I),JD2)
   CASE (5) !## packages
    CALL PMANAGER_GETNPER(JD1,JD2)
  END SELECT
  IF(NPER.GT.0)THEN
   !## determine nper
   DO I=1,SIZE(IDT); IF(IDT(I).EQ.0)EXIT; ENDDO; NPER=I-1
 !   EXIT
  ENDIF
 
  !## use initial steady-state step
  NPER=NPER+ISTEADY

  ALLOCATE(SIM(NPER))
  IF(ISTEADY.EQ.1)THEN
   SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0
  ENDIF
  DO I=1,NPER-ISTEADY
   SIM(I+ISTEADY)%CDATE=TRIM(ITOS(UTL_JDATETOIDATE(IDT(I))))
   IF(I+ISTEADY.GE.SIZE(IDT))THEN
    SIM(I+ISTEADY)%DELT =0.0
   ELSE
    SIM(I+ISTEADY)%DELT =IDT(I+1)-IDT(I)
   ENDIF
   SIM(I+ISTEADY)%ISAVE=1
   SIM(I+ISTEADY)%ISUM =0
  ENDDO
  NPER=NPER-ISTEADY-1 !## last period should not be included, it is the enddate!
  IF(ALLOCATED(IDT))DEALLOCATE(IDT)
 
 ELSE
 
  NPER=1; ALLOCATE(SIM(NPER))
  SIM(1)%CDATE='STEADY-STATE'; SIM(1)%DELT=0.0; SIM(1)%ISAVE=1; SIM(1)%ISUM=0

 ENDIF
 
 PMANAGER_FILLTIMESTEPS=.TRUE.

 END FUNCTION PMANAGER_FILLTIMESTEPS

 !###======================================================================
 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,'Model will simulate 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_LABEL9,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL10,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL11,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_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_STRING1,ABS(I-1))

 CALL WDIALOGFIELDSTATE(IDF_LABEL8,I)
 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

 READ(IU,*,IOSTAT=IOS); IF(IOS.NE.0)RETURN
 READ(IU,*,IOSTAT=IOS) NLAY,NLAY,NPER; IF(IOS.NE.0)RETURN
 
 !## 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
      
    !## create stress-period
    IPER=0; CALL PMANAGER_STRESSES(ITOPIC,IPER)
    !## create systems
    ALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES(TOPICS(ITOPIC)%NSUBTOPICS,NSYS))

    IF(TOPICS(ITOPIC)%TIMDEP)TOPICS(ITOPIC)%STRESS(IPER)%CDATE=CDATE
    
    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,J,K,N,M
 CHARACTER(LEN=256) :: CNAME,STRING
 
 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
   STRING=TRIM(STRING)//CHAR(13)//'idf='//TRIM(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
   DEALLOCATE(TOPICS(ITOPIC)%STRESS(IPER)%FILES) 
   DEALLOCATE(TOPICS(ITOPIC)%STRESS)
  ENDIF
  
  !## 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
    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
 CHARACTER(LEN=52) :: CNAME
 
 CALL WDIALOGSELECT(ID_DPMANAGER)
 CALL WDIALOGGETTREEVIEW(ID_TREEVIEW1,ID,CNAME)
 ID=MAX(ID,0); I=1; IF(ID.EQ.0)I=0

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

! !#not able to remove main-topics
! DO J=1,MAXTOPICS
!  IF(ID.EQ.TOPICS(J)%ID)I=0
! END DO
! CALL WDIALOGFIELDSTATE(ID_DELETE,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
 
 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)%IH+TOPICS(I)%STRESS(IPER)%IM+TOPICS(I)%STRESS(IPER)%IS.GT.0)THEN
      WRITE(STRING,'(A,3(A1,I2.2))') TRIM(TOPICS(I)%STRESS(IPER)%CDATE),' ', &
            TOPICS(I)%STRESS(IPER)%IH,':',TOPICS(I)%STRESS(IPER)%IM,':',TOPICS(I)%STRESS(IPER)%IS
     ELSE
      WRITE(STRING,'(A)') 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
      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
       STRING=TRIM(STRING)//';idf='//TRIM(TOPICS(I)%STRESS(IPER)%FILES(J,K)%ALIAS)
      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))
      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 ='(MSP) MetaSwap [UZF]'
 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='(CON) Concentration [-]'
 TOPICS(18)%TNAME='(SFT) StreamFlow Thickness [-]'
 TOPICS(19)%TNAME='(CPP) Common Pointer Package [-]'
 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=1  !CON
 TOPICS(18)%NSUBTOPICS=2  !SFT
 TOPICS(19)%NSUBTOPICS=1  !CPP
 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. !CON
 TOPICS(18)%TIMDEP=.FALSE. !SFT
 TOPICS(19)%TIMDEP=.FALSE. !CPP
 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)='Concentration (IDF)'
 TOPICS(18)%SNAME(1)='Stream Flow Thickness (IDF)'
 TOPICS(18)%SNAME(2)='Permeability (IDF)'
 TOPICS(19)%SNAME(1)='Common Pointer (IDF)'
 TOPICS(20)%SNAME(1)='Parameters Estimation Parameters'
 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 Level (IDF)'
 TOPICS(23)%SNAME(3)='Riverbottom Level (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
 CALL PMANAGERUPDATE(0,0,0)
 CALL PMANAGERFIELDS()

 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
 
 !#####=================================================================
 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