!!  Copyright (C) Stichting Deltares, 2005-2022.
!!
!!  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_MF2005

USE WINTERACTER
USE RESOURCE
USE MOD_PMANAGER_PAR
USE MOD_PMANAGER_UTL
USE MOD_IPEST_GLM, ONLY : IPEST_GLM_READ_ARRFILE
USE IMODVAR 
USE MOD_IDF 
USE MOD_UTL
USE MOD_IDF_PAR
USE MOD_ISG_PAR
USE MOD_ISG_GRID
USE MOD_ISG_UTL
USE MOD_POLINT
USE MOD_QKSORT
USE MOD_ASC2IDF_HFB
USE MOD_ASC2IDF_PAR 
USE MOD_ASC2IDF_UTL
USE MOD_OSD
USE MOD_IPEST_GLM, ONLY : IPEST_GLM_SETGROUPS,IPEST_GLM_READ_ZONES_OPENFILE
USE MOD_PKS, ONLY : PKS_INIT

TYPE DFFMGRIDOBJ
 INTEGER,POINTER,DIMENSION(:) :: ID
 INTEGER :: NID
END TYPE DFFMGRIDOBJ
TYPE DFFMOBJ
 REAL(KIND=DP_KIND) :: X,Y
 INTEGER :: ISEG,INODE,IZONE
END TYPE DFFMOBJ
TYPE(DFFMOBJ),ALLOCATABLE,DIMENSION(:),PRIVATE :: DFFM
TYPE(DFFMGRIDOBJ),ALLOCATABLE,DIMENSION(:,:) :: DFFMGRID
TYPE IPFMSPOBJ
 INTEGER :: ILAY
 REAL(KIND=DP_KIND) :: X,Y,CAP
END TYPE IPFMSPOBJ
TYPE(IPFMSPOBJ),ALLOCATABLE,DIMENSION(:) :: IPFMSP
TYPE IPFFLXOBJ
 INTEGER :: IL
 REAL(KIND=DP_KIND) :: XS,YS,CAP,HTL,LTL,XE,YE,ZE
END TYPE IPFFLXOBJ
TYPE(IPFFLXOBJ),ALLOCATABLE,DIMENSION(:) :: IPFFLX

CONTAINS
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEPST(IU,IOPTION,DIR,ISS,IITER)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,IOPTION,ISS,IITER
 CHARACTER(LEN=*),INTENT(IN) :: DIR
 INTEGER :: I,N,M,SCL_UP,SCL_D,IOS,ICOL,IROW
 REAL(KIND=DP_KIND) :: Z
! REAL(KIND=DP_KIND),DIMENSION(:,:,:),ALLOCATABLE :: CNT
 
 PMANAGER_SAVEPST=.FALSE.
 
 !## write model dimensions into pst file
 IF(IOPTION.EQ.2)THEN
  WRITE(IU,*) PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,PRJNPER,ISS
  WRITE(IU,*) PRJIDF%XMIN,PRJIDF%YMIN,PRJIDF%XMAX,PRJIDF%YMAX,PRJIDF%IEQ
  IF(PRJIDF%IEQ.EQ.0)THEN
   WRITE(IU,*) PRJIDF%DX
  ELSE
   WRITE(IU,*) (PRJIDF%SX(ICOL),ICOL=0,PRJIDF%NCOL)
   WRITE(IU,*) (PRJIDF%SY(IROW),IROW=0,PRJIDF%NROW)
  ENDIF
 ENDIF
 
 IF(IOPTION.NE.1)THEN
  IF(ASSOCIATED(PEST%MEASURES))THEN
   I=SIZE(PEST%MEASURES)
   IF(PEST%IIPF.EQ.1)I=-1*I
   LINE=TRIM(ITOS(I))
   WRITE(IU,'(A)') TRIM(LINE)
   DO I=1,SIZE(PEST%MEASURES)
    LINE=CHAR(39)//TRIM(PEST%MEASURES(I)%IPFNAME)//CHAR(39)//','// &
         TRIM(ITOS(PEST%MEASURES(I)%IPFTYPE))//','// &
         TRIM(ITOS(PEST%MEASURES(I)%IXCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IYCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%ILCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IMCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IVCOL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IZ1CL))  //','// &
         TRIM(ITOS(PEST%MEASURES(I)%IZ2CL))
    IF(PEST%MEASURES(I)%IDCOL.GT.0)LINE=TRIM(LINE)//','//TRIM(ITOS(PEST%MEASURES(I)%IDCOL))
    WRITE(IU,'(A)') TRIM(LINE)
   ENDDO
  ELSE 
   LINE=TRIM(ITOS(0))
   WRITE(IU,'(A)') TRIM(LINE)
  ENDIF
 ENDIF
  
 IF(IOPTION.EQ.2)THEN
  IF(PBMAN%IIES.EQ.0)THEN
   LINE=TRIM(ITOS(SIZE(PEST%PARAM)))
  ELSE
   LINE='0'
  ENDIF
  WRITE(IU,'(A)') TRIM(LINE)
 ENDIF
 
 N=0; IF(ASSOCIATED(PEST%S_PERIOD))  N=SIZE(PEST%S_PERIOD)
 M=0; IF(ASSOCIATED(PEST%B_FRACTION))M=SIZE(PEST%B_FRACTION)
 
 I=PEST%PE_MXITER; IF(IITER.EQ.-1.AND.PBMAN%IPESTP.EQ.1)I=-1
 LINE=TRIM(ITOS(I))                      //','//TRIM(RTOS(PEST%PE_STOP,'G',7))     //','// &
      TRIM(RTOS(PEST%PE_SENS,'G',7))     //','//TRIM(ITOS(N))                      //','// &
      TRIM(ITOS(M))                      //','//TRIM(RTOS(PEST%PE_TARGET(1),'G',7))//','// &
      TRIM(RTOS(PEST%PE_TARGET(2),'G',7))//','//TRIM(ITOS(PEST%PE_SCALING))        //','// &
      TRIM(RTOS(PEST%PE_PADJ,'G',7))     //','//TRIM(RTOS(PEST%PE_DRES,'G',7))     //','// &
      TRIM(ITOS(PEST%PE_KTYPE))          //','//TRIM(RTOS(PEST%PE_KRANGE,'G',7))   //','// &
      TRIM(ITOS(PEST%PE_REGULARISATION))
      
 WRITE(IU,'(A)') TRIM(LINE)

 !## write blankout idf
 IF(PEST%PE_KTYPE.LT.0)THEN
  IF(IOPTION.EQ.1)THEN
   WRITE(IU,'(A)') TRIM(PEST%PPBNDIDF)
  ELSEIF(IOPTION.EQ.2)THEN
   !## upscale is using number 7 most frequent
   SCL_UP=7; SCL_D=0
   !## read/clip/scale idf file
   IF(.NOT.IDFREADSCALE(PEST%PPBNDIDF,PRJIDF,SCL_UP,SCL_D,1.0D0,0))RETURN
   !## save array, do not correct for boundary condition as we not yet know for what layer the zone will apply
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\PST1\PPBNDIDF.ARR',PRJIDF,0,IU,1,0))RETURN
  ENDIF
 ENDIF
 
 IF(N.GT.0)THEN
  DO I=1,SIZE(PEST%S_PERIOD)
   LINE=TRIM(PEST%S_PERIOD(I))//','//TRIM(PEST%E_PERIOD(I))
   WRITE(IU,'(A)') TRIM(LINE)   
  ENDDO
 ENDIF
 
 IF(M.GT.0)THEN
  DO I=1,SIZE(PEST%B_FRACTION)
   LINE=TRIM(RTOS(PEST%B_FRACTION(I),'G',7))//','//CHAR(39)//TRIM(PEST%B_BATCHFILE(I))//CHAR(39)//','//CHAR(39)//TRIM(PEST%B_OUTFILE(I))//CHAR(39)
   WRITE(IU,'(A)') TRIM(LINE)   
  ENDDO
 ENDIF

 IF(ASSOCIATED(PEST%PARAM))THEN
  DO I=1,SIZE(PEST%PARAM)
   LINE=TRIM(ITOS(PEST%PARAM(I)%PACT))           //','// &
        TRIM(PEST%PARAM(I)%PPARAM)               //','// &
        TRIM(ITOS(PEST%PARAM(I)%PILS))           //','// &
        TRIM(ITOS(PEST%PARAM(I)%PIZONE))         //','// &    
        TRIM(RTOS(PEST%PARAM(I)%PINI,'G',7))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PDELTA,'G',7))   //','// &
        TRIM(RTOS(PEST%PARAM(I)%PMIN,'G',7))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PMAX,'G',7))     //','// &
        TRIM(RTOS(PEST%PARAM(I)%PINCREASE,'G',7))//','// &
        TRIM(ITOS(ABS(PEST%PARAM(I)%PIGROUP)))   //','// &
        TRIM(ITOS(PEST%PARAM(I)%PLOG))           //','// &
        '"'//TRIM(PEST%PARAM(I)%ACRONYM)        //'",'// &
        TRIM(RTOS(PEST%PARAM(I)%PPRIOR,'G',7))
    IF(PEST%PARAM(I)%PARSTD.EQ.0.0)THEN
     SELECT CASE (PEST%PARAM(I)%PLOG)
      CASE (0)
       PEST%PARAM(I)%PARSTD=PEST%PARAM(I)%PMAX-PEST%PARAM(I)%PMIN
      CASE (1)
       PEST%PARAM(I)%PARSTD=LOG(PEST%PARAM(I)%PMAX)-LOG(PEST%PARAM(I)%PMIN)
      CASE (2)
       PEST%PARAM(I)%PARSTD=LOG10(PEST%PARAM(I)%PMAX)-LOG10(PEST%PARAM(I)%PMIN)
     END SELECT
    ENDIF
    PEST%PARAM(I)%PARSTD=PEST%PARAM(I)%PARSTD/4.0
    LINE=TRIM(LINE)//','//TRIM(RTOS(PEST%PARAM(I)%PARSTD,'G',7))
    IF(PEST%PARAM(I)%SDATE.NE.'')LINE=TRIM(LINE)//','//TRIM(PEST%PARAM(I)%SDATE)//','// &        
                                                       TRIM(PEST%PARAM(I)%EDATE)
   IF(PBMAN%IIES.EQ.0)WRITE(IU,'(A)') TRIM(LINE)
  ENDDO
 ENDIF

 WRITE(6,'(A)') '+Reading/writing PST-files ...'
 
 IF(ASSOCIATED(PEST%IDFFILES))THEN
  LINE=TRIM(ITOS(SIZE(PEST%IDFFILES)))
  WRITE(IU,'(A)') TRIM(LINE)    
  
!  !## track zone defition not to succeed 100% per cell
!  ALLOCATE(CNT(PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY)); CNT=0.0D0

  DO I=1,SIZE(PEST%IDFFILES)

   WRITE(6,'(A)') '+Reading/writing PST-files ('//TRIM(RTOS(REAL(100*I,8)/REAL(SIZE(PEST%IDFFILES),8),'F',2))//'%)'     
   LINE=TRIM(PEST%IDFFILES(I))
  
   IF(IOPTION.EQ.2)THEN
    Z=INT(UTL_GETREAL(LINE,IOS))
    IF(IOS.EQ.0)THEN
     PRJIDF%X=Z
     !## save array, do not correct for boundary condition as we not yet know for what layer the zone will apply
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\PST1\ZONE_IZ'//TRIM(ITOS(I))//'.ARR',PRJIDF,0,IU,1,0))RETURN
    ELSE
     !## read idf
     IF(INDEX(UTL_CAP(LINE,'U'),'.IDF',.TRUE.).GT.0)THEN
      !## upscale is using number 15 is not completely correct but for reasons of backward compatibility. Undesired results can be overcome through additional file
      PRJIDF%FNAME=LINE; SCL_UP=15; SCL_D=0
      !## read/clip/scale idf file
      IF(.NOT.IDFREADSCALE(PRJIDF%FNAME,PRJIDF,SCL_UP,SCL_D,1.0D0,0))RETURN
      !## replace nodata for zero
      DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
       IF(PRJIDF%X(ICOL,IROW).EQ.PRJIDF%NODATA)PRJIDF%X(ICOL,IROW)=0.0D0
!       CNT(ICOL,IROW,ILAY)
      ENDDO; ENDDO
      !## save array, do not correct for boundary condition as we not yet know for what layer the zone will apply
      IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\PST1\ZONE_IZ'//TRIM(ITOS(I))//'.ARR',PRJIDF,0,IU,1,0))RETURN
     ELSE
      WRITE(IU,'(A)') CHAR(39)//TRIM(LINE)//CHAR(39)
     ENDIF
    ENDIF
   ELSE
    WRITE(IU,'(A)') CHAR(39)//TRIM(LINE)//CHAR(39)
   ENDIF
   
  ENDDO
!  DEALLOCATE(CNT)
 ELSE
  WRITE(IU,'(A)') '0'
 ENDIF
 
 PMANAGER_SAVEPST=.TRUE.

 END FUNCTION PMANAGER_SAVEPST
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEPST_MF6_SEAWAT(DIR,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR
 INTEGER,INTENT(IN) :: IBATCH
 TYPE ZONEOBJ
  REAL(KIND=4),POINTER,DIMENSION(:,:) :: X
  REAL(KIND=8),POINTER,DIMENSION(:,:) :: XY
  INTEGER,POINTER,DIMENSION(:) :: IZ
  INTEGER :: ZTYPE  !## ztype=0 idf, ztype=1 ipf (ppoint)
 END TYPE ZONEOBJ
 LOGICAL :: LREUSEDAT
 REAL(KIND=DP_KIND) :: Z,F
 INTEGER :: SCL_D,SCL_UP,IOS,IROW,ICOL,JU,I,J,K,NIPF,MIPF,NUZONE,IZ,ND
 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: NLOCS
 INTEGER,ALLOCATABLE,DIMENSION(:) :: NUZ,ILOCS
 TYPE(ZONEOBJ),ALLOCATABLE,DIMENSION(:) :: ZONE
 
 PMANAGER_SAVEPST_MF6_SEAWAT=.FALSE.
 
! INQUIRE(FILE=NAMFILE(:INDEX(NAMFILE,'\',.TRUE.)-1)//'\PARAM_DUMP_IPEST.DAT',EXIST=LEX)
! IF(LEX)CALL IOSDELETEFILE(NAMFILE(:INDEX(NAMFILE,'\',.TRUE.)-1)//'\PARAM_DUMP_IPEST.DAT')

 !## compute zone distribution
 INQUIRE(FILE=TRIM(DIR)//'\PARAM_DUMP_IPEST.DAT',EXIST=LREUSEDAT)
 
 LREUSEDAT=.FALSE.
 
 IF(LREUSEDAT)THEN
  IF(IBATCH.EQ.1)THEN
   !## try to open them and check them
   IF(IPEST_GLM_READ_ZONES_OPENFILE(DIR,JU,ICOL,IROW))THEN
    WRITE(*,'(/A)') 'Read zones assigned to parameters from the file:'
    WRITE(*,'(A/)') TRIM(DIR)//'\PARAM_DUMP_IPEST.DAT'
    PMANAGER_SAVEPST_MF6_SEAWAT=.TRUE.; RETURN
   ENDIF
  ENDIF
 ENDIF

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

 WRITE(6,'(A)') '+Reading Zones'

 IF(ASSOCIATED(PEST%IDFFILES))THEN
  ALLOCATE(ZONE(SIZE(PEST%IDFFILES)))
  LINE=TRIM(ITOS(SIZE(PEST%IDFFILES)))
  DO I=1,SIZE(PEST%IDFFILES)
   NULLIFY(ZONE(I)%X,ZONE(I)%XY,ZONE(I)%IZ) 

   WRITE(6,'(A)') '+Reading Zones ('//TRIM(RTOS(REAL(100*I,8)/REAL(SIZE(PEST%IDFFILES),8),'F',2))//'%)         '     
   LINE=TRIM(PEST%IDFFILES(I))
  
   Z=UTL_GETREAL(LINE,IOS)
   IF(IOS.EQ.0)THEN
    ALLOCATE(ZONE(I)%X(PRJIDF%NCOL,PRJIDF%NROW))
    ZONE(I)%ZTYPE=0; ZONE(I)%X=Z
   ELSE
    !## read idf
    IF(INDEX(UTL_CAP(LINE,'U'),'.IDF',.TRUE.).GT.0)THEN
     !## upscale is using number 15 is not completely correct but for reasons of backward compatibility. Undesired results can be overcome through additional file
     PRJIDF%FNAME=LINE; SCL_UP=15; SCL_D=0
     !## read/clip/scale idf file
     IF(.NOT.IDFREADSCALE(PRJIDF%FNAME,PRJIDF,SCL_UP,SCL_D,1.0D0,0))RETURN
     !## replace nodata for zero
     DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
      IF(PRJIDF%X(ICOL,IROW).EQ.PRJIDF%NODATA)PRJIDF%X(ICOL,IROW)=0.0D0
     ENDDO; ENDDO
     ALLOCATE(ZONE(I)%X(PRJIDF%NCOL,PRJIDF%NROW))
     ZONE(I)%ZTYPE=0; ZONE(I)%X=PRJIDF%X
    ELSEIF(INDEX(UTL_CAP(LINE,'U'),'.IPF').GT.0)THEN
     ZONE(I)%ZTYPE=1
     !## read in ipf
     JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=LINE,STATUS='OLD',ACTION='READ',FORM='FORMATTED')
     READ(JU,*) NIPF; READ(JU,*) MIPF; DO K=1,MIPF+1; READ(JU,*); ENDDO
     ALLOCATE(ZONE(I)%XY(NIPF,2),ZONE(I)%IZ(NIPF))  
     DO K=1,NIPF; READ(JU,*) ZONE(I)%XY(K,1),ZONE(I)%XY(K,2),ZONE(I)%IZ(K); ENDDO  
     CLOSE(JU)
    ELSE
     WRITE(*,'(/A/)') 'No supported file format found'; RETURN
    ENDIF
   ENDIF
  
  ENDDO
 ELSE
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to insert minimal a single zone','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(/A)') 'You need to insert minimal a single zone'
  RETURN
 ENDIF
 
 !## get number of unique zones
 ALLOCATE(NUZ(SIZE(PEST%PARAM))); NUZ=0
 DO I=1,SIZE(PEST%PARAM); NUZ(I)=PEST%PARAM(I)%PIZONE; ENDDO
 CALL UTL_GETUNIQUE_INT(NUZ,SIZE(PEST%PARAM),NUZONE,0)
 
 IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Found '//TRIM(ITOS(NUZONE))//' unique zones, getting number of location per zone ...'
 
 ALLOCATE(ILOCS(NUZ(NUZONE))); ILOCS=0
 ALLOCATE(NLOCS(NUZONE,SIZE(ZONE))); NLOCS=0
 !## set reference to zones
 DO I=1,NUZONE; ILOCS(NUZ(I))=I; ENDDO

 !## see how many locations per unique zone
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; DO J=1,SIZE(ZONE) 
  !## zones 
  IF(ASSOCIATED(ZONE(J)%X))THEN
   IZ=INT(ZONE(J)%X(ICOL,IROW))
   IF(IZ.LE.0)CYCLE
   !## zone in files but not used by current set of parameters
   IF(IZ.GT.SIZE(ILOCS))CYCLE
   IP=ILOCS(IZ)
   IF(IP.GT.0)NLOCS(IP,J)=NLOCS(IP,J)+1
  !## pilot points
  ELSE
   DO K=1,SIZE(ZONE(J)%IZ)
    IZ=ZONE(J)%IZ(K)
    IP=0; IF(IZ.GT.0.AND.IZ.LE.SIZE(ILOCS))IP=ILOCS(IZ) 
    IF(IP.GT.0)NLOCS(IP,J)=1
   ENDDO
  ENDIF
 ENDDO; ENDDO; ENDDO
 
 !## check number of zones and missing zone (if any)
 DO I=1,SIZE(PEST%PARAM)

  !## parameter active and main of group
  IZ=PEST%PARAM(I)%PIZONE
  IP=ILOCS(IZ)
  ND=0; DO J=1,SIZE(ZONE)
   ND=ND+NLOCS(IP,J)
   IF(NLOCS(IP,J).GT.0)PEST%PARAM(I)%ZTYPE=ZONE(J)%ZTYPE
  ENDDO

  PEST%PARAM(I)%NODES=ND 

  !## not applicable for pilotpoints
  IF(PEST%PARAM(I)%ZTYPE.EQ.1)THEN
   SELECT CASE (TRIM(PEST%PARAM(I)%PPARAM))
    CASE ('KD','KH','KV','VC','SC','VA','RE','SY')
    CASE DEFAULT
     IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Cannot use PilotPoints for other than KD,KH,KV,VC,SC,SY and VA'; RETURN
   END SELECT
  ENDIF

  IF(PEST%PARAM(I)%PPARAM.EQ.'HF')THEN
   PEST%PARAM(I)%NODES=0 !## one single cell used as zone for horizontal barrier module
  ELSE
   IF(PEST%PARAM(I)%NODES.EQ.0)PEST%PARAM(I)%PACT=0
  ENDIF

 ENDDO

 N=0; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PACT.EQ.0)CYCLE 
  SELECT CASE (PEST%PARAM(I)%PPARAM)
   CASE ('HF'); N=N+1
   CASE DEFAULT; N=N+PEST%PARAM(I)%NODES
  END SELECT
 ENDDO 

 !## fill array zone and set appropriate pointers in type 
 DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%NODES.GT.0)THEN
   IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Parameter '//TRIM(ITOS(I))//' number of locations '//TRIM(ITOS(PEST%PARAM(I)%NODES))// &
                   ' assigned to ptype= '//TRIM(PEST%PARAM(I)%PPARAM)

   !## get number of zone in list of unique zone numbers
   IZ=PEST%PARAM(I)%PIZONE
   IP=ILOCS(IZ)

   IF(PEST%PARAM(I)%ZTYPE.EQ.0)THEN
   
    ALLOCATE(PEST%PARAM(I)%IROW(PEST%PARAM(I)%NODES),PEST%PARAM(I)%ICOL(PEST%PARAM(I)%NODES))
    ALLOCATE(PEST%PARAM(I)%F(PEST%PARAM(I)%NODES))

    !## loop to see zones
    N=0; DO J=1,SIZE(ZONE)

     !## particular zone not in this file
     IF(NLOCS(IP,J).EQ.0)CYCLE

     DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
      IF(ZONE(J)%ZTYPE.EQ.0)THEN
       IF(PEST%PARAM(I)%PIZONE.EQ.INT(ZONE(J)%X(ICOL,IROW)))THEN

        SELECT CASE (TRIM(PEST%PARAM(I)%PPARAM))
         CASE ('KD','KH','KV','VC','SC','AF','AA','MS','MC','VA','HF','EX','SY')
          F=MOD(ZONE(J)%X(ICOL,IROW),1.0D0); IF(F.EQ.0.0D0)F=1.0D0
         CASE DEFAULT
          F=1.0D0
        END SELECT

        N=N+1; PEST%PARAM(I)%IROW(N)=INT(IROW,2); PEST%PARAM(I)%ICOL(N)=INT(ICOL,2); PEST%PARAM(I)%F(N)=F
       ENDIF
      ENDIF
     ENDDO; ENDDO

    ENDDO

    IF(N.NE.PEST%PARAM(I)%NODES)THEN
     IF(IBATCH.EQ.1)THEN
      WRITE(*,'(/A,I10,A,I10)') 'SOMETHING GOES WRONG NUMBER OF PARAMETER INITIAL ARE ',PEST%PARAM(I)%NODES
      WRITE(*,'(A,I10/)') 'PARAMETERS ACTUALLY FOUND ARE ',N
     ENDIF
    ENDIF

   ELSEIF(PEST%PARAM(I)%ZTYPE.EQ.1)THEN
  
    ALLOCATE(PEST%PARAM(I)%XY(PEST%PARAM(I)%NODES,2))

    !## check pilotpoints
    N=0; DO J=1,SIZE(ZONE)

     !## particular zone not in this file
     IF(NLOCS(IP,J).EQ.0)CYCLE

     IF(ZONE(J)%ZTYPE.EQ.1)THEN
      DO K=1,SIZE(ZONE(J)%IZ)
       !## check whether it's integer value is equal to param(i)%izone
       IF(PEST%PARAM(I)%PIZONE.EQ.INT(ZONE(J)%IZ(K)))THEN
        N=N+1
        PEST%PARAM(I)%XY(N,1)=ZONE(J)%XY(K,1)
        PEST%PARAM(I)%XY(N,2)=ZONE(J)%XY(K,2) 
       ENDIF
      ENDDO
     ENDIF

    ENDDO
  
   ENDIF
  
  ELSE
   IF(PEST%PARAM(I)%PPARAM.NE.'HF')PEST%PARAM(I)%PACT=0
  ENDIF 
 ENDDO

 DO I=1,SIZE(ZONE)
  IF(ZONE(I)%ZTYPE.EQ.0)THEN
   DEALLOCATE(ZONE(I)%X)
  ELSEIF(ZONE(I)%ZTYPE.EQ.1)THEN
   DEALLOCATE(ZONE(I)%XY,ZONE(I)%IZ)
  ENDIF
 ENDDO

 DEALLOCATE(ZONE,NLOCS,NUZ,ILOCS)
 !## dump everything
 JU=UTL_GETUNIT()
 OPEN(JU,FILE=TRIM(DIR)//'\PARAM_DUMP_IPEST.DAT',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  IF(IBATCH.EQ.1)THEN
   WRITE(*,'(/A)') 'Cannot save the dumpfile for iPESTP in the following folder:'
   WRITE(*,'(A/)') '['//TRIM(DIR)//'\PARAM_DUMP_IPEST.DAT]'
   STOP
  ENDIF
 ENDIF

 !## write header
 WRITE(JU,'(/A)')       'PARAMETER-DUMP-FILE'
 WRITE(JU,'(A22,I10)')  'NUMBER-OF-COLUMNS:    ',PRJIDF%NCOL
 WRITE(JU,'(A22,I10)')  'NUMBER-OF-ROWS:       ',PRJIDF%NROW
 WRITE(JU,'(A22,I10)')  'NUMBER-OF-PARAMETERS: ',SIZE(PEST%PARAM)

 DO I=1,SIZE(PEST%PARAM)
  WRITE(JU,'(/6A10,1X,A15)') 'NODES','PAR.-TYPE','PARAMETER','ILS','IZONE','GROUP','ACRONYM'
  WRITE(JU,'(2I10,A10,3I10,1X,A15)') PEST%PARAM(I)%NODES,PEST%PARAM(I)%ZTYPE,PEST%PARAM(I)%PPARAM,PEST%PARAM(I)%PILS, &
     PEST%PARAM(I)%PIZONE,PEST%PARAM(I)%PIGROUP,ADJUSTR(PEST%PARAM(I)%ACRONYM)
  IF(PEST%PARAM(I)%ZTYPE.EQ.0)THEN
   WRITE(JU,'(3A10)') 'IROW','ICOL','FACTOR'
   DO J=1,PEST%PARAM(I)%NODES
    IF(PEST%PARAM(I)%IROW(J).LE.0.OR.PEST%PARAM(I)%IROW(J).GT.PRJIDF%NROW)THEN
     WRITE(*,'(/A/)') 'Error row ='//TRIM(ITOS(PEST%PARAM(I)%IROW(J))); STOP
    ENDIF
    IF(PEST%PARAM(I)%ICOL(J).LE.0.OR.PEST%PARAM(I)%ICOL(J).GT.PRJIDF%NCOL)THEN
     WRITE(*,'(/A/)') 'Error column ='//TRIM(ITOS(PEST%PARAM(I)%ICOL(J))); STOP
    ENDIF
    WRITE(JU,'(2I10,F10.4)') PEST%PARAM(I)%IROW(J),PEST%PARAM(I)%ICOL(J),PEST%PARAM(I)%F(J)
   ENDDO
  ELSE
   WRITE(JU,'(3A10)') 'X-CORD','Y-CRD','FACTOR'
   DO J=1,PEST%PARAM(I)%NODES
    WRITE(JU,'(2F15.3,F10.4)') PEST%PARAM(I)%XY(J,1),PEST%PARAM(I)%XY(J,2)
   ENDDO
  ENDIF
 ENDDO
 CLOSE(JU)  

 DO I=1,SIZE(PEST%PARAM)
  IF(ASSOCIATED(PEST%PARAM(I)%IROW))DEALLOCATE(PEST%PARAM(I)%IROW)
  IF(ASSOCIATED(PEST%PARAM(I)%ICOL))DEALLOCATE(PEST%PARAM(I)%ICOL)
  IF(ASSOCIATED(PEST%PARAM(I)%F))   DEALLOCATE(PEST%PARAM(I)%F)
  IF(ASSOCIATED(PEST%PARAM(I)%XY))  DEALLOCATE(PEST%PARAM(I)%XY)
 ENDDO
 
 PMANAGER_SAVEPST_MF6_SEAWAT=.TRUE.

 END FUNCTION PMANAGER_SAVEPST_MF6_SEAWAT

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVERUN(FNAME,IBATCH)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=52) :: CDATE1,CDATE2
 CHARACTER(LEN=256) :: BNDFNAME
 INTEGER(KIND=8) :: ITIME,JTIME
 INTEGER :: IU,I,J,K,IPER,KPER,N,NSCL
 LOGICAL :: LDAYS,LEX
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 CHARACTER(LEN=256) :: LINE
 
 PMANAGER_SAVERUN=.FALSE.
 
 !## get active packages, set default values
 IF(.NOT.PMANAGER_GETPACKAGES(1,IBATCH))RETURN

 !## overrule ipst if not as keyword given
 IF(IBATCH.EQ.1.AND.PBMAN%IPEST.EQ.0)TOPICS(TPST)%IACT_MODEL=0
 IF(IBATCH.EQ.1.AND.PBMAN%IIES.EQ.0) TOPICS(TIES)%IACT_MODEL=0

 DO I=1,MAXTOPICS  
  SELECT CASE (I)
   CASE (TFHB,TUZF,TMNW,TSFR,TLAK)
    IF(TOPICS(I)%IACT_MODEL.EQ.1)THEN
     CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'You cannot use the package '//TRIM(TOPICS(I)%TNAME)//CHAR(13)// &
      'to save for a RUN-file. Select the option MODFLOW2005 instead','Information')
     RETURN
    ENDIF
  END SELECT
 ENDDO

 !## remove last timestep sinces it is the final date
 IF(PRJNPER.GT.1)PRJNPER=PRJNPER-1
 
 IF(PBMAN%NLAY.GT.0)THEN
  PRJMXNLAY=MIN(PBMAN%NLAY,PRJMXNLAY)
 ENDIF
 
 PRJNLAY=PRJMXNLAY
 
 !## check on RUN file
 CALL UTL_CREATEDIR(FNAME(1:INDEX(FNAME,'\',.TRUE.)-1))
 IF(IBATCH.EQ.0)THEN
  INQUIRE(FILE=FNAME,EXIST=LEX)
  IF(LEX)THEN
   CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to overwrite'//CHAR(13)//TRIM(FNAME),'Question')
   IF(WINFODIALOG(4).NE.1)RETURN
  ENDIF
 ENDIF
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED')
 IF(IU.EQ.0)RETURN

 !## write Data set 1
 IF(IBATCH.EQ.1)THEN
  IF(TRIM(PBMAN%OUTPUT).EQ.'')THEN
   WRITE(IU,'(A)') CHAR(39)//FNAME(1:INDEX(FNAME,'\',.TRUE.)-1)//CHAR(39)
  ELSE
   WRITE(IU,'(A)') CHAR(39)//TRIM(PBMAN%OUTPUT)//CHAR(39)
  ENDIF
 ELSE
  WRITE(IU,'(A)') CHAR(39)//TRIM(PBMAN%OUTPUT)//CHAR(39)
 ENDIF
 
 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN
  N=SIZE(PEST%MEASURES); IF(PEST%IIPF.EQ.1)N=-1*N
 ENDIF
 
 !## metaswap
 PBMAN%IARMWP=0
 IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)THEN
  IF(ASSOCIATED(TOPICS(TCAP)%STRESS))THEN
   LINE=TOPICS(TCAP)%STRESS(1)%FILES(8,1)%FNAME
   IF(INDEX(UTL_CAP(LINE,'U'),'IPF').GT.0)PBMAN%IARMWP=1
  ENDIF
 ENDIF
 NSCL=1
 IF(PBMAN%IWINDOW.EQ.3)NSCL=0
 IF(PBMAN%IWINDOW.EQ.2)THEN
  IF(SUBMODEL(7).GT.0.0D0)NSCL=2
 ENDIF
 WRITE(IU,'(12(I10,1X))') PRJNLAY,PRJMXNLAY,PRJNPER,PBMAN%ISAVEENDDATE,NSCL,0,PBMAN%ICONCHK,N,0,PBMAN%IFVDL,PBMAN%IARMWP

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

 !## data set 4
 IF(PBMAN%IWINDOW.EQ.3)THEN
  LINE='0'
 ELSE
  LINE='1'
 ENDIF
 LINE=TRIM(LINE)//',0,'//TRIM(ITOS(PBMAN%IDOUBLE))//',0,0,'//TRIM(ITOS(PBMAN%SSYSTEM))
 IF(PBMAN%MINKD.NE.0.0D0.OR.PBMAN%MINC.NE.0.0D0)THEN
  LINE=TRIM(LINE)//','//TRIM(RTOS(PBMAN%MINKD,'G',5))//','//TRIM(RTOS(PBMAN%MINC ,'G',5))
 ENDIF
 WRITE(IU,'(A)') TRIM(LINE)

 !## Data set 5
 IF(PCG%PARTOPT.GT.1)PCG%NOUTER=-ABS(PCG%NOUTER)
 LINE=TRIM(ITOS(PCG%NOUTER))//','//TRIM(ITOS(PCG%NINNER))//','// & 
      TRIM(RTOS(PCG%HCLOSE,'E',7))//','//TRIM(RTOS(PCG%RCLOSE,'E',7))//','// &
      TRIM(RTOS(PCG%RELAX,'E',7))
 IF(PCG%PARTOPT.GT.1)THEN
  !## PKS options
  LINE=TRIM(LINE)//','//TRIM(ITOS(PCG%PARTOPT-2))//','//TRIM(ITOS(PCG%IMERGE)) 
 ELSE
  !## PCG option
  LINE=TRIM(LINE)//','//TRIM(ITOS(PCG%NPCOND)) 
 ENDIF
 WRITE(IU,'(A)') TRIM(LINE)
 
 IF(PCG%PARTOPT.EQ.3.AND.TRIM(PCG%MRGFNAME).EQ.'')THEN
  CLOSE(IU); CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to specify a pointer IDF-file when selecting the RCB partition method.','Error')
  RETURN
 ENDIF
 
 IF(PCG%PARTOPT.EQ.3)THEN
  WRITE(IU,'(A)') '"'//TRIM(PCG%MRGFNAME)//'"'
 ENDIF

 !## Data set 6
 BNDFNAME=''
 IF(PBMAN%IWINDOW.EQ.3)THEN   !## user defined IDF

  BNDFNAME=PBMAN%BNDFILE

 ELSE !## full extent or submodel
 
  ALLOCATE(IDF(1)); CALL IDFNULLIFY(IDF(1))
  !## get first idf
  IF(.NOT.PMANAGER_INIT_GETFIRSTIDF(IDF(1),IBATCH))RETURN
  IF(.NOT.PMANAGER_INIT_SIMAREA(IDF(1),IBATCH))RETURN
  IF(LEN_TRIM(IDF(1)%FNAME).GT.0)THEN
   BNDFNAME=IDF(1)%FNAME !## 1st IDF in list
  ELSE
   WRITE(IDF(1)%FNAME,'(4(F15.3,A1))') IDF(1)%XMIN,',',IDF(1)%YMIN,',',IDF(1)%XMAX,',',IDF(1)%YMAX
  ENDIF

  IF(ISUBMODEL.EQ.0)THEN
   WRITE(IU,'(6(F15.3,A1))') IDF(1)%XMIN,',',IDF(1)%YMIN,',',IDF(1)%XMAX,',',IDF(1)%YMAX,',',IDF(1)%DX,',',0.0D0
  ELSE
   IF(SUBMODEL(6).GT.0.0D0.AND.SUBMODEL(7).GT.0.0D0)THEN
    WRITE(IU,'(7(F15.3,A1))') IDF(1)%XMIN,',',IDF(1)%YMIN,',',IDF(1)%XMAX,',',IDF(1)%YMAX,',',IDF(1)%DX,',',SUBMODEL(7),',',SUBMODEL(6)
   ELSE
    WRITE(IU,'(6(F15.3,A1))') IDF(1)%XMIN,',',IDF(1)%YMIN,',',IDF(1)%XMAX,',',IDF(1)%YMAX,',',IDF(1)%DX,',',SUBMODEL(6)
   ENDIF
  ENDIF
 
  CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 
 ENDIF
 
 WRITE(IU,'(A)') 'ACTIVE MODULES'

 !## Data set 8
 DO I=1,MAXTOPICS  
  IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE
  !## skip pcg
  IF(I.EQ.TPCG)CYCLE
  !## pst module is exception
  IF(I.EQ.TPST)THEN; WRITE(IU,'(A)') '1,0 '//TRIM(TOPICS(I)%TNAME); CYCLE; ENDIF
!  IF(I.EQ.TIES)THEN; WRITE(IU,'(A)') '1,0 '//TRIM(TOPICS(I)%TNAME); CYCLE; ENDIF
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE

  CALL PMANAGER_SAVEMF2005_RUN_ISAVE(PBMAN%ISAVE(I)%ILAY,TOPICS(I)%TNAME(1:5),IU)

 ENDDO

 !## write bndfile, Data set 9
 IF(LEN_TRIM(BNDFNAME).GT.0)THEN
  WRITE(IU,'(A)') CHAR(39)//TRIM(BNDFNAME)//CHAR(39)
 ELSE
  WRITE(IU,'(4(F15.3,A1))') PRJIDF%XMIN,',',PRJIDF%YMIN,',',PRJIDF%XMAX,',',PRJIDF%YMAX
 ENDIF
 
 WRITE(IU,'(A)') 'MODULES FOR EACH LAYER'
  
 !## write modules not timedependent
 DO I=1,MAXTOPICS
  IF(TOPICS(I)%IACT_MODEL.EQ.0)CYCLE   !## only active
  IF(TOPICS(I)%TIMDEP)CYCLE            !## only time independent   

  !## skip pcg
  IF(I.EQ.TPCG)CYCLE
  
  !## pst module is exception
  IF(I.EQ.TPST)THEN
   LINE=TRIM(ITOS(SIZE(PEST%PARAM)))//',(PST)'; WRITE(IU,'(A)') TRIM(LINE) 
   IF(.NOT.PMANAGER_SAVEPST(IU,1,'',0,0))THEN; ENDIF; CYCLE
  ENDIF
!  IF(I.EQ.TIES)THEN
!   LINE=TRIM(ITOS(SIZE(PEST%PARAM)))//',(IES)'; WRITE(IU,'(A)') TRIM(LINE) 
!   IF(.NOT.PMANAGER_SAVEPST(IU,1,'',0,0))THEN; ENDIF; CYCLE
!  ENDIF
  
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS))CYCLE
  IF(.NOT.ASSOCIATED(TOPICS(I)%STRESS(1)%FILES))CYCLE
  
  !## check the number of active packages
  IF(I.EQ.TCAP)THEN
   N=SIZE(TOPICS(I)%STRESS(1)%FILES,1)
   IF(ASSOCIATED(TOPICS(I)%STRESS(1)%INPFILES))THEN
    N=N+SIZE(TOPICS(I)%STRESS(1)%INPFILES)
   ENDIF
  ELSE
   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
  ENDIF
  
  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
     !## msp/pwt - skip ilay
     IF(I.EQ.TCAP.OR.I.EQ.TPWT)THEN
      WRITE(LINE,'(5X,     2(G15.7,A1))') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,','
     ELSE
      WRITE(LINE,'(1X,I5,2(A1,G15.7),A1)') &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%ILAY,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%FCT ,',', &
                                  TOPICS(I)%STRESS(1)%FILES(K,J)%IMP ,','
     ENDIF
     IF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.1)THEN
      LINE=TRIM(LINE)//TRIM(RTOS(TOPICS(I)%STRESS(1)%FILES(K,J)%CNST,'G',7))
     ELSEIF(TOPICS(I)%STRESS(1)%FILES(K,J)%ICNST.EQ.2)THEN
      LINE=TRIM(LINE)//CHAR(39)//TRIM(TOPICS(I)%STRESS(1)%FILES(K,J)%FNAME)//CHAR(39)
     ENDIF
     WRITE(IU,'(A)') TRIM(LINE)

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

 ENDDO

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

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

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

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

   IPER=PMANAGER_GETCURRENTIPER(KPER,I,ITIME,JTIME)
   
   !## overrule wel/isg packages per stress-period
   SELECT CASE (I)
    CASE (TWEL); IF(PBMAN%DWEL.EQ.1)IPER=ABS(IPER)
    CASE (TISG); IF(PBMAN%DISG.EQ.1)IPER=ABS(IPER)
    CASE (TSFR); IF(PBMAN%DSFR.EQ.1)IPER=ABS(IPER)
   END SELECT

   !## reuse previous timestep
   IF(IPER.LE.0)THEN

    N=MAX(IPER,-1)
    WRITE(IU,'(I3,A)') N,','//TRIM(TOPICS(I)%TNAME)
   
   ELSE
   
    !## check the number of active packages
    K=1; N=0
    DO J=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,2)
     IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%IACT.EQ.1)N=N+1
    ENDDO
    WRITE(IU,'(I3,A)') N,','//TRIM(TOPICS(I)%TNAME)
 
    IF(N.GT.0)THEN
     !## number of subtopics
     DO K=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,1)
      !## number of systems
      DO J=1,SIZE(TOPICS(I)%STRESS(IPER)%FILES,2)
       !## skip temporary deactivated packages
       IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%IACT.EQ.0)CYCLE
       IF(TOPICS(I)%STRESS(IPER)%FILES(K,J)%ICNST.EQ.1)THEN
        WRITE(IU,'(1X,I5,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,I5,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)

 !## copy RUN file to RUNFILES folder
 CALL IOSCOPYFILE(TRIM(PBMAN%RUNFILE),TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(PBMAN%MODELNAME)//'.RUN')
 
 PMANAGER_SAVERUN=.TRUE.

 END FUNCTION PMANAGER_SAVERUN

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005(FNAME,IBATCH) 
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=512) :: DIRMNAME,DIR,MAINDIR
 INTEGER(KIND=8) :: ITIME,JTIME
 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: NEX
 INTEGER,ALLOCATABLE,DIMENSION(:) :: SUBNLAY
 INTEGER :: IULAK,ISTEADY,IPER,INIPER,LPER,KPER,IINI,IPRT,I,J,N,NSYSFHB,NSYSGHB,NSYSRIV
 LOGICAL :: LTB

 PMANAGER_SAVEMF2005=.FALSE.; LYESNO=.FALSE.
 
 IF(PBMAN%NSUBMODEL.GT.1.AND.TOPICS(TCAP)%IACT_MODEL.EQ.1)THEN
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is not allowed to use Metaswap with MODFLOW6 with nested models.','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(/A/)') '>>> It is not allowed to use Metaswap with MODFLOW6 with nested models. <<<'
  RETURN
 ENDIF
 
 !## check usage of kvv in com ination with modflow6, which is wrong
 IF(PBMAN%IFORMAT.EQ.3.AND.TOPICS(TKVV)%IACT_MODEL.EQ.1)THEN
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is not allowed to use KVV for MODFLOW6; 3D models are supported, only.','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(/A/)') '>>> It is not allowed to use KVV for MODFLOW6; 3D models are supported, only. <<<'
  RETURN
 ENDIF
 
 IF(TOPICS(TCAP)%IACT_MODEL.EQ.1.AND.PBMAN%IFORMAT.EQ.3.AND.PBMAN%IPESTP+PBMAN%IIES.GT.0)THEN
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is not allowed to use iPESTP for MODFLOW6 in combination with MetaSWAP.','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(/A/)') '>>> It is not allowed to use iPESTP for MODFLOW6 in combination with MetaSWAP. <<<'
  RETURN
 ENDIF
 
 !## remove final stress as it is the final timestep
 IF(PRJNPER.GT.1)PRJNPER=PRJNPER-1
   
 ISTEADY=0; IF(SIM(1)%DELT.EQ.0.0D0)ISTEADY=1

 !## time information
 ISS=0; DO KPER=1,PRJNPER; IF(SIM(KPER)%DELT.NE.0.0D0)ISS=1; ENDDO

 !## overwrite nstep/nmult in case imodbatch and not tim-files are used
 IF(IBATCH.EQ.1.AND.PBMAN%TIMFNAME.EQ.'')THEN
  DO KPER=1,PRJNPER; SIM(KPER)%TMULT=PBMAN%NMULT; SIM(KPER)%NSTP=PBMAN%NSTEP; ENDDO
 ENDIF
 
 !## output unit numbers
 IHEDUN =51; IBCFCB =52; IRCHCB =53; IEVTCB =54; IDRNCB =55
 IRIVCB =56; IGHBCB =57; ICHDCB =58; IWELCB =59
 ISFRCB =60  !## output unit numbers for sfr package
 ISFRCB2=61  !## detailed output for sfr package
 IFHBCB =62  !## output fhb package
 ILAKCB =63  !## output lak package
 IUZFCB1=64  !## output uzg package
 IWL2CB =65  !## output mnw package
 ISCRCB =66  !## output scr package
 ICAPCB =67  !## output cap package
 
 !## get active packages
 IF(.NOT.PMANAGER_GETPACKAGES(1,IBATCH))RETURN

 !## overrule ipst if not as keyword given
 IF(IBATCH.EQ.1.AND.(PBMAN%IPEST+PBMAN%IPESTP+PBMAN%IIES).EQ.0)TOPICS(TPST)%IACT_MODEL=0
 
 !## turn off certain packages as not needed for seawat without simulation
 IF(PBMAN%IFORMAT.EQ.6)THEN
  IF(WQ%VDF%MTDNCONC.EQ.0)THEN
!  TOPICS(TADV)%IACT_MODEL=0
   TOPICS(TDSP)%IACT_MODEL=0
   TOPICS(TSCO)%IACT_MODEL=0
   TOPICS(TCBI)%IACT_MODEL=0
   TOPICS(TPOR)%IACT_MODEL=0
   TOPICS(TGCG)%IACT_MODEL=0
  ELSE
   IF(TOPICS(TCON)%IACT_MODEL.EQ.0)THEN
    IF(IBATCH.EQ.0)THEN
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'>>> CON package to be active in conjunction with VDF and MTDNCONC=1 <<<','Error'); STOP
    ENDIF
    IF(IBATCH.EQ.1)WRITE(*,'(/1X,A/)') '>>> CON package to be active in conjunction with VDF and MTDNCONC=1 <<<'; STOP
   ENDIF
  ENDIF
 ENDIF
 
 !## turn off metaswap whenever a steady-state model is concerned
 IF(ISS.EQ.0)TOPICS(TCAP)%IACT_MODEL=0
 
 !## flexdrainage active, need to be known here as DRN package needs information from it
 PBMAN%FLEXD=0; IF(TOPICS(TCAP)%NSUBTOPICS.EQ.26)THEN
  PBMAN%FLEXD=1; IF(IBATCH.EQ.1)WRITE(*,'(/1X,A/)') '>>> Flexible Drainage is Active <<<'
  !## check whether DRN package is active too?
  IF(PMANAGER_GETNSYS(TDRN,2).EQ.0)THEN
    IF(IBATCH.EQ.1)WRITE(*,'(/1X,A/)') '>>> Conventional DRN needs to be active with at least one system <<<'; STOP
  ENDIF
 ENDIF

! !## organise groups
! IF(.NOT.IPEST_GLM_SETGROUPS(IBATCH))RETURN
 
 !## write nam file
 IF(.NOT.PMANAGER_SAVEMF2005_NAM(FNAME,MAINDIR,DIR,DIRMNAME,IPRT,ISS))RETURN
 
 !## get area of simulation / allocate arrays
 IF(.NOT.PMANAGER_SAVEMF2005_SIM(IBATCH))RETURN
 !## allocate memory
 IF(.NOT.PMANAGER_SAVEMF2005_SIM_ALLOC(ISS))RETURN
 
 !##================
 !## reading section
 !##================
 
 !## read bnd/shd files
 IF(.NOT.PMANAGER_SAVEMF2005_BAS_READ(IPRT))RETURN
 !## read top/bot information
 IF(.NOT.PMANAGER_SAVEMF2005_DIS_READ(LTB,IPRT))RETURN
 !## read bcf
 IF(.NOT.PMANAGER_SAVEMF2005_BCF_READ(ISS,IPRT))RETURN
 !## read lpf
 IF(.NOT.PMANAGER_SAVEMF2005_LPF_READ(ISS,IPRT))RETURN

 !## merge layer in case modflow6
 IF(.NOT.PMANAGER_MERGELAYERS())RETURN
 
 !## read for vdf
 IF(.NOT.PMANAGER_SAVEMF2005_CON_READ(IPRT))RETURN
 !## read dsp
 IF(.NOT.PMANAGER_SAVEMF2005_DSP_READSAVE(DIR,DIRMNAME,IBATCH,IPRT))RETURN
 !## read por
 IF(.NOT.PMANAGER_SAVEMF2005_POR_READ(IPRT))RETURN
 !## read cbi
 IF(.NOT.PMANAGER_SAVEMF2005_CBI_READ(IPRT))RETURN
 !## read sco
 IF(.NOT.PMANAGER_SAVEMF2005_SCO_READ(IPRT))RETURN
 !## read scr
 IF(.NOT.PMANAGER_SAVEMF2005_SCR_READ(IPRT))RETURN
 !## compute kdw/vcw
 CALL PMANAGER_SAVEMF2005_COMPUTE_KDW_VCW()
 !## read ani
 IF(.NOT.PMANAGER_SAVEMF2005_ANI_READ(IPRT))RETURN
 !## read top/bot information
 IF(.NOT.PMANAGER_SAVEMF2005_LAK_READ(0,IPRT,INIPER))RETURN
 !## read top/kh information
 IF(.NOT.PMANAGER_SAVEMF2005_SFT_READ(IPRT))RETURN

 !##================
 !## checking section
 !##================

 !## apply consistency checks
 CALL PMANAGER_SAVEMF2005_CONSISTENCY(LTB)
 !## recompute kdw/vcw
 CALL PMANAGER_SAVEMF2005_COMPUTE_KDW_VCW()
 !## get lak position and conductances
 IF(.NOT.PMANAGER_SAVEMF2005_LAK_CONFIG())RETURN

 !##================
 !## read/write pst section
 !##================

 !## write pst-file
 IF(.NOT.PMANAGER_SAVEMF2005_PST_READWRITE(DIR,DIRMNAME,IBATCH,ISS))RETURN
 !## organise groups
 IF(.NOT.IPEST_GLM_SETGROUPS(IBATCH))RETURN
 
 !##================
 !## writing section
 !##================

 !## write meta-data file
 IF(.NOT.PMANAGER_SAVEMF2005_MET(DIR,DIRMNAME))RETURN
 !## write time-discretisation file
 IF(.NOT.PMANAGER_SAVEMF2005_TDIS(TRIM(MAINDIR)//'\MFSIM'))RETURN
 !## save ims file
 IF(.NOT.PMANAGER_SAVEMF2005_IMS(TRIM(MAINDIR)//'\MFSIM'))RETURN
 !## save pcg file
 IF(.NOT.PMANAGER_SAVEMF2005_PCG(DIRMNAME))RETURN
 !## save gcg file
 IF(.NOT.PMANAGER_SAVEMF2005_GCG(DIRMNAME))RETURN
 !## save pks file
 IF(.NOT.PMANAGER_SAVEMF2005_PKS(DIRMNAME))RETURN
 !## save oc file
 IF(.NOT.PMANAGER_SAVEMF2005_OCD(DIRMNAME,MAINDIR))RETURN

 !## save bas file
 IF(.NOT.PMANAGER_SAVEMF2005_BAS_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save btn file
 IF(.NOT.PMANAGER_SAVEMF2005_BTN_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save ic file
 IF(.NOT.PMANAGER_SAVEMF2005_IC_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save dis file
 IF(.NOT.PMANAGER_SAVEMF2005_DIS_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save bcf file
 IF(.NOT.PMANAGER_SAVEMF2005_BCF_SAVE(DIR,DIRMNAME,IBATCH,ISS))RETURN
 !## save lpf file
 IF(.NOT.PMANAGER_SAVEMF2005_LPF_SAVE(DIR,DIRMNAME,IBATCH,ISS))RETURN
 !## save adv file
 IF(.NOT.PMANAGER_SAVEMF2005_ADV_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save vdf file
 IF(.NOT.PMANAGER_SAVEMF2005_VDF_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save npf file
 IF(.NOT.PMANAGER_SAVEMF2005_NPF_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save sto file
 IF(.NOT.PMANAGER_SAVEMF2005_STO_SAVE(DIR,DIRMNAME,IBATCH,ISS))RETURN
 !## save ani file
 IF(.NOT.PMANAGER_SAVEMF2005_ANI_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save scr file
 IF(.NOT.PMANAGER_SAVEMF2005_SCR_SAVE(DIR,DIRMNAME,IBATCH))RETURN
 !## save hfb file
 IF(.NOT.PMANAGER_SAVEMF2005_HFB(IBATCH,DIRMNAME,IPRT,LTB))RETURN
 
 !## save uzf package
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TUZF)%IACT_MODEL,TUZF,IUZFCB1,'UZF',(/1,2,3,4,5,6,7,8/),IPRT))RETURN
 !## save mnw package
 IF(PBMAN%IFORMAT.EQ.3)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_MNW2(DIR,DIRMNAME,IBATCH,TOPICS(TMNW)%IACT_MODEL,TMNW,IWL2CB,'MAW',IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_MNW2(DIR,DIRMNAME,IBATCH,TOPICS(TMNW)%IACT_MODEL,TMNW,IWL2CB,'MNW',IPRT))RETURN
 ENDIF
 !## save wel package
 IF(.NOT.PMANAGER_SAVEMF2005_WEL(DIR,DIRMNAME,IBATCH,TOPICS(TWEL)%IACT_MODEL,TWEL,IWELCB,'WEL',IPRT))RETURN
 !## save drn package
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TDRN)%IACT_MODEL,TDRN,IDRNCB,'DRN',(/2,1/),IPRT))RETURN
 !## save isg package (always before riv in case of dmm-files)
 IF(.NOT.PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,TOPICS(TISG)%IACT_MODEL,IRIVCB,'ISG',IPRT))RETURN
 !## save riv package
 NSYSRIV=PMANAGER_GETNSYS(TRIV,1)
 IF(NSYSRIV.EQ.5.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TRIV)%IACT_MODEL,TRIV,IRIVCB,'RIV',(/2,1,3,4,5/),IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TRIV)%IACT_MODEL,TRIV,IRIVCB,'RIV',(/2,1,3,4/),IPRT))RETURN
 ENDIF
 !## save evt package
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TEVT)%IACT_MODEL,TEVT,IEVTCB,'EVT',(/2,1,3/),IPRT))RETURN
 !## save ghb package
 NSYSGHB=PMANAGER_GETNSYS(TGHB,1)
 IF(NSYSGHB.EQ.3.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TGHB)%IACT_MODEL,TGHB,IGHBCB,'GHB',(/2,1,3/),IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TGHB)%IACT_MODEL,TGHB,IGHBCB,'GHB',(/2,1/),IPRT))RETURN
 ENDIF
 !## save rch package
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TRCH)%IACT_MODEL,TRCH,IRCHCB,'RCH',(/1/),IPRT))RETURN
 !## save olf package
 IF(TOPICS(TDRN)%IACT_MODEL.EQ.0)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TOLF)%IACT_MODEL,TOLF,IDRNCB,'DRN',(/1/),IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TOLF)%IACT_MODEL,TOLF,IDRNCB,'OLF',(/1/),IPRT))RETURN
 ENDIF
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TCHD)%IACT_MODEL,TCHD,ICHDCB,'CHD',(/1/),IPRT))RETURN
 !## save sfr package
 IF(.NOT.PMANAGER_SAVEMF2005_SFR(DIR,DIRMNAME,IBATCH,TOPICS(TSFR)%IACT_MODEL,ISFRCB,'SFR',IPRT))RETURN
 !## save fhb package
 NSYSFHB=PMANAGER_GETNSYS(TFHB,1)
 IF(NSYSFHB.EQ.2)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TFHB)%IACT_MODEL,TFHB,IFHBCB,'FHB',(/1,2/),IPRT))RETURN
 ELSEIF(NSYSFHB.EQ.3)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TFHB)%IACT_MODEL,TFHB,IFHBCB,'FHB',(/1,2,3/),IPRT))RETURN
 ENDIF
 IF(TOPICS(TLAK)%IACT_MODEL)THEN
  !## save rest of lak package
  LPER=0; DO IPER=1,PRJNPER
   !## get appropriate stress-period to store in runfile   
   KPER=PMANAGER_GETCURRENTIPER(IPER,TLAK,ITIME,JTIME)
   !## kper is stress period for which lakes are firstly defined
   IINI=0; IF(KPER.EQ.INIPER)IINI=1
   !## read in new values in case not previous one can be used
   IF(ABS(KPER).NE.LPER)THEN
    KPER=ABS(KPER)
    IF(.NOT.PMANAGER_SAVEMF2005_LAK_READ(IPER,IPRT,KPER))RETURN
   ENDIF
   IF(.NOT.PMANAGER_SAVEMF2005_LAK_SAVE(IULAK,IINI,IBATCH,DIR,KPER=IPER,DIRMNAME=DIRMNAME))RETURN
   !## store previous stress-period information for this timestep
   LPER=ABS(KPER)
  ENDDO
  CLOSE(IULAK)
 ENDIF
 !## save obs package with mf6
 IF(PBMAN%IFORMAT.EQ.3)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_OBS(DIR,DIRMNAME,IBATCH,TOPICS(TOBS)%IACT_MODEL,TOBS,'OBS',1))RETURN
 ELSE 
  !## combine olf/drn (if not MF6)
  IF(PBMAN%DMMFILE.EQ.1.OR.(TOPICS(TOLF)%IACT_MODEL.AND.TOPICS(TDRN)%IACT_MODEL))THEN
   IF(PBMAN%ICONCHK.EQ.0)THEN
    IF(.NOT.PMANAGER_SAVEMF2005_COMBINE(DIR,DIRMNAME,(/'OLF','DRN','DRN_'/),IDRNCB,'AUX ISUB DSUBSYS ISUB NOPRINT'))RETURN
   ELSE
    IF(.NOT.PMANAGER_SAVEMF2005_COMBINE(DIR,DIRMNAME,(/'OLF','DRN','DRN_'/),IDRNCB,'AUX ISUB DSUBSYS ISUB ICONCHK IC NOPRINT'))RETURN
   ENDIF
  ENDIF
  !## combine isg/riv (if not MF6)  
  IF(TOPICS(TISG)%IACT_MODEL.OR.TOPICS(TRIV)%IACT_MODEL)THEN
   IF(PBMAN%INFFCT.EQ.1)THEN
    IF(.NOT.PMANAGER_SAVEMF2005_COMBINE(DIR,DIRMNAME,(/'ISG','RIV','RIV_'/),IRIVCB,'AUX ISUB RSUBSYS ISUB NOPRINT'))RETURN
   ELSE
    IF(.NOT.PMANAGER_SAVEMF2005_COMBINE(DIR,DIRMNAME,(/'ISG','RIV','RIV_'/),IRIVCB,'AUX RFCT AUX ISUB RFACT RFCT RSUBSYS ISUB NOPRINT'))RETURN
   ENDIF
  ENDIF
 ENDIF
 
 !## save ssm file
 IF(.NOT.PMANAGER_SAVEMF2005_SSM_READSAVE(MAINDIR,DIR,DIRMNAME,IBATCH,IPRT))RETURN

 !## write metaswap at last --- uses info from river export
 IF(.NOT.PMANAGER_SAVEMF2005_MSP(DIR,DIRMNAME,IBATCH,IPRT))RETURN 

 !## recompute icell-type
 DO I=1,PBMAN%NSUBMODEL  
  IF(.NOT.PMANAGER_SAVEMF2005_SETICELLTYPE(MAINDIR,DIRMNAME,I,(/'RIV6','GHB6'/)))RETURN  !,'DRN6'
 ENDDO
 
 !## create connections
 IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%ISUBMODEL.EQ.PBMAN%NSUBMODEL)THEN
  DO; I=LEN_TRIM(MAINDIR); IF(MAINDIR(I:I).NE.'\')EXIT; MAINDIR(I:I)=' '; ENDDO

  ALLOCATE(NEX(PBMAN%NSUBMODEL,PBMAN%NSUBMODEL)); NEX=0
  !## associated via imodbatch or submodel with variable layering
  IF(.NOT.ASSOCIATED(PBMAN%SM))THEN
   ALLOCATE(PBMAN%SM(PBMAN%NSUBMODEL))
   DO I=1,PBMAN%NSUBMODEL
    ALLOCATE(PBMAN%SM(I)%ILAY(PRJNLAY)); DO J=1,PRJNLAY; PBMAN%SM(I)%ILAY(J)=J; ENDDO
   ENDDO
  ENDIF
  DO I=1,PBMAN%NSUBMODEL; ALLOCATE(PBMAN%SM(I)%CON(3)); ENDDO; ALLOCATE(SUBNLAY(PBMAN%NSUBMODEL)); SUBNLAY=0
  DO I=1,PBMAN%NSUBMODEL; DO J=1,PBMAN%NSUBMODEL
   IF(I.EQ.J)CYCLE; N=NEX(J,I)
   CALL PMANAGER_SAVEMF6_EXG(MAINDIR,DIRMNAME,I,J,N,SUBNLAY(I)); NEX(I,J)=N
  ENDDO; ENDDO
  DEALLOCATE(NEX)
  !## exchange connections might be changed due to the HFB package
  IF(TOPICS(THFB)%IACT_MODEL.EQ.1)THEN
   DO I=1,PBMAN%NSUBMODEL
    CALL PMANAGER_SAVEMF6_EXG_MODIFYHFB(MAINDIR,DIRMNAME,I,SUBNLAY)
   ENDDO
  ENDIF
  DEALLOCATE(SUBNLAY)
  DO I=1,PBMAN%NSUBMODEL
   IF(ASSOCIATED(PBMAN%SM(I)%CON(1)%X))THEN
    PBMAN%SM(I)%CON(1)%FNAME=TRIM(MAINDIR)//'\GWF_'//TRIM(ITOS(I))//'\CON_TOP.IDF'
    IF(.NOT.IDFWRITE(PBMAN%SM(I)%CON(1),PBMAN%SM(I)%CON(1)%FNAME,1))THEN; ENDIF
    CALL IDFDEALLOCATEX(PBMAN%SM(I)%CON(1))
   ENDIF
   IF(ASSOCIATED(PBMAN%SM(I)%CON(2)%X))THEN
    PBMAN%SM(I)%CON(2)%FNAME=TRIM(MAINDIR)//'\GWF_'//TRIM(ITOS(I))//'\CON_BOT.IDF'
    IF(.NOT.IDFWRITE(PBMAN%SM(I)%CON(2),PBMAN%SM(I)%CON(2)%FNAME,1))THEN; ENDIF
    CALL IDFDEALLOCATEX(PBMAN%SM(I)%CON(2))
   ENDIF
   IF(ASSOCIATED(PBMAN%SM(I)%CON(3)%X))THEN
    PBMAN%SM(I)%CON(3)%FNAME=TRIM(MAINDIR)//'\GWF_'//TRIM(ITOS(I))//'\CON_LAT.IDF'
    IF(.NOT.IDFWRITE(PBMAN%SM(I)%CON(3),PBMAN%SM(I)%CON(3)%FNAME,1))THEN; ENDIF
    CALL IDFDEALLOCATEX(PBMAN%SM(I)%CON(3))
   ENDIF
   DEALLOCATE(PBMAN%SM(I)%CON)
  ENDDO
  
!  !## remove from nam if no packages exists anymore
!  DO I=1,PBMAN%NSUBMODEL
!   CALL PMANAGER_SAVEMF6_CLEANNAM(MAINDIR,DIRMNAME,I)
!  ENDDO
  
 ENDIF
 
 !## modify files if needed for ies and/or modflow6
 IF(.NOT.PMANAGER_SAVEMF2005_IES_READWRITE(DIRMNAME,IBATCH))RETURN
 !## modify files if needed for ipestp/ies and modflow6/seawat
 IF(.NOT.PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE(MAINDIR,DIRMNAME,IBATCH))RETURN
 
 IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%ISUBMODEL.EQ.PBMAN%NSUBMODEL)THEN
  !## remove from nam if no packages exists anymore
  DO I=1,PBMAN%NSUBMODEL
   CALL PMANAGER_SAVEMF6_CLEANNAM(MAINDIR,DIRMNAME,I)
  ENDDO
 ENDIF
 
 PMANAGER_SAVEMF2005=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF6_CLEANNAM(DIR,DIRMNAME,M)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: M
 INTEGER :: I,J,IU,JU,KU,IOS,N,N1,N2
 CHARACTER(LEN=256) :: FNAME,PCKFNAME,LINE,STRING
 CHARACTER(LEN=52) :: MDLNAME,CTXT
 CHARACTER(LEN=4),DIMENSION(6) :: PCK
 CHARACTER(LEN=24) :: CTMP
 LOGICAL :: LEX
 DATA PCK/'CHD6','WEL6','DRN6','RCH6','RIV6','HFB6'/
 
 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  IF(PEST%PE_MXITER.LT.0)THEN
   N1=-1; N2=N1
  ELSE
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  ENDIF
 ELSEIF(PBMAN%IIES.EQ.1)THEN
  N1=1; N2=PEST%NREALS
 ENDIF
 
 MDLNAME=DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:); MDLNAME=UTL_CAP(MDLNAME,'U')    
 
 DO I=N1,N2
  !## skip zero
  IF(I.EQ.0)CYCLE
  IU=UTL_GETUNIT()
  IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'.NAM'
  ELSEIF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_P#'//TRIM(ITOS(I))//'.NAM'
   ELSE
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.NAM'
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_R#'//TRIM(ITOS(ABS(I)))//'.NAM'
  ENDIF
  
  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=TRIM(FNAME)//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)THEN; CLOSE(IU); RETURN; ENDIF
  DO
   READ(IU,'(A256)',IOSTAT=IOS) LINE
   IF(IOS.NE.0)EXIT
   WRITE(JU,'(A)') TRIM(LINE)
   IF(TRIM(LINE).EQ.'BEGIN PACKAGES')THEN
    DO
     READ(IU,'(A256)',IOSTAT=IOS) LINE
     IF(IOS.NE.0)EXIT
     LEX=.FALSE.;
     DO J=1,SIZE(PCK)
      IF(INDEX(LINE,PCK(J)).GT.0)THEN
       READ(LINE,*) CTXT,PCKFNAME
       !## remove '..\'
       DO
        IF(INDEX(PCKFNAME,'..\').EQ.0)EXIT
        PCKFNAME=UTL_SUBST(PCKFNAME,'..\','\')
       ENDDO
       !## check whether there are packages defined
       KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,FILE=TRIM(DIR)//'\'//TRIM(PCKFNAME),STATUS='OLD', &
         ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)RETURN
       LEX=.TRUE.
       DO 
        READ(KU,'(A256)') STRING
        IF(INDEX(STRING,'MAXBOUND').GT.0)THEN
         READ(STRING,*) CTMP,N
         IF(N.GT.0)WRITE(JU,'(A)') TRIM(LINE)
         EXIT
        ENDIF
        IF(INDEX(STRING,'MAXHFB').GT.0)THEN
         READ(STRING,*) CTMP,N
         IF(N.GT.0)WRITE(JU,'(A)') TRIM(LINE)
         EXIT
        ENDIF
       ENDDO
       CLOSE(KU)
      ENDIF
     ENDDO
     IF(.NOT.LEX)WRITE(JU,'(A)') TRIM(LINE)
    ENDDO
   ENDIF
  ENDDO
  CLOSE(IU,STATUS='DELETE'); CLOSE(JU)
 
  CALL IOSRENAMEFILE(TRIM(FNAME)//'_',FNAME)
 ENDDO
 
 END SUBROUTINE PMANAGER_SAVEMF6_CLEANNAM
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF6_EXG(DIR,MNAME,M1,M2,NEX,NLAY)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: CDISTANCE=0.0D0
 CHARACTER(LEN=*),INTENT(IN) :: DIR,MNAME
 INTEGER,INTENT(IN) :: M1,M2
 INTEGER,INTENT(INOUT) :: NEX
 INTEGER,INTENT(OUT) :: NLAY
 REAL(KIND=DP_KIND) :: XP,YP,T,B,Z1,Z2
 INTEGER :: IU,JU,I,J,K,IM,N,IOS,II,ILAY,JLAY,MAXNLAY,IROW,ICOL,JROW,JCOL,ID
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:,:) :: BND,TOP,BOT
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: ICON1,ICON2
 INTEGER,DIMENSION(2) :: MNLAY 
 CHARACTER(LEN=256) :: FNAME,LINE
 CHARACTER(LEN=52) :: TXT,MDLNAME
 CHARACTER(LEN=1),DIMENSION(6) :: CID=['N','S','W','E','T','B'] 
 LOGICAL :: LEX,LTOP,LBOT,LLAT
 
 MDLNAME=MNAME(INDEX(MNAME,'\',.TRUE.)+1:)
 
 FNAME=TRIM(DIR)//'\MFSIM_M'//TRIM(ITOS(M1))//'_M'//TRIM(ITOS(M2))//'.EXG'
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# '//TRIM(FNAME(INDEX(FNAME,'\',.TRUE.)+1:))//' File Generated by '//TRIM(UTL_IMODVERSION())
 WRITE(IU,'(/A/)') '#General Options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)WRITE(IU,'(A)') 'AUXILIARY ANGLDEGX'
 !## only output of one of the flowfluxes is active
 DO I=1,SIZE(TFLX)
  IF(ASSOCIATED(PBMAN%ISAVE(TFLX(I))%ILAY))THEN
   WRITE(IU,'(1X,A)') 'SAVE_FLOWS'; EXIT
  ENDIF
 ENDDO
! WRITE(IU,'(1X,A)') 'PRINT_INPUT' - no geprint in file
! WRITE(IU,'(1X,A)') 'PRINT_FLOWS' - no geprint in file
! WRITE(IU,'(1X,A)') 'HARMONIC' 
! WRITE(IU,'(A)') '[VARIABLECV [DEWATERED]]'
 IF(PBMAN%NEWTON.EQ.1)WRITE(IU,'(1X,A)') 'NEWTON'
! WRITE(IU,'(A)') '[GNC6 FILEIN <gnc6_filename>]' !## ghost-node correction
! WRITE(IU,'(A)') '[MVR6 FILEIN <mvr6_filename>]' !## water mover
! WRITE(IU,'(A)') '[OBS6 FILEIN <obs6_filename>]' !## observation
 WRITE(IU,'(A)') 'END OPTIONS'

 !## read boundary-files
 DO II=1,2
  MAXNLAY=0
  DO IM=1,2
   JU=UTL_GETUNIT()
   IF(IM.EQ.1)OPEN(JU,FILE=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M1))//'\MODELINPUT\'//TRIM(MDLNAME)//'.DIS6',STATUS='OLD',ACTION='READ')
   IF(IM.EQ.2)OPEN(JU,FILE=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M2))//'\MODELINPUT\'//TRIM(MDLNAME)//'.DIS6',STATUS='OLD',ACTION='READ')
   DO 
    READ(JU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    IF(INDEX(LINE,'BEGIN DIMENSIONS').GT.0)THEN
     READ(JU,*) TXT,MNLAY(IM); MAXNLAY=MAX(MAXNLAY,MNLAY(IM)); IF(IM.EQ.1)NLAY=MNLAY(IM)
     IF(II.EQ.2)THEN
      IF(IM.EQ.1)THEN
       !## read bnd as is
       DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(BND(1,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M1))//'\MODELINPUT\DIS6\BND_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
      ELSE
       DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(BND(2,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M2))//'\MODELINPUT\DIS6\BND_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
      ENDIF
      EXIT
     ENDIF
    ENDIF
   ENDDO
   CLOSE(JU)
  ENDDO
  IF(II.EQ.1)THEN
   ALLOCATE(BND(2,MAXNLAY)); DO I=1,SIZE(BND,1); DO J=1,SIZE(BND,2); CALL IDFNULLIFY(BND(I,J)); ENDDO; ENDDO
  ENDIF
 ENDDO

 !## check whether the first is smaller than the second first - return otherwise, it will come along later
 IF(BND(2,1)%DX.LT.BND(1,1)%DX.OR.NEX.GT.0)THEN
  DO I=1,SIZE(BND,1); DO J=1,SIZE(BND,2); CALL IDFDEALLOCATEX(BND(I,J)); ENDDO; ENDDO
  WRITE(IU,'(/A/)') '#Dimensions'
  WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
  WRITE(IU,'(1X,A)') 'NEXG '//TRIM(ITOS(0))
  WRITE(IU,'(A)') 'END DIMENSIONS'
  WRITE(IU,'(/A/)') '#Exchange Data'
  WRITE(IU,'(A)') 'BEGIN EXCHANGEDATA'
  WRITE(IU,'(/A)') 'END EXCHANGEDATA'
  DEALLOCATE(BND); CLOSE(IU); RETURN
 ENDIF

 ALLOCATE(TOP(2,MAXNLAY),BOT(2,MAXNLAY),ICON1(MNLAY(1)),ICON2(MNLAY(2)))
 DO I=1,SIZE(TOP,1); DO J=1,SIZE(TOP,2); CALL IDFNULLIFY(TOP(I,J)); ENDDO; ENDDO
 DO I=1,SIZE(BOT,1); DO J=1,SIZE(BOT,2); CALL IDFNULLIFY(BOT(I,J)); ENDDO; ENDDO

 !## correct the idomain
 DO K=1,2; DO ILAY=1,MNLAY(K); DO IROW=1,BND(K,1)%NROW; DO ICOL=1,BND(K,1)%NCOL
  BND(K,ILAY)%X(ICOL,IROW)=MIN(1.0D0,BND(K,ILAY)%X(ICOL,IROW))
  !## inactive
  IF(BND(K,ILAY)%X(ICOL,IROW).EQ.0.0D0)BND(K,ILAY)%X(ICOL,IROW)=BND(K,ILAY)%NODATA
  !## vertically inactive idomain.le.0
  IF(BND(K,ILAY)%X(ICOL,IROW).LT.0.0D0)BND(K,ILAY)%X(ICOL,IROW)=BND(K,ILAY)%NODATA
 ENDDO; ENDDO; ENDDO; ENDDO
 
 !## save connections
 DO ILAY=1,MNLAY(1); CALL IDFCOPY(BND(1,1),ICON1(ILAY)); ENDDO
 DO ILAY=1,MNLAY(2); CALL IDFCOPY(BND(2,1),ICON2(ILAY)); ENDDO

 LTOP=.FALSE.; LBOT=.FALSE.; LLAT=.FALSE.
 
 !## determine whether layers are onm top,bottom or next to eachother
 ILAY=PBMAN%SM(M1)%ILAY(1)
 JLAY=PBMAN%SM(M2)%ILAY(1)
 IF(ILAY.LT.JLAY)THEN
  LBOT=.TRUE.
 ELSEIF(ILAY.GT.JLAY)THEN
  LTOP=.TRUE.
 ELSE
  LLAT=.TRUE.
 ENDIF
 
 !## coarse model is on top of fine model
 IF(LTOP)THEN
  IF(.NOT.ASSOCIATED(PBMAN%SM(M1)%CON(1)%X))THEN
   CALL IDFCOPY(BND(1,1),PBMAN%SM(M1)%CON(1))
   IF(.NOT.IDFALLOCATEX(PBMAN%SM(M1)%CON(1)))RETURN
   PBMAN%SM(M1)%CON(1)%X=0.0D0
  ENDIF
 !## coarse model is on the bottom of fine model
 ELSEIF(LBOT)THEN
  IF(.NOT.ASSOCIATED(PBMAN%SM(M1)%CON(2)%X))THEN
   CALL IDFCOPY(BND(1,1),PBMAN%SM(M1)%CON(2))
   IF(.NOT.IDFALLOCATEX(PBMAN%SM(M1)%CON(2)))RETURN
   PBMAN%SM(M1)%CON(2)%X=0.0D0
  ENDIF
 !## coarse model is lateral of fine model
 ELSEIF(LLAT)THEN
  IF(.NOT.ASSOCIATED(PBMAN%SM(M1)%CON(3)%X))THEN
   CALL IDFCOPY(BND(1,1),PBMAN%SM(M1)%CON(3))
   IF(.NOT.IDFALLOCATEX(PBMAN%SM(M1)%CON(3)))RETURN
   PBMAN%SM(M1)%CON(3)%X=0.0D0
  ENDIF
 ENDIF
 
 !## read top/bottom in coarse-resolution
 DO IM=1,2
  JU=UTL_GETUNIT()
  IF(IM.EQ.1)THEN
   DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(TOP(1,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M1))//'\MODELINPUT\DIS6\TOPM_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
   DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(BOT(1,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M1))//'\MODELINPUT\DIS6\BOTM_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
  ELSE
   DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(TOP(2,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M2))//'\MODELINPUT\DIS6\TOPM_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
   DO I=1,MNLAY(IM); IF(.NOT.IDFREAD(BOT(2,I),TRIM(DIR)//'\GWF_'//TRIM(ITOS(M2))//'\MODELINPUT\DIS6\BOTM_L'//TRIM(ITOS(I))//'.IDF',1))RETURN; ENDDO
  ENDIF
 ENDDO
 
 DO I=1,2
  N=0

  !## keep track of type of connections
  DO ILAY=1,MNLAY(1); ICON1(ILAY)%X=0.0D0; ENDDO
  DO ILAY=1,MNLAY(2); ICON2(ILAY)%X=0.0D0; ENDDO

  !## vertical connections
  IF(LTOP)THEN
   DO IROW=1,BND(1,1)%NROW; DO ICOL=1,BND(1,1)%NCOL

    !## already created a link upwards
    IF(PBMAN%SM(M1)%CON(1)%X(ICOL,IROW).NE.0.0D0)CYCLE

    !## find first top-layer to be potential connected to an upper layer
ILAYLOOP1: DO ILAY=1,MNLAY(1)
     !## skip inactive cells
     IF(BND(1,ILAY)%X(ICOL,IROW).EQ.BND(1,ILAY)%NODATA)CYCLE
     !## if active in other model - probably vertical connection to the top/bottom
     CALL IDFGETLOC(BND(1,1),IROW,ICOL,XP,YP); CALL IDFIROWICOL(BND(2,1),JROW,JCOL,XP,YP)
     Z1=TOP(1,ILAY)%X(JCOL,JROW); Z2=BOT(1,ILAY)%X(JCOL,JROW)
     !## try top connection
     LEX=.FALSE.; DO JLAY=MNLAY(2),1,-1
      !## only try active layer on top
      T=TOP(2,JLAY)%X(JCOL,JROW); B=BOT(2,JLAY)%X(JCOL,JROW)
      IF(T-B.GT.0.0D0)THEN
       IF(PMANAGER_SAVEMF6_EXG_CONNECTIONS('T',IU,ILAY,IROW,ICOL,JLAY,BND,TOP,BOT,I))THEN
        IF(I.EQ.2)PBMAN%SM(M1)%CON(1)%X(ICOL,IROW)=M2
        N=N+1
        !## id number of cell to be connected to
        ICON1(ILAY)%X(ICOL,IROW)=N
        ICON2(JLAY)%X(JCOL,JROW)=N
        !## stop looking
        EXIT ILAYLOOP1
       ENDIF
      ENDIF
     ENDDO
    ENDDO ILAYLOOP1
   ENDDO; ENDDO
  ENDIF
  
  !## vertical connections
  IF(LBOT)THEN
   DO IROW=1,BND(1,1)%NROW; DO ICOL=1,BND(1,1)%NCOL

    !## already created a link downwards
    IF(PBMAN%SM(M1)%CON(2)%X(ICOL,IROW).NE.0.0D0)CYCLE

    !## find first bottom-layer to be potential connected to a lower layer
ILAYLOOP2: DO ILAY=MNLAY(1),1,-1
     !## skip inactive cells
     IF(BND(1,ILAY)%X(ICOL,IROW).EQ.BND(1,ILAY)%NODATA)CYCLE
     !## if active in other model - probably vertical connection to the top/bottom
     CALL IDFGETLOC(BND(1,1),IROW,ICOL,XP,YP); CALL IDFIROWICOL(BND(2,1),JROW,JCOL,XP,YP)
     Z1=TOP(1,ILAY)%X(JCOL,JROW); Z2=BOT(1,ILAY)%X(JCOL,JROW)
     !## try bot connection
     LEX=.FALSE.; DO JLAY=1,MNLAY(2)
      !## only try active layer on top
      T=TOP(2,JLAY)%X(JCOL,JROW); B=BOT(2,JLAY)%X(JCOL,JROW)
      IF(T-B.GT.0.0D0)THEN
       IF(PMANAGER_SAVEMF6_EXG_CONNECTIONS('B',IU,ILAY,IROW,ICOL,JLAY,BND,TOP,BOT,I))THEN
        IF(I.EQ.2)PBMAN%SM(M1)%CON(2)%X(ICOL,IROW)=M2
        N=N+1
        !## id number of cell to be connected to
        ICON1(ILAY)%X(ICOL,IROW)=N
        ICON2(JLAY)%X(JCOL,JROW)=N
        !## stop looking
        EXIT ILAYLOOP2
       ENDIF
      ENDIF
     ENDDO
    ENDDO ILAYLOOP2
   ENDDO; ENDDO
  ENDIF
  
  IF(LLAT)THEN
   DO ILAY=1,MNLAY(1)
    !## connections
    DO IROW=1,BND(1,ILAY)%NROW; DO ICOL=1,BND(1,ILAY)%NCOL
     !## skip inactive cells
     IF(BND(1,ILAY)%X(ICOL,IROW).EQ.BND(1,ILAY)%NODATA)CYCLE

     !## found boundary cell
     DO ID=1,4
      LEX=.FALSE.
      SELECT CASE (CID(ID))
       !## north
       CASE ('N')
        IF(IROW.EQ.1)LEX=.TRUE.
        IF(IROW.GT.1)THEN; LEX=BND(1,ILAY)%X(ICOL,IROW-1).EQ.BND(1,ILAY)%NODATA; ENDIF
       !## south
       CASE ('S')
        IF(IROW.EQ.BND(1,ILAY)%NROW)LEX=.TRUE.
        IF(IROW.LT.BND(1,ILAY)%NROW)THEN; LEX=BND(1,ILAY)%X(ICOL,IROW+1).EQ.BND(1,ILAY)%NODATA; ENDIF
       !## west
       CASE ('W')
        IF(ICOL.EQ.1)LEX=.TRUE.
        IF(ICOL.GT.1)THEN; LEX=BND(1,ILAY)%X(ICOL-1,IROW).EQ.BND(1,ILAY)%NODATA; ENDIF
       !## east 
       CASE ('E')
        IF(ICOL.EQ.BND(1,ILAY)%NCOL)LEX=.TRUE.
        IF(ICOL.LT.BND(1,ILAY)%NCOL)THEN; LEX=BND(1,ILAY)%X(ICOL+1,IROW).EQ.BND(1,ILAY)%NODATA; ENDIF
      END SELECT
 
      IF(.NOT.LEX)CYCLE
      IF(PMANAGER_SAVEMF6_EXG_CONNECTIONS(CID(ID),IU,ILAY,IROW,ICOL,0,BND,TOP,BOT,I))THEN
       IF(I.EQ.2)PBMAN%SM(M1)%CON(3)%X(ICOL,IROW)=M2
       N=N+1
       !## id number of cell to be connected to
       ICON1(ILAY)%X(ICOL,IROW)=N
       CALL IDFGETLOC(BND(1,1),IROW,ICOL,XP,YP); CALL IDFIROWICOL(BND(2,1),JROW,JCOL,XP,YP)
       IF(JROW.NE.0.AND.JCOL.NE.0)ICON2(ILAY)%X(JCOL,JROW)=N
      ENDIF
     ENDDO
 
    ENDDO; ENDDO
   ENDDO 
  ENDIF
  
  IF(I.EQ.1)THEN
   WRITE(IU,'(/A/)') '#Dimensions'
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   WRITE(IU,'(1X,A)') 'NEXG '//TRIM(ITOS(N)); NEX=N
   WRITE(IU,'(A)') 'END DIMENSIONS'
   WRITE(IU,'(/A/)') '#Exchange Data'
   WRITE(IU,'(A)') 'BEGIN EXCHANGEDATA'
  ELSE
   WRITE(IU,'(A)') 'END EXCHANGEDATA'
  ENDIF
 
 ENDDO

 CLOSE(IU)
  
 !## write connections
 DO I=1,MNLAY(1)
  ICON1(I)%FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M1))//'\GWF_EXCHANGE\GWF_'//TRIM(ITOS(M1))//'_L'//TRIM(ITOS(I))//'_GWF_'//TRIM(ITOS(M2))//'.IDF'
  IF(MAXVAL(ICON1(I)%X).EQ.0.0D0)CYCLE
  IF(.NOT.IDFWRITE(ICON1(I),ICON1(I)%FNAME,1))THEN; ENDIF
 ENDDO
 DO I=1,MNLAY(2)
  ICON2(I)%FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M2))//'\GWF_EXCHANGE\GWF_'//TRIM(ITOS(M2))//'_L'//TRIM(ITOS(I))//'_GWF_'//TRIM(ITOS(M1))//'.IDF'
  IF(MAXVAL(ICON2(I)%X).EQ.0.0D0)CYCLE
  IF(.NOT.IDFWRITE(ICON2(I),ICON2(I)%FNAME,1))THEN; ENDIF
 ENDDO
 
 DO I=1,SIZE(BND,1); DO J=1,SIZE(BND,2); CALL IDFDEALLOCATEX(BND(I,J)); ENDDO; ENDDO
 DO I=1,SIZE(TOP,1); DO J=1,SIZE(TOP,2); CALL IDFDEALLOCATEX(TOP(I,J)); ENDDO; ENDDO
 DO I=1,SIZE(BOT,1); DO J=1,SIZE(BOT,2); CALL IDFDEALLOCATEX(BOT(I,J)); ENDDO; ENDDO
 DEALLOCATE(BND,TOP,BOT)
 DO I=1,SIZE(ICON1); CALL IDFDEALLOCATEX(ICON1(I)); ENDDO 
 DO I=1,SIZE(ICON2); CALL IDFDEALLOCATEX(ICON2(I)); ENDDO 
 DEALLOCATE(ICON1,ICON2)
 
 END SUBROUTINE PMANAGER_SAVEMF6_EXG
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF6_EXG_MODIFYHFB(MAINDIR,MNAME,M1,SUBNLAY) 
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: MNAME,MAINDIR
 INTEGER,INTENT(IN),DIMENSION(:) :: SUBNLAY
 INTEGER,INTENT(IN) :: M1
 CHARACTER(LEN=256) :: FNAME,STRING,MDLNAME
 CHARACTER(LEN=52) :: TXT
 CHARACTER(LEN=1) :: CDIR,CHV
 INTEGER :: IU,JU,KU,IOS,ILAY,IROW,ICOL,N,IHC,M,M2,IHFB,NEXG,MM,II
 REAL(KIND=DP_KIND) :: HWVA,AREA,F
 REAL(KIND=DP_KIND),DIMENSION(2) :: CL
 TYPE HFBOBJ
  INTEGER,DIMENSION(2) :: ICOL,IROW
  INTEGER :: ILAY,IBND
  CHARACTER(LEN=1) :: CHV
  REAL(KIND=DP_KIND) :: C,F
 END TYPE HFBOBJ
 TYPE(HFBOBJ),ALLOCATABLE,DIMENSION(:,:) :: HFB
 INTEGER,DIMENSION(2,3) :: CELLID
 INTEGER,DIMENSION(2) :: NHFB
 
 MDLNAME=MNAME(INDEX(MNAME,'\',.TRUE.)+1:)

 !## correct any exchange, if needed, for this submodel
 DO M2=1,PBMAN%NSUBMODEL
  IF(M2.EQ.M1)CYCLE
  
  FNAME=TRIM(MAINDIR)//'\MFSIM_M'//TRIM(ITOS(M1))//'_M'//TRIM(ITOS(M2))//'.EXG'
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  FNAME=TRIM(MAINDIR)//'\MFSIM_M'//TRIM(ITOS(M1))//'_M'//TRIM(ITOS(M2))//'.EXG_'
  KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(KU.EQ.0)RETURN
 
  DO
   READ(IU,'(A256)',IOSTAT=IOS) STRING
   !## file probably empty
   IF(IOS.NE.0)EXIT
   IF(TRIM(STRING).EQ.'BEGIN DIMENSIONS')THEN
    WRITE(KU,'(A)') TRIM(STRING)
    READ(IU,'(A256)',IOSTAT=IOS) STRING
    READ(STRING,*)  TXT,NEXG
   ENDIF
   IF(TRIM(STRING).EQ.'BEGIN EXCHANGEDATA')THEN
    WRITE(KU,'(A)') TRIM(STRING)
    
    !## load all hfbs on boundaries for both sub models
    ALLOCATE(HFB(2,1)); NHFB=0

    !## exchange existing
    IF(NEXG.GT.0)THEN
    
     DO I=1,2
      M=0; DO IHFB=1,2
       IF(IHFB.EQ.1)MM=M1; IF(IHFB.EQ.2)MM=M2
       N=0; DO ILAY=1,SUBNLAY(MM)
        FNAME=TRIM(MAINDIR)//'\GWF_'//TRIM(ITOS(MM))//'\MODELINPUT\'//TRIM(MDLNAME)//'_HFB_L'//TRIM(ITOS(ILAY))//'.DAT'
        JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED',IQUESTION=0)
        IF(JU.GT.0)THEN
         READ(JU,*)
         DO
          N=N+1
          IF(I.EQ.1)THEN
           M=M+1; IF(I.EQ.1)N=1
          ELSE
           IF(N.GT.NHFB(IHFB))EXIT
          ENDIF
          READ(JU,'(11X,F15.0,17X,F15.0,10X,5I10)',IOSTAT=IOS) HFB(IHFB,N)%C,      HFB(IHFB,N)%F,      HFB(IHFB,N)%ICOL(1), &
                                                               HFB(IHFB,N)%IROW(1),HFB(IHFB,N)%ICOL(2),HFB(IHFB,N)%IROW(2), &
                                                               HFB(IHFB,N)%IBND
          IF(IOS.NE.0)EXIT
          HFB(IHFB,N)%ILAY=ILAY
          !## horizontal
          IF(HFB(IHFB,N)%ICOL(1).LT.HFB(IHFB,N)%ICOL(2))HFB(IHFB,N)%CHV='H'
          IF(HFB(IHFB,N)%ICOL(1).GT.HFB(IHFB,N)%ICOL(2))HFB(IHFB,N)%CHV='H'
          !## vertical
          IF(HFB(IHFB,N)%IROW(1).LT.HFB(IHFB,N)%IROW(2))HFB(IHFB,N)%CHV='V'
          IF(HFB(IHFB,N)%IROW(1).GT.HFB(IHFB,N)%IROW(2))HFB(IHFB,N)%CHV='V'
         ENDDO
         M=M-1; IF(I.EQ.1)NHFB(IHFB)=M; CLOSE(JU)
        ENDIF
       ENDDO
      ENDDO
      IF(MAXVAL(NHFB).GT.0)THEN
       IF(I.EQ.1)THEN
        DEALLOCATE(HFB); ALLOCATE(HFB(2,MAXVAL(NHFB)))
       ENDIF
      ELSE
       !## nothing found - continue
       EXIT
      ENDIF
     ENDDO
    ENDIF

    !## check whether hfb urges to modify exchange
    DO
     READ(IU,'(A256)',IOSTAT=IOS) STRING; IF(IOS.NE.0)EXIT; IF(LEN_TRIM(STRING).EQ.0)EXIT
     IF(TRIM(STRING).EQ.'END EXCHANGEDATA')EXIT
     READ(STRING,'(7I10,5G15.7,3X,A1)') (CELLID(1,I),I=1,3),(CELLID(2,I),I=1,3),IHC,CL(1),CL(2),HWVA,AREA,CDIR
     SELECT CASE (CDIR); CASE ('E','W'); CHV='H'; CASE DEFAULT; CHV='V'; END SELECT
     DO IHFB=1,2
      !## look for fault
      ILAY=CELLID(IHFB,1)
      IROW=CELLID(IHFB,2)
      ICOL=CELLID(IHFB,3)
IILOOP: DO I=1,NHFB(IHFB)
       !## skip if not on a potential boundary
       IF(HFB(IHFB,I)%IBND.EQ.0)CYCLE
       DO II=1,2
        IF(HFB(IHFB,I)%ILAY .EQ.ILAY.AND. &
           HFB(IHFB,I)%IROW(II).EQ.IROW.AND. &
           HFB(IHFB,I)%ICOL(II).EQ.ICOL.AND. &
           HFB(IHFB,I)%CHV .EQ.CHV)THEN
         !## no flow at all - remove exchange --- this need to be solved by the USGS
         F=HUGE(1.0)
         !## found hfb location in between current sub model - apply factor
         CL=CL*F; EXIT IILOOP
        ENDIF
       ENDDO
      ENDDO IILOOP
      IF(IHFB.EQ.2.OR.I.LE.NHFB(IHFB))THEN
       WRITE(KU,'(7I10,5G15.7,1X,A3)') (CELLID(1,I),I=1,3),(CELLID(2,I),I=1,3),IHC,CL(1),CL(2),HWVA,AREA,CDIR
       EXIT
      ENDIF
     ENDDO
    ENDDO
    DEALLOCATE(HFB)
    WRITE(KU,'(A)') TRIM(STRING)
   ELSE
    WRITE(KU,'(A)') TRIM(STRING)
   ENDIF
  ENDDO
  
  CLOSE(IU,STATUS='DELETE'); CLOSE(KU)
  CALL IOSRENAMEFILE(TRIM(MAINDIR)//'\MFSIM_M'//TRIM(ITOS(M1))//'_M'//TRIM(ITOS(M2))//'.EXG_', &
                     TRIM(MAINDIR)//'\MFSIM_M'//TRIM(ITOS(M1))//'_M'//TRIM(ITOS(M2))//'.EXG')
 ENDDO
 
 END SUBROUTINE PMANAGER_SAVEMF6_EXG_MODIFYHFB
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF6_EXG_CONNECTIONS(CDIR,IU,ILAY,IROW,ICOL,KLAY,BND,TOP,BOT,IIU)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: CDIR
 INTEGER,INTENT(IN) :: ILAY,IROW,ICOL,IU,IIU,KLAY
 TYPE(IDFOBJ),INTENT(IN),DIMENSION(:,:) :: BND,TOP,BOT
 INTEGER,DIMENSION(2,3) :: CELLID
 INTEGER :: JROW,JCOL,JLAY,IHC,I 
 REAL(KIND=DP_KIND) :: HWVA,XP1,YP1,XP2,YP2,X1,X2,Y1,Y2,Z1,Z2,XP,YP,ZP1,ZP2,DX1,DX2,DY1,DY2,DZ1,DZ2, &
                       XINT1,YINT1,ZINT1,XINT2,YINT2,ZINT2,ANGLDEGX,DX,DY
 REAL(KIND=DP_KIND),DIMENSION(2) :: CL

 PMANAGER_SAVEMF6_EXG_CONNECTIONS=.FALSE.
 
 !## active cell?
 IF(BND(1,ILAY)%X(ICOL,IROW).EQ.BND(1,ILAY)%NODATA)RETURN

 !## current centre location of fine model
 CALL IDFGETLOC  (BND(1,ILAY),IROW,ICOL,XP1,YP1)
 !## get location in coarse-model use ilay=1
 CALL IDFGETEDGE (BND(1,ILAY),IROW,ICOL,X1 ,Y1 ,X2 ,Y2)

 !## get vertical position of node
 Z2=TOP(1,ILAY)%X(ICOL,IROW); Z1=BOT(1,ILAY)%X(ICOL,IROW)
 DZ1=Z2-Z1; ZP1=Z1+0.5D0*DZ1
 !## get cellsize of fine model
 CALL IDFGETDXDY(BND(1,ILAY),IROW,ICOL,DX1,DY1)

 !## get location of nearest course model
 SELECT CASE (CDIR)
  CASE ('N'); CALL IDFGETLOC(BND(1,ILAY),IROW-1,ICOL,XP,YP); IHC=1; JLAY=ILAY
  CASE ('S'); CALL IDFGETLOC(BND(1,ILAY),IROW+1,ICOL,XP,YP); IHC=1; JLAY=ILAY
  CASE ('W'); CALL IDFGETLOC(BND(1,ILAY),IROW,ICOL-1,XP,YP); IHC=1; JLAY=ILAY
  CASE ('E'); CALL IDFGETLOC(BND(1,ILAY),IROW,ICOL+1,XP,YP); IHC=1; JLAY=ILAY
  CASE ('T'); CALL IDFGETLOC(BND(1,ILAY),IROW,ICOL  ,XP,YP); IHC=0; JLAY=KLAY
  CASE ('B'); CALL IDFGETLOC(BND(1,ILAY),IROW,ICOL  ,XP,YP); IHC=0; JLAY=KLAY
 END SELECT
 
 !## outside parent model
 CALL IDFIROWICOL(BND(2,JLAY),JROW,JCOL,XP,YP); IF(JROW.LE.0.OR.JCOL.LE.0)RETURN

 !## check if location is active
 IF(BND(2,JLAY)%X(JCOL,JROW).EQ.BND(2,JLAY)%NODATA)RETURN
 
 !## get location of cell outside submodel
 CALL IDFGETLOC(BND(2,JLAY),JROW,JCOL,XP2,YP2)
 !## get vertical position of node
 DZ2=TOP(2,JLAY)%X(JCOL,JROW)-BOT(2,JLAY)%X(JCOL,JROW)
 ZP2=BOT(2,JLAY)%X(JCOL,JROW)+0.5D0*DZ2
 !## get cellsize of course model
 CALL IDFGETDXDY(BND(2,JLAY),JROW,JCOL,DX2,DY2)

 DX=XP2-XP1
 DY=YP2-YP1
 ANGLDEGX=ATAN2(DY,DX)
 ANGLDEGX=(ANGLDEGX*360.0D0)/(2.0D0*PI)
 IF(ANGLDEGX.LT.0.0D0)ANGLDEGX=ANGLDEGX+360.0D0
 
 CELLID(1,1)=ILAY
 CELLID(1,2)=IROW
 CELLID(1,3)=ICOL
 CELLID(2,1)=JLAY
 CELLID(2,2)=JROW
 CELLID(2,3)=JCOL

 !## find point on shared interface
 SELECT CASE (CDIR)
  CASE ('W')
   XINT1=X1; YINT1=YP1
   XINT2=X1; YINT2=YP2
  CASE ('E')
   XINT1=X2; YINT1=YP1
   XINT2=X2; YINT2=YP2
  CASE ('N')
   XINT1=XP1; YINT1=Y2
   XINT2=XP2; YINT2=Y2
  CASE ('S')
   XINT1=XP1; YINT1=Y1
   XINT2=XP2; YINT2=Y1
  CASE ('T')
   ZINT1=Z2; XINT1=XP1; YINT1=YP1
   ZINT2=Z2; XINT2=XP2; YINT2=YP2
  CASE ('B')
   ZINT1=Z1; XINT1=XP1; YINT1=YP1
   ZINT2=Z1; XINT2=XP2; YINT2=YP2
 END SELECT

 !## area of connection in vertical
 HWVA=0.0D0

 !## width of connection
 IF(IHC.EQ.1)THEN

  !## distance to shared interface
  CL(1)=UTL_DIST(XP1,YP1,XINT1,YINT1)
  CL(2)=UTL_DIST(XP2,YP2,XINT2,YINT2)
  HWVA=X2-X1

 !## area of connection
 ELSEIF(IHC.EQ.0)THEN

  !## ook 2d denk ik ... gewoon recht naar het vlak toe
  CL(1)=UTL_DIST_3D(XP1,YP1,ZP1,XINT1,YINT1,ZINT1)
  CL(2)=UTL_DIST_3D(XP2,YP2,ZP2,XINT2,YINT2,ZINT2)
  HWVA=(X2-X1)*(Y2-Y1)

 ENDIF

 IF(IIU.EQ.2)THEN
  IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
   WRITE(IU,'(7I10,5G15.7,1X,A3)') (CELLID(1,I),I=1,3),(CELLID(2,I),I=1,3),IHC,CL(1),CL(2),HWVA,ANGLDEGX,CDIR
  ELSE
   WRITE(IU,'(7I10,5G15.7,1X,A3)') (CELLID(1,I),I=1,3),(CELLID(2,I),I=1,3),IHC,CL(1),CL(2),HWVA,0.0D0,CDIR
  ENDIF
 ENDIF

 PMANAGER_SAVEMF6_EXG_CONNECTIONS=.TRUE.

 END FUNCTION PMANAGER_SAVEMF6_EXG_CONNECTIONS

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_MERGELAYERS()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: TP,BT,HK,VA,KD,C,TK
 INTEGER,DIMENSION(:),ALLOCATABLE :: IB
 INTEGER :: IROW,ICOL,ILAY,IL,IL1,IL2,TB1,TB2,TA1,TA2
 REAL(KIND=DP_KIND) :: CT,DK,MAXC,CT1,CT2,DK1,DK2,TT1,TT2,TC1,TC2,C1,VA1
 REAL(KIND=DP_KIND),PARAMETER :: MAXK=1.0D0
 
 PMANAGER_MERGELAYERS=.TRUE.; IF(PBMAN%MERGELAYERS.EQ.0.0D0)RETURN
 
 MAXC=PBMAN%MERGELAYERS
 
 PMANAGER_MERGELAYERS=.FALSE.
 
 ALLOCATE(TP(PRJNLAY),BT(PRJNLAY),HK(PRJNLAY),VA(PRJNLAY),IB(PRJNLAY),KD(PRJNLAY),C(PRJNLAY),TK(PRJNLAY))
 
 !## total number of active cells
 TA1=0; TA2=0
 
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  
  IF(IROW.EQ.2.AND.ICOL.EQ.2)THEN
   WRITE(*,*) 
  ENDIF
  
  DO ILAY=1,PRJNLAY
   IB(ILAY)=BND(ILAY)%X(ICOL,IROW)
   TP(ILAY)=TOP(ILAY)%X(ICOL,IROW)
   BT(ILAY)=BOT(ILAY)%X(ICOL,IROW)
   TK(ILAY)=TP(ILAY)-BT(ILAY)
   !## correct thickness in case ibound=0
   IF(IB(ILAY).EQ.0)TK(ILAY)=0.0D0
   HK(ILAY)=KHV(ILAY)%X(ICOL,IROW)
   VA(ILAY)=KVA(ILAY)%X(ICOL,IROW)
  ENDDO
  
  !## merge layers if possible
  !## a resistance is less then 10 days
  !## b transmissivity is in class of diff log10(k).lt.1.0
  KD=0.0D0; C=0.0D0
  DO ILAY=1,PRJNLAY
   IF(TK(ILAY).GT.0.0D0)THEN
    KD(ILAY)=(TK(ILAY))* HK(ILAY)
     C(ILAY)=(TK(ILAY))/(HK(ILAY)/VA(ILAY))
        TA1 = TA1+1
   ENDIF
  ENDDO
  
  !## totals
  TB1=SUM(ABS(IB)); TT1=SUM(KD); TC1=SUM(C) 
  
  C1=0.0D0; CT=0.0D0
  !## find first on-zero thickness layer
  DO IL1=1,PRJNLAY-1; IF(TK(IL1).GT.0.0D0)EXIT; ENDDO; IL2=IL1
  !## merge layers
  DO ILAY=IL1,PRJNLAY-1
!  DO ILAY=1,PRJNLAY-1
   CT1=0.0D0; CT2=0.0D0; DK1=0.0D0; DK2=0.0D0
   IF(TK(ILAY  ).NE.0)CT1=C(ILAY)  /2.0D0
   IF(TK(ILAY+1).NE.0)CT2=C(ILAY+1)/2.0D0
   !## total vertical resistance
   CT=CT+(CT1+CT2)
!   !## determine log10(material) - subsequently
!   IF(TK(IL1   ).GT.0.0D0)DK1=    LOG10(HK(IL1   ))
!   IF(TK(ILAY+1).GT.0.0D0)DK2=DK1-LOG10(HK(ILAY+1))
!   DK=ABS(DK2-DK1)
   !## still less vertical resistance and subsequent material within log10(1)
   IF(CT.GT.MAXC)THEN !.OR.DK.GT.MAXK)THEN
    BT(IL1)=BT(IL2)
    TK(IL1)=TP(IL1)-BT(IL1)
    DO IL=IL1+1,IL2
     !## take boundary setting
     IF(IB(IL1).GE.0.AND.IB(IL).NE.0)IB(IL1)=IB(IL)
     KD(IL1)=KD(IL1)+KD(IL)
      C(IL1)= C(IL1)+ C(IL)
     !## reset to default values
     KD(IL) =1.0D0
     HK(IL) =1.0D0
     VA(IL) =1.0D0
      C(IL) =1.0D0
     !## thickness of merges layer is 0.0
     TP(IL)=BT(IL2)
     BT(IL)=BT(IL2)
     TK(IL)=0.0D0
    ENDDO
    !## recompute hk and va
    IF(TK(IL1).GT.0.0D0)THEN
     HK(IL1)=KD(IL1)/(TP(IL1)-BT(IL1))
     !## vertical k-value
     VA(IL1)=(TP(IL1)-BT(IL1))/C(IL1)
     VA(IL1)= HK(IL1)         /VA(IL1)
     !## correct c value for first modellayer only, to be applied after checking column resistance
     IF(IL1.EQ.1)THEN
      !## resistance need to be this
      C1 =(CT-CT2)*2.0D0
      VA1=(TP(IL1)-BT(IL1))/C1
      VA1= HK(IL1)         /VA1
     ENDIF
    ENDIF
    IL1=ILAY+1; IL2=IL1; CT=0.0D0
   ELSE
    IL2=IL2+1
   ENDIF
  ENDDO
  
!10 continue    
  
  KD=0.0D0; C=0.0D0
  DO ILAY=1,PRJNLAY
   IF(TK(ILAY).GT.0.0D0)THEN
    KD(ILAY)=(TK(ILAY))* HK(ILAY)
    C(ILAY) =(TK(ILAY))/(HK(ILAY)/VA(ILAY))
        TA2 = TA2+1
   ENDIF
  ENDDO

  !## totals
  TB2=SUM(ABS(IB)); TT2=SUM(KD); TC2=SUM(C)
  
  IF(ABS(TT1-TT2).GT.0.1D0.OR.ABS(TC1-TC2).GT.0.1D0)THEN
   WRITE(*,'(2I5,4F10.2)') TB1,TB2,TT1,TT2,TC1,TC2
   pause
  ENDIF

  !## correct vertical resistance for layer 1
  IF(C1.NE.0.0D0)C(1)=C1
  
  !## no constant head in zero-thickness layer
!  DO ILAY=1,PRJNLAY
!   IF(TP(ILAY)-BT(ILAY).EQ.0.0D0)IB(ILAY)=ABS(IB(ILAY))
!  ENDDO

  !## copy new configuration
  DO ILAY=1,PRJNLAY
   
   if(BND(ILAY)%X(ICOL,IROW).ne.ib(ilay).AND.MAXC.LE.0.01)then
    write(*,*) 'bnd ',BND(ILAY)%X(ICOL,IROW),ib(ilay)
   endif
   BND(ILAY)%X(ICOL,IROW)=IB(ILAY)

   if(abs(TOP(ILAY)%X(ICOL,IROW)-TP(ilay)).gt.0.0001d0.AND.MAXC.LE.0.01)then
    write(*,*) 'top ',TOP(ILAY)%X(ICOL,IROW),tp(ilay)
   ENDIF
   TOP(ILAY)%X(ICOL,IROW)=TP(ILAY)

   if(abs(BOT(ILAY)%X(ICOL,IROW)-BT(ilay)).gt.0.0001d0.AND.MAXC.LE.0.01)then
    write(*,*) 'bot ',bot(ILAY)%X(ICOL,IROW),bt(ilay)
   ENDIF
   BOT(ILAY)%X(ICOL,IROW)=BT(ILAY)

   IF(TK(ILAY).GT.0.0D0)THEN
    if(abs(KHV(ILAY)%X(ICOL,IROW)-HK(ilay)).gt.0.0001d0.AND.MAXC.LE.0.01)then
     write(*,*) 'khv ',khv(ILAY)%X(ICOL,IROW),hk(ILAY)
    ENDIF
   ENDIF
   KHV(ILAY)%X(ICOL,IROW)=HK(ILAY)
   
   IF(TK(ILAY).GT.0.0D0)THEN
    if(abs(KVA(ILAY)%X(ICOL,IROW)-VA(ilay)).gt.0.000001d0.AND.MAXC.LE.0.01)then
     write(*,*) 'kva ',KVA(ILAY)%X(ICOL,IROW),VA(ILAY)
    ENDIF
   ENDIF
   KVA(ILAY)%X(ICOL,IROW)=VA(ILAY)
  ENDDO
    
 ENDDO; ENDDO

 !## make sure there is a uppermost layer available
 
 WRITE(*,'(/2(A,I10),A,F10.2,A/)') 'AGGREGATE DECREASES NUMBER OF ACTIVE CELLS FROM ',TA1,' TO ',TA2,' (',REAL(TA1,8)/REAL(TA2,8),'% REDUCTION)'
 
 DEALLOCATE(TP,BT,HK,VA,IB,KD,C,TK)

 PMANAGER_MERGELAYERS=.TRUE.
 
 END FUNCTION PMANAGER_MERGELAYERS
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_CONSISTENCY(LTB)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LTB
 INTEGER :: IROW,ICOL,ILAY,JLAY,N
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: TP,BT,HK,VK,VA,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU
 REAL(KIND=DP_KIND),DIMENSION(:,:),ALLOCATABLE :: TH
 INTEGER,DIMENSION(:),ALLOCATABLE :: IB
 REAL(KIND=DP_KIND) :: ST,SB
 
 !## make sure nodata for anisotropy factors is 1.0D0
 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
  !## apply consistency check anisotropy factor to be in between 0.0D0-1.0D0
  DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   ANF(ILAY)%X(ICOL,IROW)=MAX(0.0D0,MIN(1.0D0,ANF(ILAY)%X(ICOL,IROW)))
  ENDDO; ENDDO; ENDDO
  !## set boundary corners =0
  DO ILAY=1,PRJNLAY
   BND(ILAY)%X(1          ,1          )=0.0D0
   BND(ILAY)%X(PRJIDF%NCOL,1          )=0.0D0
   BND(ILAY)%X(1          ,PRJIDF%NROW)=0.0D0
   BND(ILAY)%X(PRJIDF%NCOL,PRJIDF%NROW)=0.0D0
  ENDDO
 ENDIF
 
 !## in case of modflow6 overrule consistency check to option 1
 IF(PBMAN%IFORMAT.EQ.3)THEN
  PBMAN%ICONSISTENCY=1; PBMAN%MINTHICKNESS=0.0D0
 ENDIF
 IF(TOPICS(TKHV)%IACT_MODEL.EQ.0)THEN; PBMAN%ICONSISTENCY=0; ENDIF
 
 !## clean from bottom to top inactive layers with zero conductance - in case of iconsistency.eq.1
 IF(PBMAN%ICONSISTENCY.NE.2)THEN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   DO ILAY=PRJNLAY,1,-1
    IF(KDW(ILAY)%X(ICOL,IROW).LE.0.0D0)THEN
     IF(ILAY.GT.1)VCW(ILAY-1)%X(ICOL,IROW)=0.0D0
     KDW(ILAY)%X(ICOL,IROW)=0.0D0   
     BND(ILAY)%X(ICOL,IROW)=0.0D0
    ELSE
     !## stop search for this location
     EXIT
    ENDIF
   ENDDO
  ENDDO; ENDDO
 ENDIF
 
 IF(.NOT.LTB)RETURN

 !## apply consistency check top/bot
 IF(PBMAN%ICONSISTENCY.EQ.1)THEN

  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; JLAY=0; DO ILAY=1,PRJNLAY
   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)CYCLE

   ST=TOP(ILAY)%X(ICOL,IROW)
   SB=BOT(ILAY)%X(ICOL,IROW)
   SB=MIN(ST,SB)
   BOT(ILAY)%X(ICOL,IROW)=SB
   
   IF(JLAY.GT.0)THEN
    !## minimal aquifer thickness
    SB=BOT(JLAY)%X(ICOL,IROW)
    ST=TOP(ILAY)%X(ICOL,IROW)
    ST=MIN(SB,ST)
    TOP(ILAY)%X(ICOL,IROW)=ST
   ENDIF

   !## store last active layer
   JLAY=ILAY

  ENDDO; ENDDO; ENDDO

  !## in case laye thickness are zero from the top and bottom, remove them
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   !## clean from the top downwards
   DO ILAY=1,PRJNLAY
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
    ST=TOP(ILAY)%X(ICOL,IROW); SB=BOT(ILAY)%X(ICOL,IROW); IF(ST-SB.GT.0.0D0)EXIT
   ENDDO
   DO JLAY=1,ILAY-1; BND(JLAY)%X(ICOL,IROW)=0.0D0; ENDDO
   !## clean from the bottom upwards
   DO ILAY=PRJNLAY,1,-1
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
    ST=TOP(ILAY)%X(ICOL,IROW); SB=BOT(ILAY)%X(ICOL,IROW); IF(ST-SB.GT.0.0D0)EXIT
   ENDDO
   DO JLAY=PRJNLAY,ILAY+1,-1; BND(JLAY)%X(ICOL,IROW)=0.0D0; ENDDO
  ENDDO; ENDDO
  
 ELSEIF(PBMAN%ICONSISTENCY.EQ.2)THEN
 
  IF(ALLOCATED(KHV).AND.ALLOCATED(KVA).AND.ALLOCATED(KVV))THEN

   ALLOCATE(TP(PRJNLAY)   ,BT(PRJNLAY)   ,HK(PRJNLAY)   ,VK(PRJNLAY)   ,VA(PRJNLAY)   ,IB(PRJNLAY),TH(PRJNLAY,2), &
            TP_BU(PRJNLAY),BT_BU(PRJNLAY),HK_BU(PRJNLAY),VK_BU(PRJNLAY),VA_BU(PRJNLAY))
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL

!    IF(IROW.EQ.38.AND.ICOL.EQ.39)THEN
!     WRITE(*,*) 
!    ENDIF
    
    DO ILAY=1,PRJNLAY  ; IB(ILAY)=BND(ILAY)%X(ICOL,IROW); ENDDO
    DO ILAY=1,PRJNLAY  ; TP(ILAY)=TOP(ILAY)%X(ICOL,IROW); ENDDO
    DO ILAY=1,PRJNLAY  ; BT(ILAY)=BOT(ILAY)%X(ICOL,IROW); ENDDO
    DO ILAY=1,PRJNLAY  ; HK(ILAY)=KHV(ILAY)%X(ICOL,IROW); ENDDO
    DO ILAY=1,PRJNLAY  ; VA(ILAY)=KVA(ILAY)%X(ICOL,IROW); ENDDO
    VK=0.0D0; DO ILAY=1,PRJNLAY-1; VK(ILAY)=KVV(ILAY)%X(ICOL,IROW); ENDDO
 
!    ib=1; tp=0.0d0
!    do ilay=2,prjnlay; tp(ilay)=tp(ilay-1)-1.0d0; enddo
!    do ilay=1,prjnlay; bt(ilay)=tp(ilay)  -1.0d0; enddo
!    IB(1)=0; IB(2)=0
!    BT(3)=-2.05D0
!    hk=1.0d0
!    vk=1.0d0
!    va=1.0d0
    CALL UTL_MINTHICKNESS(TP,BT,HK,VK,VA,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU,IB,TH,PBMAN%MINTHICKNESS,PRJNLAY,ICOL,IROW)

    DO ILAY=1,PRJNLAY  ; BND(ILAY)%X(ICOL,IROW)=IB(ILAY); ENDDO
!    DO ILAY=1,PRJNLAY  ; IB(ILAY)=BND(ILAY)%X(ICOL,IROW); ENDDO
    DO ILAY=1,PRJNLAY  ; TOP(ILAY)%X(ICOL,IROW)=TP(ILAY); ENDDO
    DO ILAY=1,PRJNLAY  ; BOT(ILAY)%X(ICOL,IROW)=BT(ILAY); ENDDO
    DO ILAY=1,PRJNLAY  ; KHV(ILAY)%X(ICOL,IROW)=HK(ILAY); ENDDO
    DO ILAY=1,PRJNLAY  ; KVA(ILAY)%X(ICOL,IROW)=VA(ILAY); ENDDO
    DO ILAY=1,PRJNLAY-1; KVV(ILAY)%X(ICOL,IROW)=VK(ILAY); ENDDO
    !## clean
    DO ILAY=1,PRJNLAY
     IF(IB(ILAY).EQ.0)THEN
      TOP(ILAY)%X(ICOL,IROW)=TOP(ILAY)%NODATA
      KHV(ILAY)%X(ICOL,IROW)=KHV(ILAY)%NODATA
      KVA(ILAY)%X(ICOL,IROW)=KVA(ILAY)%NODATA
      IF(ILAY.LT.PRJNLAY)KVV(ILAY)%X(ICOL,IROW)=KVV(ILAY)%NODATA
      !## skip bottom as well as layer below is nodata
      IF(ILAY.LT.PRJNLAY)THEN
       IF(IB(ILAY+1).EQ.0)BOT(ILAY)%X(ICOL,IROW)=BOT(ILAY)%NODATA
      ENDIF
     ENDIF
    ENDDO
   ENDDO; ENDDO
   DEALLOCATE(TP,BT,HK,VK,VA,IB,TH,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU)
  ENDIF
 ENDIF
 
 !## constant head is not allowed in cell with thickness of 0.0 - this is not neccessary for BCF-models
 IF(TOPICS(TKHV)%IACT_MODEL.EQ.1)THEN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; DO ILAY=1,PRJNLAY
   IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
    IF(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW).LE.0.0)BND(ILAY)%X(ICOL,IROW)=ABS(BND(ILAY)%X(ICOL,IROW))
   ENDIF
  ENDDO; ENDDO; ENDDO
 ENDIF
 
 !## apply consistency check constant head and top/bot - only whenever CHD is not active
 IF(PBMAN%ICHKCHD.EQ.1)THEN
  N=0
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; DO ILAY=1,PRJNLAY
   IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
    !## head is in within current layer
    IF(SHD(ILAY)%X(ICOL,IROW).GT.BOT(ILAY)%X(ICOL,IROW))CYCLE
    N=N+1
    !## constant head cell dry - becomes active node - shift to an appropriate model layer where the head is actually in
    DO JLAY=ILAY,PRJNLAY
     IF(SHD(ILAY)%X(ICOL,IROW).LE.BOT(JLAY)%X(ICOL,IROW))THEN
      BND(JLAY)%X(ICOL,IROW)=1.0D0
      SHD(JLAY)%X(ICOL,IROW)=SHD(ILAY)%X(ICOL,IROW)
     ELSE
      BND(JLAY)%X(ICOL,IROW)=-99.0D0
      SHD(JLAY)%X(ICOL,IROW)=SHD(ILAY)%X(ICOL,IROW)
      !## exit
      EXIT
     ENDIF
    ENDDO
   ENDIF
  ENDDO; ENDDO; ENDDO
  WRITE(*,'(/A/)') 'iMOD corrected '//TRIM(ITOS(N))//' constant heads cell which were inappropriate regarding there levels.'
 ENDIF
 
 !## if unconfined modify (nodata) head for dry cells, check from bottom to top
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; DO ILAY=PRJNLAY-1,1,-1
  IF(LAYCON(ILAY).NE.2)CYCLE
  IF(SHD(ILAY)%X(ICOL,IROW).EQ.HNOFLOW.AND.BND(ILAY)%X(ICOL,IROW).GT.0)THEN
   SHD(ILAY)%X(ICOL,IROW)=SHD(ILAY+1)%X(ICOL,IROW)
  ENDIF
 ENDDO; ENDDO; ENDDO 

 !## clean from bottom to top inactive layers with zero conductance
 IF(PBMAN%ICONSISTENCY.NE.2)THEN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   DO ILAY=PRJNLAY,1,-1
    IF(KDW(ILAY)%X(ICOL,IROW).LE.0.0D0)THEN
     IF(ILAY.GT.1)VCW(ILAY-1)%X(ICOL,IROW)=0.0D0
     KDW(ILAY)%X(ICOL,IROW)=0.0D0   
     BND(ILAY)%X(ICOL,IROW)=0.0D0
    ELSE
     !## stop search for this location
     EXIT
    ENDIF
   ENDDO
  ENDDO; ENDDO
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEMF2005_CONSISTENCY
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MF6_GETPARAM(LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(OUT) :: LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW
 INTEGER :: I
 
 LNPF=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF((PEST%PARAM(I)%PPARAM.EQ.'KH'.OR.PEST%PARAM(I)%PPARAM.EQ.'VA'))THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LNPF=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LNPF=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 LSTO=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF((PEST%PARAM(I)%PPARAM.EQ.'SC'.OR.PEST%PARAM(I)%PPARAM.EQ.'SY'))THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LSTO=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LSTO=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO
 
 LDRN=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'DC'.OR.PEST%PARAM(I)%PPARAM.EQ.'DL')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LDRN=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LDRN=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO
 
 LRIV=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'RC'.OR.PEST%PARAM(I)%PPARAM.EQ.'RL'.OR. &
     PEST%PARAM(I)%PPARAM.EQ.'RB'.OR.PEST%PARAM(I)%PPARAM.EQ.'RI')THEN
  IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LRIV=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LRIV=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO
 
 LISG=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'IC'.OR.PEST%PARAM(I)%PPARAM.EQ.'IL'.OR. &
     PEST%PARAM(I)%PPARAM.EQ.'IB'.OR.PEST%PARAM(I)%PPARAM.EQ.'II')THEN
  IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LISG=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LISG=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 LGHB=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'GC')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LGHB=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LGHB=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO
 
 LRCH=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'RE')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LRCH=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LRCH=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO
 
 LEVT=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'ET'.OR.PEST%PARAM(I)%PPARAM.EQ.'ED')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LEVT=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LEVT=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 LUZF=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'EP')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LUZF=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LUZF=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 LWEL=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'QR')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LWEL=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LWEL=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 LMNW=.FALSE.; DO I=1,SIZE(PEST%PARAM)
  IF(PEST%PARAM(I)%PPARAM.EQ.'MQ')THEN
   IF(PEST%PARAM(I)%PACT.EQ.1)THEN; LMNW=.TRUE.; EXIT; ENDIF
   IF(PEST%PARAM(I)%PACT.EQ.0.AND.PEST%PARAM(I)%PINI.NE.1.0D0)THEN; LMNW=.TRUE.; EXIT; ENDIF
  ENDIF
 ENDDO

 END SUBROUTINE PMANAGER_SAVEMF2005_MF6_GETPARAM

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_NAM(FNAME,MAINDIR,DIR,DIRMNAME,IPRT,ISS)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISS
 INTEGER,INTENT(OUT) :: IPRT
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=*),INTENT(OUT) :: DIR,DIRMNAME,MAINDIR
 INTEGER :: IU,I,J,K,N1,N2,ISYS
 CHARACTER(LEN=52) :: MNAME
 CHARACTER(LEN=256) :: NAME
 CHARACTER(LEN=3) :: CRELDIR
 CHARACTER(LEN=1) :: CT
 LOGICAL :: LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW
 
 PMANAGER_SAVEMF2005_NAM=.FALSE.
 
 IF(TOPICS(TUZF)%IACT_MODEL.EQ.1)THEN
  IF(LAYCON(1).NE.2)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is compulsory to use an unconfined first model layer for the UZF package','Error')
   RETURN
  ENDIF
 ENDIF

 !## result main folder
 MAINDIR=FNAME(:INDEX(FNAME,'\',.TRUE.)-1)
 MAINDIR=UTL_CAP(MAINDIR,'U'); CALL UTL_CREATEDIR(MAINDIR) 

 !## modelname
 MNAME=FNAME(INDEX(FNAME,'\',.TRUE.)+1:INDEX(FNAME,'.',.TRUE.)-1); MNAME=UTL_CAP(MNAME,'U')  

 IF(PBMAN%IPESTP.EQ.1)CALL PMANAGER_SAVEMF2005_MF6_GETPARAM(LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW)
 
 !## write *.nam file for modflow 6
 IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%ISUBMODEL.EQ.1)THEN
  
  CRELDIR='.\'; IF(TOPICS(TPST)%IACT_MODEL.EQ.1.OR.TOPICS(TIES)%IACT_MODEL.EQ.1)CRELDIR='..\'
 
  !## write *.nam file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(PEST%PE_MXITER.LT.0)THEN
    N1=-1; N2=N1
   ELSE
    N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   N1=1; N2=PEST%NREALS
  ENDIF
  
  DO I=N1,N2
   !## skip zero
   IF(I.EQ.0)CYCLE
  
   IF(PBMAN%IPESTP.EQ.1)THEN
    CT='L'; IF(I.GT.0)CT='P'
   ELSEIF(PBMAN%IIES.EQ.1)THEN
    CT='R'
   ENDIF

   IU=UTL_GETUNIT()
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    NAME=TRIM(MAINDIR)
   ELSEIF(PBMAN%IPESTP.EQ.1)THEN
    IF(I.GT.0)THEN
     IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    ENDIF
    NAME=TRIM(MAINDIR)//'\IPEST_'//CT//'#'//TRIM(ITOS(ABS(I))); CALL UTL_CREATEDIR(NAME)
   ENDIF
   NAME=TRIM(NAME)//'\MFSIM.NAM'
   CALL OSD_OPEN(IU,FILE=TRIM(NAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   IF(IU.EQ.0)RETURN
   
   WRITE(IU,'(A)') '# MFSIM.NAM File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
   IF(PCG%IQERROR.EQ.1)WRITE(IU,'(A)') ' CONTINUE'
![NOCHECK]
![MEMORY_PRINT_OPTION <memory_print_option>]
   WRITE(IU,'(A)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#Timing Options'
   WRITE(IU,'(A)') 'BEGIN TIMING'
   WRITE(IU,'(A)') ' TDIS6 '//TRIM(CRELDIR)//'MFSIM.TDIS6'
   WRITE(IU,'(A)') 'END TIMING'
   WRITE(IU,'(/A/)') '#List of Models'
   WRITE(IU,'(A)') 'BEGIN MODELS'
   !## multiply models
   DO K=1,PBMAN%NSUBMODEL
    IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
     NAME='' 
    ELSEIF(PBMAN%IPESTP.EQ.1)THEN
     IF(I.GT.0)THEN
      IF(PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
     ENDIF
     NAME='_'//CT//'#'//TRIM(ITOS(ABS(I)))
    ENDIF
    WRITE(IU,'(A)') ' GWF6 '//TRIM(CRELDIR)//'GWF_'//TRIM(ITOS(K))//'\'//TRIM(MNAME)//TRIM(NAME)//'.NAM GWF_'//TRIM(ITOS(K))
   ENDDO
   WRITE(IU,'(A)') 'END MODELS'
   WRITE(IU,'(/A/)') '#List of Exchanges'
   WRITE(IU,'(A)') 'BEGIN EXCHANGES'
   DO K=1,PBMAN%NSUBMODEL
    DO J=1,PBMAN%NSUBMODEL
     IF(K.EQ.J)CYCLE
     WRITE(IU,'(A)') ' GWF6-GWF6 '//TRIM(CRELDIR)//'MFSIM_M'//TRIM(ITOS(K))//'_M'//TRIM(ITOS(J))//'.EXG GWF_'//TRIM(ITOS(K))//' GWF_'//TRIM(ITOS(J))
    ENDDO
   ENDDO
   WRITE(IU,'(A)') 'END EXCHANGES'
   WRITE(IU,'(/A/)') '#Definition of Numerical Solution'
   WRITE(IU,'(A)') 'BEGIN SOLUTIONGROUP 1'
   WRITE(IU,'(A)') ' MXITER 1'
   WRITE(IU,'(A,99A)') ' IMS6 '//TRIM(CRELDIR)//'MFSIM.IMS6',(' GWF_'//TRIM(ITOS(K)),K=1,PBMAN%NSUBMODEL)
   WRITE(IU,'(A)') 'END SOLUTIONGROUP'
   CLOSE(IU)
  ENDDO
  
 ENDIF
 
 !## loop over multiply models
 DIR=MAINDIR; IF(PBMAN%IFORMAT.EQ.3)DIR=TRIM(MAINDIR)//'\GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))

 !## result folder including the modelname
 DIRMNAME='MODELINPUT\'//TRIM(MNAME)
 
 CALL UTL_CREATEDIR(TRIM(DIR)//'\MODELINPUT') 
 IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)CALL UTL_CREATEDIR(TRIM(DIR)//'\MSWAPINPUT') 

 IF(PBMAN%IFORMAT.EQ.3)THEN

  DIRMNAME='GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\'//TRIM(DIRMNAME)
  DIRMNAME=TRIM(CRELDIR)//TRIM(DIRMNAME)

  !## write *.nam file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(PEST%PE_MXITER.LT.0)THEN
    N1=-1; N2=N1
   ELSE  
    N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   N1=1; N2=PEST%NREALS
  ENDIF
  
  DO I=N1,N2
   !## skip zero
   IF(I.EQ.0)CYCLE
   
   IF(PBMAN%IPESTP.EQ.1)THEN
    CT='L'; IF(I.GT.0)CT='P'
   ELSEIF(PBMAN%IIES.EQ.1)THEN
    CT='R'
   ENDIF

   IU=UTL_GETUNIT()
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    NAME=TRIM(DIR)//'\'//TRIM(MNAME)//'.NAM'
   ELSEIF(PBMAN%IPESTP.EQ.1)THEN
    IF(I.GT.0)THEN
     IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    ENDIF
    NAME=TRIM(DIR)//'\'//TRIM(MNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.NAM'
   ENDIF
   CALL OSD_OPEN(IU,FILE=TRIM(NAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   IF(IU.EQ.0)RETURN
   WRITE(IU,'(A)') '# '//TRIM(MNAME)//'.NAM File Generated by '//TRIM(UTL_IMODVERSION())
   
   WRITE(IU,'(/A/)') '#General Options'
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    WRITE(IU,'(A)') ' LIST '//TRIM(CRELDIR)//'GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\'//TRIM(MNAME)//'.LST'
   ELSE 
    WRITE(IU,'(A)') ' LIST '//TRIM(CRELDIR)//'GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\'//TRIM(MNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.LST'
   ENDIF
   IF(PBMAN%NEWTON.EQ.1)WRITE(IU,'(A)') ' NEWTON UNDER_RELAXATION'
   WRITE(IU,'(A)') 'END OPTIONS'

   WRITE(IU,'(/A/)') '#List of Packages'
   WRITE(IU,'(A)') 'BEGIN PACKAGES'
   WRITE(IU,'(A)') ' DIS6 '//TRIM(DIRMNAME)//'.DIS6'
   WRITE(IU,'(A)') ' IC6  '//TRIM(DIRMNAME)//'.IC6'
   IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
    WRITE(IU,'(A)') ' NPF6 '//TRIM(DIRMNAME)//'.NPF6'
    WRITE(IU,'(A)') ' OC6  '//TRIM(DIRMNAME)//'.OC6'
    IF(ISS.EQ.1)WRITE(IU,'(A)') ' STO6 '//TRIM(DIRMNAME)//'.STO6'
   ELSE
    IF(LNPF)THEN
     WRITE(IU,'(A)') ' NPF6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.NPF6'
    ELSE
     WRITE(IU,'(A)') ' NPF6 '//TRIM(DIRMNAME)//'.NPF6'
    ENDIF
    IF(ISS.EQ.1)THEN
     IF(LSTO)THEN
      WRITE(IU,'(A)') ' STO6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.STO6'
     ELSE
      WRITE(IU,'(A)') ' STO6 '//TRIM(DIRMNAME)//'.STO6'
     ENDIF
    ENDIF
    WRITE(IU,'(A)') ' OC6  '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.OC6'
   ENDIF
   
   IF(TOPICS(TCHD)%IACT_MODEL.NE.0)THEN 
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TCHD,2)
      WRITE(IU,'(A)') ' CHD6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.CHD6 CHD_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(PMANAGER_GETNSYS(TCHD,2).GT.0)WRITE(IU,'(A)') ' CHD6 '//TRIM(DIRMNAME)//'.CHD6 CHD'
    ENDIF
   ENDIF
   
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TWEL,'WEL',LWEL,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TDRN,'DRN',LDRN,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TRCH,'RCH',LRCH,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TEVT,'EVT',LEVT,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TUZF,'UZF',LUZF,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TRIV,'RIV',LRIV,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TISG,'ISG',LISG,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TGHB,'GHB',LGHB,CT,I)
   CALL PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,TMNW,'MAW',LMNW,CT,I)
    
   IF(TOPICS(THFB)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') ' HFB6 '//TRIM(DIRMNAME)//'.HFB6'
   IF(TOPICS(TPST)%IACT_MODEL.EQ.1.OR.TOPICS(TIES)%IACT_MODEL.EQ.1)THEN
    IF(PBMAN%IPESTP.EQ.1)THEN
     WRITE(IU,'(A)') ' OBS6 '//TRIM(DIRMNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.OBS6'
    ENDIF
   ELSE
    IF(TOPICS(TOBS)%IACT_MODEL.NE.0) WRITE(IU,'(A)') ' OBS6 '//TRIM(DIRMNAME)//'.OBS6'
   ENDIF
   
   !## check whether metaswap is turned on if so, add a well package which is filled at the processing of msw-files
   IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)THEN
    WRITE(IU,'(A)') ' WEL6 '//TRIM(CRELDIR)//'GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELINPUT\MSW.WEL6 WELLS_MSW'
    WRITE(IU,'(A)') ' RCH6 '//TRIM(CRELDIR)//'GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELINPUT\MSW.RCH6 RCH_MSW'
   ENDIF
   
   WRITE(IU,'(A)') 'END PACKAGES'

   CLOSE(IU)
  ENDDO
  
 ELSE 
  
  DIRMNAME='.\'//TRIM(DIRMNAME)

  !## write *.nam file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(PEST%PE_MXITER.LT.0)THEN
    N1=-1; N2=N1
   ELSE
    N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   N1=1; N2=PEST%NREALS
  ENDIF
  DO I=N1,N2
   !## skip zero
   IF(I.EQ.0)CYCLE

   IF(PBMAN%IPESTP.EQ.1)THEN
    CT='L'; IF(I.GT.0)CT='P'
   ELSEIF(PBMAN%IIES.EQ.1)THEN
    CT='R'
   ENDIF

   IU=UTL_GETUNIT()
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    CALL OSD_OPEN(IU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE 
    IF(PBMAN%IPESTP.EQ.1)THEN
     IF(I.GT.0)THEN
      IF(PEST%PARAM(I)%PACT.EQ.0)CYCLE
      IF(PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
     ENDIF
    ENDIF
    NAME=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.NAM'
    CALL OSD_OPEN(IU,FILE=TRIM(NAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ENDIF
   IF(IU.EQ.0)RETURN
   WRITE(IU,'(A)') '# Nam File Generated by '//TRIM(UTL_IMODVERSION())

   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    WRITE(IU,'(A)') 'LIST 10 '//CHAR(39)//'.\'//TRIM(MNAME)//'.LIST'//CHAR(39)
    WRITE(IU,'(A)') 'MET 11  '//CHAR(39)//TRIM(DIRMNAME)//'.MET7'//CHAR(39)
   ELSE 
    WRITE(IU,'(A)') 'LIST 10 '//CHAR(39)//'.\'//TRIM(MNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.LIST'//CHAR(39)
    WRITE(IU,'(A)') 'MET 11  '//CHAR(39)//TRIM(DIRMNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.MET7'//CHAR(39)
   ENDIF

   WRITE(IU,'(A)') 'BAS6 12 '//CHAR(39)//TRIM(DIRMNAME)//'.BAS6'//CHAR(39)
   WRITE(IU,'(A)') 'DIS  13 '//CHAR(39)//TRIM(DIRMNAME)//'.DIS6'//CHAR(39)
   IF(LBCF) WRITE(IU,'(A)') 'BCF6 14 '//CHAR(39)//TRIM(DIRMNAME)//'.BCF6'//CHAR(39)
   IF(LLPF)THEN
    IF(PBMAN%IIES.EQ.0.AND.PBMAN%IFORMAT.NE.6)THEN
     WRITE(IU,'(A)') 'LPF  14 '//CHAR(39)//TRIM(DIRMNAME)//'.LPF7'//CHAR(39)
    ELSE
     IF(PBMAN%IPESTP.EQ.1)THEN
      WRITE(IU,'(A)') 'LPF  14 '//CHAR(39)//TRIM(DIRMNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.LPF7'//CHAR(39)
     ELSE
      WRITE(IU,'(A)') 'LPF  14 '//CHAR(39)//TRIM(DIRMNAME)//'.LPF7'//CHAR(39)
     ENDIF
    ENDIF
   ENDIF

   IF(LPKS)THEN
    WRITE(IU,'(A)') 'PKS  15 '//CHAR(39)//TRIM(DIRMNAME)//'.PKS'//CHAR(39)
   ELSE
    IF(TOPICS(TPCG)%IACT_MODEL.EQ.1)WRITE(IU,'(A)') 'PCG  15 '//CHAR(39)//TRIM(DIRMNAME)//'.PCG7'//CHAR(39)
   ENDIF
   
   IF(PBMAN%IPESTP.EQ.1)THEN
!    IF(I.GT.0)THEN
    WRITE(IU,'(A)') 'OC   16 '//CHAR(39)//TRIM(DIRMNAME)//'_'//CT//'.OC'//CHAR(39)
!    ELSE
!     WRITE(IU,'(A)') 'OC   16 '//CHAR(39)//TRIM(DIRMNAME)//'_L.OC'//CHAR(39)
!    ENDIF
   ELSE
    WRITE(IU,'(A)') 'OC   16 '//CHAR(39)//TRIM(DIRMNAME)//'.OC'//CHAR(39)
   ENDIF
   IF(TOPICS(TRCH)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'RCH  17 '//CHAR(39)//TRIM(DIRMNAME)//'.RCH7'//CHAR(39)
   IF(TOPICS(TEVT)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'EVT  18 '//CHAR(39)//TRIM(DIRMNAME)//'.EVT7'//CHAR(39)
   IF(TOPICS(TDRN)%IACT_MODEL.EQ.1.OR.TOPICS(TOLF)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'DRN  19 '//CHAR(39)//TRIM(DIRMNAME)//'.DRN7'//CHAR(39)
   IF(TOPICS(TRIV)%IACT_MODEL.EQ.1.OR.TOPICS(TISG)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'RIV  20 '//CHAR(39)//TRIM(DIRMNAME)//'.RIV7'//CHAR(39)
   IF(TOPICS(TGHB)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'GHB  21 '//CHAR(39)//TRIM(DIRMNAME)//'.GHB7'//CHAR(39)
   IF(TOPICS(TCHD)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'CHD  22 '//CHAR(39)//TRIM(DIRMNAME)//'.CHD7'//CHAR(39)
   IF(TOPICS(TWEL)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'WEL  23 '//CHAR(39)//TRIM(DIRMNAME)//'.WEL7'//CHAR(39)
   IF(TOPICS(THFB)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'HFB6 24 '//CHAR(39)//TRIM(DIRMNAME)//'.HFB7'//CHAR(39)
   IF(TOPICS(TSFR)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'SFR  25 '//CHAR(39)//TRIM(DIRMNAME)//'.SFR7'//CHAR(39)
   IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)THEN; WRITE(IU,'(A)') 'FHB  26 '//CHAR(39)//TRIM(DIRMNAME)//'.FHB7'//CHAR(39); IFHBUN=26; ENDIF
   IF(TOPICS(TLAK)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'LAK  27 '//CHAR(39)//TRIM(DIRMNAME)//'.LAK7'//CHAR(39) 
   IF(TOPICS(TUZF)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'UZF  28 '//CHAR(39)//TRIM(DIRMNAME)//'.UZF7'//CHAR(39)
   IF(TOPICS(TMNW)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'MNW2 29 '//CHAR(39)//TRIM(DIRMNAME)//'.MNW7'//CHAR(39)
   IF(TOPICS(TANI)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'ANI  30 '//CHAR(39)//TRIM(DIRMNAME)//'.ANI1'//CHAR(39)
   IF(TOPICS(TCAP)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'DXC  31 '//CHAR(39)//TRIM(DIRMNAME)//'.DXC'//CHAR(39) 
   IF(TOPICS(TVDF)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'VDF  32 '//CHAR(39)//TRIM(DIRMNAME)//'.VDF1'//CHAR(39) 
   IF(TOPICS(TSCR)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'SCR  33 '//CHAR(39)//TRIM(DIRMNAME)//'.SCR1'//CHAR(39) 
   IF(TOPICS(TDSP)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'DSP  34 '//CHAR(39)//TRIM(DIRMNAME)//'.DSP1'//CHAR(39) 
   IF(TOPICS(TSCO)%IACT_MODEL.EQ.1)THEN
    WRITE(IU,'(A)') 'BTN  35 '//CHAR(39)//TRIM(DIRMNAME)//'.BTN1'//CHAR(39) 
    WRITE(IU,'(A)') 'ADV  36 '//CHAR(39)//TRIM(DIRMNAME)//'.ADV1'//CHAR(39) 
    WRITE(IU,'(A)') 'SSM  37 '//CHAR(39)//TRIM(DIRMNAME)//'.SSM1'//CHAR(39) 
    IF(TOPICS(TGCG)%IACT_MODEL.EQ.1)WRITE(IU,'(A)') 'GCG  38 '//CHAR(39)//TRIM(DIRMNAME)//'.GCG1'//CHAR(39)
   ENDIF
   IF(PBMAN%IFORMAT.EQ.6.AND.TOPICS(TPST)%IACT_MODEL.EQ.1)THEN
    WRITE(IU,'(A)') 'OBS  39 '//CHAR(39)//TRIM(DIRMNAME)//'_'//CT//'#'//TRIM(ITOS(ABS(I)))//'.OBS7'//CHAR(39)
    WRITE(IU,'(A)') 'HOB  40 '//CHAR(39)//TRIM(DIRMNAME)//'.HOB7'//CHAR(39)
   ENDIF
   
   WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IHEDUN,' '//CHAR(39)//'HEAD'//CHAR(39)
   WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IBCFCB,' '//CHAR(39)//'BDGSTO BDGBND BDGFRF BDGFFF BDGFLF'//CHAR(39) 
   IF(TOPICS(TRCH)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IRCHCB,' '//CHAR(39)//'BDGRCH'//CHAR(39) 
   IF(TOPICS(TEVT)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IEVTCB,' '//CHAR(39)//'BDGEVT'//CHAR(39) 
   IF(TOPICS(TDRN)%IACT_MODEL.EQ.1.OR.TOPICS(TOLF)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IDRNCB,' '//CHAR(39)//'BDGDRN'//CHAR(39) 
   IF(TOPICS(TRIV)%IACT_MODEL.EQ.1.OR.TOPICS(TISG)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IRIVCB,' '//CHAR(39)//'BDGRIV'//CHAR(39) 
   IF(TOPICS(TGHB)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IGHBCB,' '//CHAR(39)//'BDGGHB'//CHAR(39) 
   IF(TOPICS(TCHD)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',ICHDCB,' '//CHAR(39)//'BDGCHD'//CHAR(39) 
   IF(TOPICS(TWEL)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IWELCB,' '//CHAR(39)//'BDGWEL'//CHAR(39) 
   IF(TOPICS(TSFR)%IACT_MODEL.EQ.1)THEN
    WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',ISFRCB,' '//CHAR(39)//'BDGSFR'//CHAR(39) 
    IF(ISFRCB2.GT.0)WRITE(IU,'(A,I3,A)') 'DATA         ',ISFRCB2,' '//CHAR(39)//'.\'//TRIM(MNAME)//'_FSFR.TXT'//CHAR(39) 
   ENDIF
   IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IFHBCB ,' '//CHAR(39)//'BDGFHB'//CHAR(39) 
   IF(TOPICS(TLAK)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',ILAKCB ,' '//CHAR(39)//'BDGLAK'//CHAR(39) 
   IF(TOPICS(TUZF)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IUZFCB1,' '//CHAR(39)//'UZFINF BDGGRC BDGGET UZFRUN UZFET UZFSFR'//CHAR(39) 
!   IF(TOPICS(TUZF)%IACT_MODEL.EQ.1)THEN
!    DO J=1,PBMAN%NLOGLOC
!     WRITE(IU,'(A,I3,A)') 'DATA ',99+J ,' '//CHAR(39)//'UZF_LOG_ROW'//TRIM(ITOS(PBMAN%ILOC(J,1)))//'-COL'//TRIM(ITOS(PBMAN%ILOC(J,2)))//'.TXT'//CHAR(39)
!    ENDDO
!   ENDIF
   IF(TOPICS(TMNW)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',IWL2CB ,' '//CHAR(39)//'BDGMNW'//CHAR(39)
   IF(TOPICS(TSCR)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',ISCRCB ,' '//CHAR(39)//'BDGSCR'//CHAR(39)
   IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)WRITE(IU,'(A,I3,A)') 'DATA(BINARYIDF) ',ICAPCB ,' '//CHAR(39)//'BDGCAP'//CHAR(39)
  ENDDO
 ENDIF

 CLOSE(IU)
 
 !## result folder including the modelname
 DIRMNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MNAME)
 DIR     =TRIM(DIR)//'\MODELINPUT'

 !## echo used files from the prj-file
 IPRT=UTL_GETUNIT();      CALL OSD_OPEN(IPRT     ,FILE=TRIM(DIR)//'\USED_FILES.TXT',STATUS='UNKNOWN',ACTION='WRITE')
 IUEXAMINE=0; IF(SUM(PBMAN%EXAMINE).NE.0.0D0)THEN
  IUEXAMINE=UTL_GETUNIT(); CALL OSD_OPEN(IUEXAMINE,FILE=TRIM(MAINDIR)//'\EXAMINE.TXT'   ,STATUS='UNKNOWN',ACTION='WRITE')
 ENDIF
 
 PMANAGER_SAVEMF2005_NAM=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_NAM

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_NAMIPESTPCK(IU,DIRMNAME,ITOPIC,CPCK,LPEST,CT,I)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: CPCK,DIRMNAME,CT
 INTEGER,INTENT(IN) :: ITOPIC,IU,I
 LOGICAL,INTENT(IN) :: LPEST
 INTEGER :: ISYS
 CHARACTER(LEN=3) :: CCPCK
 
 IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)RETURN

 !## apply riv system for ISG
 CCPCK=CPCK; IF(ITOPIC.EQ.TISG)CCPCK='RIV'
 
 DO ISYS=1,PMANAGER_GETNSYS(ITOPIC,2)
  IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0.OR..NOT.LPEST)THEN
   IF(PBMAN%SSYSTEM.EQ.0)THEN
    WRITE(IU,'(A)') ' '//TRIM(CCPCK)//'6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.'//TRIM(CPCK)//'6 '//TRIM(CPCK)//'_SYS'//TRIM(ITOS(ISYS))
   ELSE
    WRITE(IU,'(A)') ' '//TRIM(CCPCK)//'6 '//TRIM(DIRMNAME)//'.'//TRIM(CPCK)//'6 '//TRIM(CPCK); EXIT
   ENDIF
  ELSE
   IF(PBMAN%SSYSTEM.EQ.0)THEN
    WRITE(IU,'(A)') ' '//TRIM(CCPCK)//'6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.'//TRIM(CPCK)//'6 '//TRIM(CPCK)//'_SYS'//TRIM(ITOS(ISYS))
   ELSE
    WRITE(IU,'(A)') ' '//TRIM(CCPCK)//'6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.'//TRIM(CPCK)//'6'; EXIT
   ENDIF
  ENDIF
 ENDDO

 END SUBROUTINE PMANAGER_SAVEMF2005_NAMIPESTPCK
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SIM(IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2
 INTEGER :: IWINDOW,IR,IC
 
 !## IBATCH flag only for messsage management
 
 !## reads idf for model dimensions
 !## creates IDF objects to store parameter values
 
 PMANAGER_SAVEMF2005_SIM=.FALSE.
 
 !## read idf for dimensions
 CALL IDFNULLIFY(PRJIDF)
 IF(.NOT.PMANAGER_INIT_SIMAREA(PRJIDF,IBATCH))RETURN

 IF(PBMAN%IWINDOW.EQ.1)THEN
  IF(SUBMODEL(5).NE.0.0D0)THEN
   PRJIDF%DX=SUBMODEL(5)
   PRJIDF%DY=SUBMODEL(5)
   CALL UTL_IDFSNAPTOGRID_LLC(PRJIDF%XMIN,PRJIDF%XMAX,PRJIDF%YMIN,PRJIDF%YMAX,PRJIDF%DX,PRJIDF%DY,PRJIDF%NCOL,PRJIDF%NROW,LLC=.TRUE.)
  ENDIF
 ENDIF
 
 IF(ISUBMODEL.EQ.1)THEN
  !# get total maximal dimensions
  IWINDOW=PBMAN%IWINDOW; PBMAN%IWINDOW=0
  IF(.NOT.PMANAGER_INIT_SIMAREA(PRJIDF,IBATCH))RETURN
  PBMAN%IWINDOW=IWINDOW
  X1=SUBMODEL(1); Y1=SUBMODEL(2); X2=SUBMODEL(3); Y2=SUBMODEL(4)
  !## include buffer to simulation window
  SUBMODEL(1)=SUBMODEL(1)-SUBMODEL(6); SUBMODEL(2)=SUBMODEL(2)-SUBMODEL(6)
  SUBMODEL(3)=SUBMODEL(3)+SUBMODEL(6); SUBMODEL(4)=SUBMODEL(4)+SUBMODEL(6)
  !## make sure size of model (including buffer) does not exceed total model domain
  SUBMODEL(1)=MAX(SUBMODEL(1),PRJIDF%XMIN); SUBMODEL(2)=MAX(SUBMODEL(2),PRJIDF%YMIN)
  SUBMODEL(3)=MIN(SUBMODEL(3),PRJIDF%XMAX); SUBMODEL(4)=MIN(SUBMODEL(4),PRJIDF%YMAX)
  !## compute dimensions of submodel
  CALL UTL_IDFSNAPTOGRID_LLC(SUBMODEL(1),SUBMODEL(3),SUBMODEL(2),SUBMODEL(4),SUBMODEL(5),SUBMODEL(5),PRJIDF%NCOL,PRJIDF%NROW,LLC=.TRUE.)
  IF(PRJIDF%NCOL.LE.0.OR.PRJIDF%NROW.LE.0)THEN
   IF(IBATCH.EQ.0)WRITE(*,'(A)') 'Model dimensions are outside maximal modeling domain'
   IF(IBATCH.EQ.1)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Model dimensions are outside maximal modeling domain','Error')
   RETURN
  ENDIF
  PRJIDF%XMIN=SUBMODEL(1); PRJIDF%YMIN=SUBMODEL(2); PRJIDF%XMAX=SUBMODEL(3); PRJIDF%YMAX=SUBMODEL(4)
  PRJIDF%DX=SUBMODEL(5); PRJIDF%DY=SUBMODEL(5); 
  IF(SUBMODEL(7).EQ.0.0D0)THEN
   PRJIDF%IEQ=0
  ELSE
   !## create non-equidistantial network
   IF(.NOT.PMANAGER_SAVEMF2005_COARSEGRID(PRJIDF,X1,Y1,X2,Y2,SUBMODEL(7)))RETURN
  ENDIF
 ENDIF
 IF(.NOT.ASSOCIATED(PRJIDF%X))THEN                     !## overrule nodata value
  IF(.NOT.IDFALLOCATEX(PRJIDF))RETURN; PRJIDF%X=0.0D0; PRJIDF%NODATA=HUGE(1.0)
 ENDIF
 !## fill sx/sy variable in idf
 IF(.NOT.IDFFILLSXSY(PRJIDF))RETURN
 
 IF(SUM(PBMAN%EXAMINE).NE.0.0D0)THEN
  IF(PBMAN%EXAMINE(1).GT.0.0D0.AND.PBMAN%EXAMINE(2).GT.0.0D0)THEN
   CALL IDFIROWICOL(PRJIDF,IR,IC,PBMAN%EXAMINE(1),PBMAN%EXAMINE(2))
   IF(IR.EQ.0.OR.IC.EQ.0)THEN
    WRITE(*,'(/A,2F15.3,A/)') 'EXAMINE LOCATION ',PBMAN%EXAMINE(1),PBMAN%EXAMINE(2),' OUTSIDE MODEL DOMAIN'; STOP
   ENDIF
   PBMAN%EXAMINE(1)=IR; PBMAN%EXAMINE(2)=IC
  ELSE
   PBMAN%EXAMINE=ABS(PBMAN%EXAMINE)
  ENDIF
  IR=INT(PBMAN%EXAMINE(1)); IC=INT(PBMAN%EXAMINE(2))
  WRITE(IUEXAMINE,'(A,2I10)') 'EXAMING LOCATION (ROW,COL): ',IR,IC
 ENDIF
 
 PMANAGER_SAVEMF2005_SIM=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_SIM
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SIM_ALLOC(ISS)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISS
 INTEGER :: ILAY
 
 ALLOCATE(BND(PRJNLAY));   DO ILAY=1,SIZE(BND); CALL IDFNULLIFY(BND(ILAY)); ENDDO
 ALLOCATE(SHD(PRJNLAY));   DO ILAY=1,SIZE(SHD); CALL IDFNULLIFY(SHD(ILAY)); ENDDO
 ALLOCATE(TOP(PRJNLAY));   DO ILAY=1,SIZE(TOP); CALL IDFNULLIFY(TOP(ILAY)); ENDDO
 ALLOCATE(BOT(PRJNLAY));   DO ILAY=1,SIZE(BOT); CALL IDFNULLIFY(BOT(ILAY)); ENDDO
 ALLOCATE(KDW(PRJNLAY));   DO ILAY=1,SIZE(KDW); CALL IDFNULLIFY(KDW(ILAY)); ENDDO
 ALLOCATE(VCW(PRJNLAY-1)); DO ILAY=1,SIZE(VCW); CALL IDFNULLIFY(VCW(ILAY)); ENDDO
 ALLOCATE(KHV(PRJNLAY));   DO ILAY=1,SIZE(KHV); CALL IDFNULLIFY(KHV(ILAY)); ENDDO

 IF(PBMAN%APPLYTC.EQ.1)THEN
  ALLOCATE(KHA(PRJNLAY)); DO ILAY=1,SIZE(KHA); CALL IDFNULLIFY(KHA(ILAY)); ENDDO  
 ENDIF
 
 IF(ISS.EQ.1)THEN
  ALLOCATE(STO(PRJNLAY)); DO ILAY=1,SIZE(STO); CALL IDFNULLIFY(STO(ILAY)); ENDDO
  ALLOCATE(SPY(PRJNLAY)); DO ILAY=1,SIZE(SPY); CALL IDFNULLIFY(SPY(ILAY)); ENDDO
 ENDIF

 IF(LLPF.OR.LNPF)THEN
  ALLOCATE(KVV(PRJNLAY-1)); DO ILAY=1,SIZE(KVV); CALL IDFNULLIFY(KVV(ILAY)); ENDDO
  ALLOCATE(KVA(PRJNLAY)); DO ILAY=1,SIZE(KVA); CALL IDFNULLIFY(KVA(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(ANA(PRJNLAY)); DO ILAY=1,SIZE(ANA); CALL IDFNULLIFY(ANA(ILAY)); ENDDO
  ALLOCATE(ANF(PRJNLAY)); DO ILAY=1,SIZE(ANF); CALL IDFNULLIFY(ANF(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TSCR)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(THK(PRJNLAY)); DO ILAY=1,SIZE(THK); CALL IDFNULLIFY(THK(ILAY)); ENDDO
  ALLOCATE(ARR(PRJNLAY)); DO ILAY=1,SIZE(ARR); CALL IDFNULLIFY(ARR(ILAY)); ENDDO
  ALLOCATE(BCR(PRJNLAY)); DO ILAY=1,SIZE(BCR); CALL IDFNULLIFY(BCR(ILAY)); ENDDO
  ALLOCATE(CCA(PRJNLAY)); DO ILAY=1,SIZE(CCA); CALL IDFNULLIFY(CCA(ILAY)); ENDDO
  ALLOCATE(VOI(PRJNLAY)); DO ILAY=1,SIZE(VOI); CALL IDFNULLIFY(VOI(ILAY)); ENDDO
  ALLOCATE(SUB(PRJNLAY)); DO ILAY=1,SIZE(SUB); CALL IDFNULLIFY(SUB(ILAY)); ENDDO
  SELECT CASE (PBMAN%SCR_ISTPCS)
   CASE (0); ALLOCATE(PCS(PRJNLAY)); DO ILAY=1,SIZE(PCS); CALL IDFNULLIFY(PCS(ILAY)); ENDDO
   CASE (1); ALLOCATE(PC0(PRJNLAY)); DO ILAY=1,SIZE(PC0); CALL IDFNULLIFY(PC0(ILAY)); ENDDO
   CASE (2); ALLOCATE(OCR(PRJNLAY)); DO ILAY=1,SIZE(OCR); CALL IDFNULLIFY(OCR(ILAY)); ENDDO
   CASE (3)
    ALLOCATE(PCS(PRJNLAY)); DO ILAY=1,SIZE(PCS); CALL IDFNULLIFY(PCS(ILAY)); ENDDO
    ALLOCATE(PC0(PRJNLAY)); DO ILAY=1,SIZE(PC0); CALL IDFNULLIFY(PC0(ILAY)); ENDDO
    ALLOCATE(OCR(PRJNLAY)); DO ILAY=1,SIZE(OCR); CALL IDFNULLIFY(OCR(ILAY)); ENDDO
    ALLOCATE(TH0(PRJNLAY)); DO ILAY=1,SIZE(TH0); CALL IDFNULLIFY(TH0(ILAY)); ENDDO
  END SELECT
  ALLOCATE(GL0(PRJNLAY)); DO ILAY=1,SIZE(GL0); CALL IDFNULLIFY(GL0(ILAY)); ENDDO
  ALLOCATE(SGS(PRJNLAY)); DO ILAY=1,SIZE(SGS); CALL IDFNULLIFY(SGS(ILAY)); ENDDO
  ALLOCATE(SGM(PRJNLAY)); DO ILAY=1,SIZE(SGM); CALL IDFNULLIFY(SGM(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TLAK)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(LAK(10)); DO ILAY=1,SIZE(LAK); CALL IDFNULLIFY(LAK(ILAY)); ENDDO
  ALLOCATE(LBD(PRJNLAY)); DO ILAY=1,SIZE(LBD); CALL IDFNULLIFY(LBD(ILAY)); ENDDO
  ALLOCATE(LCD(PRJNLAY)); DO ILAY=1,SIZE(LCD); CALL IDFNULLIFY(LCD(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TCON)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(CON(PRJNLAY)); DO ILAY=1,SIZE(CON); CALL IDFNULLIFY(CON(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TDSP)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(LON(PRJNLAY)); DO ILAY=1,SIZE(LON); CALL IDFNULLIFY(LON(ILAY)); ENDDO
  ALLOCATE(RHD(PRJNLAY)); DO ILAY=1,SIZE(RHD); CALL IDFNULLIFY(RHD(ILAY)); ENDDO
  ALLOCATE(RVD(PRJNLAY)); DO ILAY=1,SIZE(RVD); CALL IDFNULLIFY(RVD(ILAY)); ENDDO
  ALLOCATE(MDC(PRJNLAY)); DO ILAY=1,SIZE(MDC); CALL IDFNULLIFY(MDC(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TPOR)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(POR(PRJNLAY)); DO ILAY=1,SIZE(POR); CALL IDFNULLIFY(POR(ILAY)); ENDDO
 ENDIF
 
 IF(TOPICS(TCBI)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(CBI(PRJNLAY)); DO ILAY=1,SIZE(CBI); CALL IDFNULLIFY(CBI(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TSCO)%IACT_MODEL.EQ.1)THEN
  ALLOCATE(SCO(PRJNLAY)); DO ILAY=1,SIZE(SCO); CALL IDFNULLIFY(SCO(ILAY)); ENDDO
 ENDIF

 ALLOCATE(SFT(2)); DO ILAY=1,SIZE(SFT); CALL IDFNULLIFY(SFT(ILAY)); ENDDO

 DO ILAY=1,SIZE(TOP); CALL IDFCOPY(PRJIDF,TOP(ILAY)); ENDDO
 DO ILAY=1,SIZE(BOT); CALL IDFCOPY(PRJIDF,BOT(ILAY)); ENDDO
 DO ILAY=1,SIZE(KDW); CALL IDFCOPY(PRJIDF,KDW(ILAY)); ENDDO
 DO ILAY=1,SIZE(VCW); CALL IDFCOPY(PRJIDF,VCW(ILAY)); ENDDO
 DO ILAY=1,SIZE(KHV); CALL IDFCOPY(PRJIDF,KHV(ILAY)); ENDDO

 IF(LLPF.OR.LNPF)THEN
  DO ILAY=1,SIZE(KVV); CALL IDFCOPY(PRJIDF,KVV(ILAY)); ENDDO
  DO ILAY=1,SIZE(KVA); CALL IDFCOPY(PRJIDF,KVA(ILAY)); ENDDO
 ENDIF

 IF(ISS.EQ.1)THEN
  DO ILAY=1,SIZE(STO); CALL IDFCOPY(PRJIDF,STO(ILAY)); ENDDO
  DO ILAY=1,SIZE(SPY); CALL IDFCOPY(PRJIDF,SPY(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(ANF); CALL IDFCOPY(PRJIDF,ANF(ILAY)); ENDDO
  DO ILAY=1,SIZE(ANA); CALL IDFCOPY(PRJIDF,ANA(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TSCR)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(GL0); CALL IDFCOPY(PRJIDF,GL0(ILAY)); ENDDO
  DO ILAY=1,SIZE(SGM); CALL IDFCOPY(PRJIDF,SGM(ILAY)); ENDDO
  DO ILAY=1,SIZE(SGS); CALL IDFCOPY(PRJIDF,SGS(ILAY)); ENDDO
  DO ILAY=1,SIZE(THK); CALL IDFCOPY(PRJIDF,THK(ILAY)); ENDDO
  DO ILAY=1,SIZE(ARR); CALL IDFCOPY(PRJIDF,ARR(ILAY)); ENDDO
  DO ILAY=1,SIZE(BCR); CALL IDFCOPY(PRJIDF,BCR(ILAY)); ENDDO
  DO ILAY=1,SIZE(CCA); CALL IDFCOPY(PRJIDF,CCA(ILAY)); ENDDO
  DO ILAY=1,SIZE(VOI); CALL IDFCOPY(PRJIDF,VOI(ILAY)); ENDDO
  DO ILAY=1,SIZE(SUB); CALL IDFCOPY(PRJIDF,SUB(ILAY)); ENDDO
  SELECT CASE (PBMAN%SCR_ISTPCS)
   CASE (0); DO ILAY=1,SIZE(PCS); CALL IDFCOPY(PRJIDF,PCS(ILAY)); ENDDO
   CASE (1); DO ILAY=1,SIZE(PC0); CALL IDFCOPY(PRJIDF,PC0(ILAY)); ENDDO
   CASE (2); DO ILAY=1,SIZE(OCR); CALL IDFCOPY(PRJIDF,OCR(ILAY)); ENDDO
   CASE (3)
    DO ILAY=1,SIZE(PCS); CALL IDFCOPY(PRJIDF,PCS(ILAY)); ENDDO
    DO ILAY=1,SIZE(PC0); CALL IDFCOPY(PRJIDF,PC0(ILAY)); ENDDO
    DO ILAY=1,SIZE(OCR); CALL IDFCOPY(PRJIDF,OCR(ILAY)); ENDDO
    DO ILAY=1,SIZE(TH0); CALL IDFCOPY(PRJIDF,TH0(ILAY)); ENDDO
  END SELECT
  DO ILAY=1,SIZE(GL0); CALL IDFCOPY(PRJIDF,GL0(ILAY)); ENDDO
  DO ILAY=1,SIZE(SGS); CALL IDFCOPY(PRJIDF,SGS(ILAY)); ENDDO
  DO ILAY=1,SIZE(SGM); CALL IDFCOPY(PRJIDF,SGM(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TLAK)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(LBD); CALL IDFCOPY(PRJIDF,LBD(ILAY)); ENDDO
  DO ILAY=1,SIZE(LCD); CALL IDFCOPY(PRJIDF,LCD(ILAY)); ENDDO
 ENDIF
  
 IF(TOPICS(TSFT)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(SFT); CALL IDFCOPY(PRJIDF,SFT(ILAY)); ENDDO
 ENDIF
 
 IF(TOPICS(TCON)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(CON); CALL IDFCOPY(PRJIDF,CON(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TPOR)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(POR); CALL IDFCOPY(PRJIDF,POR(ILAY)); ENDDO
 ENDIF
 IF(TOPICS(TCBI)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(CBI); CALL IDFCOPY(PRJIDF,CBI(ILAY)); ENDDO
 ENDIF
 IF(TOPICS(TSCO)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(SCO); CALL IDFCOPY(PRJIDF,SCO(ILAY)); ENDDO
 ENDIF

 IF(TOPICS(TDSP)%IACT_MODEL.EQ.1)THEN
  DO ILAY=1,SIZE(LON); CALL IDFCOPY(PRJIDF,LON(ILAY)); ENDDO
!  DO ILAY=1,SIZE(RHD); CALL IDFCOPY(PRJIDF,RHD(ILAY)); ENDDO
!  DO ILAY=1,SIZE(RVD); CALL IDFCOPY(PRJIDF,RVD(ILAY)); ENDDO
!  DO ILAY=1,SIZE(MDC); CALL IDFCOPY(PRJIDF,MDC(ILAY)); ENDDO
 ENDIF

 PMANAGER_SAVEMF2005_SIM_ALLOC=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_SIM_ALLOC

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PST_READWRITE(DIR,DIRMNAME,IBATCH,ISS)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,ISS
 INTEGER :: I,J,N,N1,N2,IU
 CHARACTER(LEN=256) :: CFNAME
 
 PMANAGER_SAVEMF2005_PST_READWRITE=.TRUE.
 
 IF(TOPICS(TPST)%IACT_MODEL.EQ.0.AND.TOPICS(TIES)%IACT_MODEL.EQ.0)RETURN

 !## overrule is by imod batch
 IF(IBATCH.EQ.1.AND.PBMAN%IPEST+PBMAN%IPESTP+PBMAN%IIES.EQ.0)RETURN

 PMANAGER_SAVEMF2005_PST_READWRITE=.FALSE.

 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN; N=SIZE(PEST%MEASURES); ENDIF

 IF(N.EQ.0.AND.PEST%PE_MXITER.GT.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to specify measurements to use the PST module.','Error'); RETURN
 ENDIF
 
 !## modflow6/seawat
 IF(PBMAN%IFORMAT.EQ.3.OR.PBMAN%IFORMAT.EQ.6)THEN
 
  IF(.NOT.PMANAGER_SAVEPST_MF6_SEAWAT(DIR,IBATCH))RETURN
  TOPICS(TPST)%IACT_MODEL=1; TOPICS(TOBS)%IACT_MODEL=1
  IF(.NOT.PMANAGER_SAVEMF2005_OBS(DIR,DIRMNAME,IBATCH,TOPICS(TOBS)%IACT_MODEL,TOBS,'OBS',2))RETURN
  !## do not export the obs again
  TOPICS(TOBS)%IACT_MODEL=0

  !## write blankout idf
  IF(PEST%PE_KTYPE.LT.0)THEN
   !## read/clip/scale idf file
   IF(.NOT.IDFREADSCALE(PEST%PPBNDIDF,PRJIDF,7,0,1.0D0,0))RETURN
   !## save array, do not correct for boundary condition as we not yet know for what layer the zone will apply
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\PST1\PPBNDIDF.ARR',PRJIDF,0,IU,1,0))RETURN
  ENDIF

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

  N1=1; N2=1; J=0
  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(PEST%PE_MXITER.LT.0)THEN
    N1=-1; N2=N1
   ELSE
    N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
   ENDIF
  ENDIF; CFNAME=''
  DO I=N1,N2
   !## skip zero
   IF(I.EQ.0)CYCLE

   IU=UTL_GETUNIT()
   IF(PBMAN%IPESTP.EQ.0)THEN
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.PST1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE
    IF(I.GT.0)THEN
     IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
     IF(J.EQ.0)THEN
      CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_P#'//TRIM(ITOS(I))//'.PST1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
      CFNAME=TRIM(DIRMNAME)//'_P#'//TRIM(ITOS(I))//'.PST1'
     ELSE
      CALL IOSCOPYFILE(CFNAME,TRIM(DIRMNAME)//'_P#'//TRIM(ITOS(I))//'.PST1')
     ENDIF
    ELSE
     IF(J.EQ.0)THEN
      CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.PST1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
      CFNAME=TRIM(DIRMNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.PST1'
     ELSE
      CALL IOSCOPYFILE(CFNAME,TRIM(DIRMNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.PST1')
     ENDIF
    ENDIF   
   ENDIF
  
   IF(J.EQ.0)THEN
    IF(IU.EQ.0)RETURN
  
    WRITE(IU,'(A)') '# PST1 File Generated by '//TRIM(UTL_IMODVERSION())

    !## pst module is exception
    IF(.NOT.PMANAGER_SAVEPST(IU,2,DIR,ISS,-1))RETURN

    CLOSE(IU)
   ENDIF
   J=1
  
  ENDDO
 
 ENDIF
 
 PMANAGER_SAVEMF2005_PST_READWRITE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_PST_READWRITE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_IES_READWRITE(DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,J,K,N,IU,JU,IOS,ILAY
 
 PMANAGER_SAVEMF2005_IES_READWRITE=.TRUE.
 
 IF(TOPICS(TIES)%IACT_MODEL.EQ.0)RETURN

 !## overrule is by imod batch
 IF(IBATCH.EQ.1.AND.PBMAN%IIES.EQ.0)RETURN

 PMANAGER_SAVEMF2005_IES_READWRITE=.FALSE.

 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN; N=SIZE(PEST%MEASURES); ENDIF
 
 IF(N.EQ.0.OR.PEST%PE_MXITER.LE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to specify measurements to use the IES module.','Error'); RETURN
 ENDIF
 
 !## change lpf (copy) for now into an #.lpf
 DO I=1,PEST%NREALS
  IU=UTL_GETUNIT()
  CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.LPF7'                      ,STATUS='OLD'    ,ACTION='READ' ,FORM='FORMATTED')
  JU=UTL_GETUNIT()
  CALL OSD_OPEN(JU,FILE=TRIM(DIRMNAME)//'_R#'//TRIM(ITOS(I))//'.LPF7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  DO
   READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
   DO J=1,SIZE(PEST%PARAM)
    DO K=1,SIZE(PEST%PARAM(J)%ILS)
     ILAY=PEST%PARAM(J)%ILS(K)
     SELECT CASE (PEST%PARAM(J)%PPARAM)
      CASE ('KH')
       LINE=UTL_SUBST(LINE,'HK_L'//TRIM(ITOS(ILAY))//'.ARR','HK_L'//TRIM(ITOS(ILAY))//'_R#'//TRIM(ITOS(I))//'.ARR')
     END SELECT
    ENDDO
   ENDDO
   WRITE(JU,'(A)') TRIM(LINE)
  ENDDO
  CLOSE(IU); CLOSE(JU)
 ENDDO
 
 PMANAGER_SAVEMF2005_IES_READWRITE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_IES_READWRITE
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME,DIR
 CHARACTER(LEN=256) :: FNAME
 CHARACTER(LEN=52) :: MDLNAME,FTYPE
 CHARACTER(LEN=4) :: FEXT
 CHARACTER(LEN=3) :: CPCK
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,II,J,N,IU,JU,IOS,ILAY,N1,N2,ISUB,IPER,ISYS
 LOGICAL :: LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW,LEX
 LOGICAL,DIMENSION(2) :: LMOD
 LOGICAL,DIMENSION(7) :: LPCK
 
 PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE=.TRUE.
 
 !## not modflow6/seawat
 IF(PBMAN%IFORMAT.NE.3.AND.PBMAN%IFORMAT.NE.6)RETURN
 !## not ipest defined
 IF(TOPICS(TPST)%IACT_MODEL.EQ.0)RETURN
 !## not ipestp defined
 IF(PBMAN%IPESTP.EQ.0)RETURN

 PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE=.FALSE.

 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN; N=SIZE(PEST%MEASURES); ENDIF
 
 IF(N.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to specify measurements to use the GLM module.','Error'); RETURN
 ENDIF 

 CALL PMANAGER_SAVEMF2005_MF6_GETPARAM(LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL,LEVT,LUZF,LISG,LMNW)
 LMOD(1)=LNPF; LMOD(2)=LSTO
 LPCK(1)=LDRN; LPCK(2)=LRIV; LPCK(3)=LGHB; LPCK(4)=LRCH; LPCK(5)=LWEL; LPCK(6)=LISG; LPCK(7)=LMNW
 
 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  IF(PEST%PE_MXITER.LT.0)then
   N1=-1; N2=N1
  ELSE
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  ENDIF
 ELSEIF(PBMAN%IIES.EQ.1)THEN
  N1=1; N2=SIZE(PEST%PARAM)
 ENDIF
 
 MDLNAME=DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:); MDLNAME=UTL_CAP(MDLNAME,'U')    
 ISUB=PBMAN%ISUBMODEL
 
 DO I=N1,N2
  !## skip zero
  IF(I.EQ.0)CYCLE

  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    FTYPE='P#'//TRIM(ITOS(I))
   ELSE
    FTYPE='L#'//TRIM(ITOS(ABS(I)))
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   FTYPE='R#'//TRIM(ITOS(I))
  ENDIF

  !## copy npf in case a parameters effect this file
  DO J=1,SIZE(LMOD)
   IF(.NOT.LMOD(J))CYCLE
   IF(PBMAN%IFORMAT.EQ.3)THEN
    IF(J.EQ.1)FEXT='NPF6'
    IF(J.EQ.2)FEXT='STO6'
    !## original model
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'.'//TRIM(FEXT)
    IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'_'//TRIM(FTYPE)//'.'//TRIM(FEXT)
    JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE
    FEXT='LPF7'
    !## original model
    FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'.'//TRIM(FEXT)
    IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
    FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'_'//TRIM(FTYPE)//'.'//TRIM(FEXT)
    JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ENDIF

   DO
    READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    IF(INDEX(LINE,'.ARR').LE.0)THEN; WRITE(JU,'(A)') TRIM(LINE); CYCLE; ENDIF
    DO II=1,SIZE(PEST%PARAM)
     ILAY=PEST%PARAM(II)%PILS
     !## modflow6
     IF(PBMAN%IFORMAT.EQ.3)THEN
      SELECT CASE (PEST%PARAM(II)%PPARAM)
       CASE ('KH')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\K_L'//TRIM(ITOS(ILAY))//'.ARR'  ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\K_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('VA')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\K33_L'//TRIM(ITOS(ILAY))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\K33_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('SC')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\SS_L'//TRIM(ITOS(ILAY))//'.ARR' ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\SS_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('SY')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\SY_L'//TRIM(ITOS(ILAY))//'.ARR' ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\SY_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
      END SELECT
     ELSE
      SELECT CASE (PEST%PARAM(II)%PPARAM)
       CASE ('KH')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\HK_L'//TRIM(ITOS(ILAY))//'.ARR' ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\HK_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('VA')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\KVA_L'//TRIM(ITOS(ILAY))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\KVA_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('SC')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\SF1_L'//TRIM(ITOS(ILAY))//'.ARR' ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\SF1_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('SY')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\SF2_L'//TRIM(ITOS(ILAY))//'.ARR' ,TRIM(FEXT)//'\'//TRIM(FTYPE)//'\SF2_L'//TRIM(ITOS(ILAY))//'_'//TRIM(FTYPE)//'.ARR')
      END SELECT
     ENDIF
    ENDDO
    WRITE(JU,'(A)') TRIM(LINE)
   ENDDO
   CLOSE(IU); CLOSE(JU)
  ENDDO

  !## copy drn in case a parameters effect this file
  DO J=1,SIZE(LPCK)
   IF(.NOT.LPCK(J))CYCLE
   IF(PBMAN%IFORMAT.EQ.3)THEN
    IF(J.EQ.1)FEXT='DRN6'
    IF(J.EQ.2)FEXT='RIV6'
    IF(J.EQ.3)FEXT='GHB6'
    IF(J.EQ.4)FEXT='RCH6'
    IF(J.EQ.5)FEXT='WEL6'
    !IF(J.EQ.6)FEXT='WEL6'  isg
    IF(J.EQ.7)FEXT='MNW6'
   ELSE
    IF(J.EQ.1)FEXT='DRN7'
    IF(J.EQ.2)FEXT='RIV7'
    IF(J.EQ.3)FEXT='GHB7'
    IF(J.EQ.4)FEXT='RCH7'
    IF(J.EQ.5)FEXT='WEL7'
    !IF(J.EQ.6)FEXT='WEL6'  isg
    IF(J.EQ.7)FEXT='MNW7'
   ENDIF
   
   !## try all systems
   ISYS=0
   DO
    ISYS=ISYS+1
    
    IF(PBMAN%IFORMAT.EQ.3)THEN
     !## original model
     FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.'//TRIM(FEXT)
     INQUIRE(FILE=FNAME,EXIST=LEX); IF(.NOT.LEX)EXIT
     IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
     FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'_SYS'//TRIM(ITOS(ISYS))//'_'//TRIM(FTYPE)//'.'//TRIM(FEXT)
     JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
    ELSE
     !## original model
     FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.'//TRIM(FEXT)
     INQUIRE(FILE=FNAME,EXIST=LEX); IF(.NOT.LEX)EXIT
     IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
     FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'_SYS'//TRIM(ITOS(ISYS))//'_'//TRIM(FTYPE)//'.'//TRIM(FEXT)
     JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
    ENDIF
    
    DO
     READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
     IF(INDEX(LINE,'.ARR').LE.0)THEN; WRITE(JU,'(A)') TRIM(LINE); CYCLE; ENDIF
     DO II=1,SIZE(PEST%PARAM)
      !## skip this parameter
      IF(PEST%PARAM(II)%PILS.NE.ISYS)CYCLE
      DO IPER=1,PRJNPER
       SELECT CASE (PEST%PARAM(II)%PPARAM)
        CASE ('DC'); CPCK='DRN'
        CASE ('RC'); CPCK='RIV'
        CASE ('GC'); CPCK='GHB'
        CASE ('RE'); CPCK='RCH'
        CASE ('QR'); CPCK='WEL'
        CASE ('MQ'); CPCK='MAW'
       END SELECT
       LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\SYS'//TRIM(ITOS(ISYS))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR', &
                           TRIM(FEXT)//'\SYS'//TRIM(ITOS(ISYS))//'\'//TRIM(FTYPE)//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
      ENDDO
     ENDDO
     WRITE(JU,'(A)') TRIM(LINE)
    ENDDO
    CLOSE(IU); CLOSE(JU)
   ENDDO
  ENDDO 
 ENDDO
 
 !## copy obs files
 DO I=N1,N2
  !## skip zero
  IF(I.EQ.0)CYCLE

  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    FTYPE='P#'//TRIM(ITOS(I))
   ELSE
    FTYPE='L#'//TRIM(ITOS(ABS(I)))
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   FTYPE='R#'//TRIM(ITOS(I))
  ENDIF

  IF(PBMAN%IFORMAT.EQ.3)THEN
   !## original model
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'.OBS6'
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(ISUB))//'\MODELINPUT\'//TRIM(MDLNAME)//'_'//TRIM(FTYPE)//'.OBS6'
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ELSE
   !## original model
   FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'.OBS7'
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ' ,FORM='FORMATTED')
   FNAME=TRIM(DIR)//'\MODELINPUT\'//TRIM(MDLNAME)//'_'//TRIM(FTYPE)//'.OBS7'
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(FNAME),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  
  DO
   READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
   IF(PBMAN%IFORMAT.EQ.3)THEN
    LINE=UTL_SUBST(LINE,'\OUTPUT_OBS.TXT','\IPEST_'//TRIM(FTYPE)//'\OUTPUT_OBS_'//TRIM(FTYPE)//'.TXT')
   ELSE
    LINE=UTL_SUBST(LINE,'\OBS\OBS','\IPEST_'//TRIM(FTYPE)//'\OUTPUT_OBS_'//TRIM(FTYPE))
    !## create folder as seawat is not doing that
    CALL UTL_CREATEDIR(TRIM(DIR)//'\IPEST_'//TRIM(FTYPE))
   ENDIF
   WRITE(JU,'(A)') TRIM(LINE)
  ENDDO
  CLOSE(IU); CLOSE(JU)
 ENDDO
 
 PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_GLM_MF6_SEAWAT_READWRITE
  
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_BAS_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ITOPIC,SCL_D,SCL_U,ILAY
 INTEGER,DIMENSION(:,:),ALLOCATABLE :: ISIZE
 
 PMANAGER_SAVEMF2005_BAS_READ=.FALSE.

 ALLOCATE(FNAMES(PRJNLAY),PRJILIST(1),ISIZE(4,PRJNLAY))

 !## bnd settings
 ITOPIC=TBND; SCL_D=0; SCL_U=1; PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(1,PRJNLAY,0,1,0).LE.0)RETURN

 DO ILAY=1,PRJNLAY
  WRITE(6,'(A)') '+Reading BND-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  CALL IDFCOPY(PRJIDF,BND(ILAY))
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(BND(ILAY),ITOPIC,ILAY,SCL_D,SCL_U,0,IPRT,ISIZE=ISIZE(:,ILAY)))RETURN 
 ENDDO

 !## adjust boundary for submodel()
 CALL PMANAGER_SAVEMF2005_BND(ISIZE,BND,-1)

 !## shd settings
 ITOPIC=TSHD; SCL_D=PBMAN%INT(TSHD); SCL_U=2; PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(1,PRJNLAY,0,1,0).LE.0)RETURN

 DO ILAY=1,PRJNLAY
  WRITE(6,'(A)') '+Reading SHD-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '
  CALL IDFCOPY(PRJIDF,SHD(ILAY))
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SHD(ILAY),ITOPIC,ILAY,SCL_D,SCL_U,0,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SHD(ILAY),0,ITOPIC)
 ENDDO

 DEALLOCATE(FNAMES,PRJILIST,ISIZE)

 PMANAGER_SAVEMF2005_BAS_READ=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_BAS_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_BAS_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,IFBND

 PMANAGER_SAVEMF2005_BAS_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.3)RETURN
 PMANAGER_SAVEMF2005_BAS_SAVE=.FALSE.
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.BAS6'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.BAS6'//'...'

 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.BAS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# BAS6 File Generated by '//TRIM(UTL_IMODVERSION())
 LINE='FREE'
 IF(PCG%IQERROR.EQ.0)THEN
  WRITE(IU,'(A)') 'FREE'
 ELSE
  WRITE(IU,'(A,G12.5)') 'FREE STOPERROR ',PCG%QERROR
 ENDIF
 IFBND=0
 DO ILAY=1,PRJNLAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BAS6\IBOUND_L'//TRIM(ITOS(ILAY))//'.ARR', &
      BND(ILAY),1,IU,ILAY,IFBND))RETURN
 ENDDO
 WRITE(IU,'(A)') TRIM(RTOS(HNOFLOW,'G',7))
 IFBND=1
 !## include a minor modification to ensure a save in ARR files
 IF(PBMAN%IPESTP.EQ.1)IFBND=-1
 DO ILAY=1,PRJNLAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BAS6\STRT_L'//TRIM(ITOS(ILAY))//'.ARR', &
      SHD(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO
 CLOSE(IU)
 
 PMANAGER_SAVEMF2005_BAS_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_BAS_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_IC_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,JLAY,IFBND

 PMANAGER_SAVEMF2005_IC_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)RETURN
 PMANAGER_SAVEMF2005_IC_SAVE=.FALSE.
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.IC6'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.IC6'//'...'
 
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.IC6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# IC6 File Generated by '//TRIM(UTL_IMODVERSION())
 WRITE(IU,'(/A/)') '#General Options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 WRITE(IU,'(A)') 'END OPTIONS'

 WRITE(IU,'(/A/)') '#Initial Head Data'
 WRITE(IU,'(A)') 'BEGIN GRIDDATA'
 WRITE(IU,'(A)') ' STRT LAYERED'
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\IC6\IC_L'//TRIM(ITOS(JLAY))//'.ARR', &
      SHD(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO
 WRITE(IU,'(A)') 'END GRIDDATA'
 CLOSE(IU)
  
 PMANAGER_SAVEMF2005_IC_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_IC_SAVE
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_DIS_READ(LTB,IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 LOGICAL,INTENT(OUT) :: LTB
 INTEGER :: ILAY,IINV,SCL_D,SCL_U,ITOPIC
 LOGICAL :: LEX

 PMANAGER_SAVEMF2005_DIS_READ=.FALSE.

 ALLOCATE(FNAMES(1),PRJILIST(1))

 !## check top/bottom
 LTB=.TRUE.; IINV=0
 
 !## top settings
 SCL_D=PBMAN%INT(TTOP); SCL_U=2
 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading TOP/BOT-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## top data
  ITOPIC=TTOP; LEX=.FALSE.
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))THEN

    PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

    IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(TOP(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    LEX=.TRUE.
   ENDIF
  ENDIF
  IF(.NOT.LEX)THEN; TOP(ILAY)%X=0.0D0; LTB=.FALSE.; ENDIF
  
  !## bot data
  ITOPIC=TBOT; LEX=.FALSE.
  IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS))THEN
   IF(ASSOCIATED(TOPICS(ITOPIC)%STRESS(1)%FILES))THEN

    PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

    IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(BOT(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    LEX=.TRUE.
   ENDIF
  ENDIF
  IF(.NOT.LEX)THEN; BOT(ILAY)%X=0.0D0; LTB=.FALSE.; ENDIF
  
 ENDDO

 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_DIS_READ=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_DIS_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_DIS_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,JLAY,KPER,KKPER,ITOPIC,ICOL,IROW,N,I,LHMS,IFBND
 INTEGER,ALLOCATABLE,DIMENSION(:) :: LCBD
 REAL(KIND=DP_KIND) :: T,DELT
 CHARACTER(LEN=256) :: CLINE
 
 PMANAGER_SAVEMF2005_DIS_SAVE=.FALSE.

 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.DIS6'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.DIS6'//'...'
 
 !## construct dis-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.DIS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# DIS6 File Generated by '//TRIM(UTL_IMODVERSION())

 IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN

  LINE=TRIM(ITOS(PRJNLAY))//','//TRIM(ITOS(PRJIDF%NROW))//','//TRIM(ITOS(PRJIDF%NCOL))//','//TRIM(ITOS(PRJNPER))//',4,2 TBCHECK'
  WRITE(IU,'(A)') TRIM(LINE)

  ALLOCATE(LCBD(PRJNLAY))
 
  !## laycbd code
  LINE=''
  DO ILAY=1,PRJNLAY
   IF(ILAY.LT.PRJNLAY)THEN
    !## quasi-3d scheme
    IF(LQBD)THEN
     LCBD(ILAY)=1
    !## 3d no quasi confining bed
    ELSE
     LCBD(ILAY)=0
    ENDIF
   ELSE
    !## lowest layer has never a quasi-confining bed
    LCBD(ILAY)=0
   ENDIF
  ENDDO

  WRITE(IU,'(999I2)') LCBD
  DEALLOCATE(LCBD)
 
  IF(PRJIDF%IEQ.EQ.0)THEN
   WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(PRJIDF%DX,'E',7)); WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(PRJIDF%DY,'E',7))
  ELSE
   WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1'
   WRITE(IU,*) (PRJIDF%SX(ICOL)-PRJIDF%SX(ICOL-1),ICOL=1,PRJIDF%NCOL)
   WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1'
   WRITE(IU,*) (PRJIDF%SY(IROW-1)-PRJIDF%SY(IROW),IROW=1,PRJIDF%NROW)
  ENDIF

  DO ILAY=1,PRJNLAY
   ITOPIC=TTOP
   !## no check with bnd
   IFBND=0
   !## quasi-3d scheme add top aquifer modellayer
   IF(LQBD.OR.ILAY.EQ.1)THEN
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DIS6\TOP_L'//TRIM(ITOS(ILAY))//'.ARR', &
       TOP(ILAY),0,IU,ILAY,IFBND))RETURN 
   ENDIF
   ITOPIC=TBOT
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DIS6\BOTM_L'//TRIM(ITOS(ILAY))//'.ARR', &
       BOT(ILAY),0,IU,ILAY,IFBND))RETURN 
  ENDDO
  
  !## time information
  LHMS=0; DO KPER=1,PRJNPER
   !## set delt.eq.1 otherwise crash in UZF package
   IF(SIM(KPER)%DELT.GT.0.0D0)THEN
    IF(SIM(KPER)%IHR+SIM(KPER)%IMT+SIM(KPER)%ISC.NE.0)THEN; LHMS=1; EXIT; ENDIF
   ENDIF
  ENDDO
  
  !## time information
  DO KPER=1,PRJNPER
   !## set delt.eq.1 otherwise crash in UZF package <<< DELT MOET 0.0 ZIJN VOOR ???
   IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
    LINE=TRIM(RTOS(0.0D0,'G',7))//','// &
         TRIM(ITOS(1))      //','// &
         TRIM(RTOS(1.0D0,'G',7))
   ELSE
    LINE=TRIM(RTOS(SIM(KPER)%DELT,'G',7))//','// &
         TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
         TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
   ENDIF
   IF(SIM(KPER)%DELT.EQ.0.0D0)LINE=TRIM(LINE)//',SS'
   IF(SIM(KPER)%DELT.NE.0.0D0)LINE=TRIM(LINE)//',TR'
   IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
    CLINE='STEADY-STATE'
   ELSE
    KKPER=KPER; IF(PBMAN%ISAVEENDDATE.EQ.1)KKPER=KKPER+1
!    DELT=0.0D0 ;IF(PBMAN%ISAVEENDDATE.EQ.1)DELT=SIM(KPER)%DELT
!    CLINE=TRIM(ITOS_DBL(ADD_DT_TO_IDATE(SIM(KPER)%IYR,SIM(KPER)%IMH,SIM(KPER)%IDY,SIM(KPER)%IHR,SIM(KPER)%IMT,SIM(KPER)%ISC,DELT,ABS(LHMS-1))))
    IF(LHMS.EQ.0)THEN
     WRITE(CLINE,'(I4.4,2I2.2)') SIM(KKPER)%IYR,SIM(KKPER)%IMH,SIM(KKPER)%IDY
    ELSE
     WRITE(CLINE,'(I4.4,5I2.2)') SIM(KKPER)%IYR,SIM(KKPER)%IMH,SIM(KKPER)%IDY,SIM(KKPER)%IHR,SIM(KKPER)%IMT,SIM(KKPER)%ISC
    ENDIF
   ENDIF
   LINE=TRIM(LINE)//' ['//TRIM(CLINE)//']'
   IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
    LINE=TRIM(LINE)//' [STEADY-STATE] [STEADY-STATE]'
   ELSE
    !## add begin- and end-timestamps
    WRITE(CLINE,'(I4.4,5I2.2)') SIM(KPER)%IYR  ,SIM(KPER)%IMH  ,SIM(KPER)%IDY  ,SIM(KPER)%IHR  ,SIM(KPER)%IMT  ,SIM(KPER)%ISC
    LINE=TRIM(LINE)//' ['//TRIM(CLINE)//']'
    WRITE(CLINE,'(I4.4,5I2.2)') SIM(KPER+1)%IYR,SIM(KPER+1)%IMH,SIM(KPER+1)%IDY,SIM(KPER+1)%IHR,SIM(KPER+1)%IMT,SIM(KPER+1)%ISC
    LINE=TRIM(LINE)//' ['//TRIM(CLINE)//']'
   ENDIF
   WRITE(IU,'(A)') TRIM(LINE)
  ENDDO
 
 ELSE
  
  WRITE(IU,'(/A/)') 'General Options'
  WRITE(IU,'(A)') 'BEGIN OPTIONS'  
  WRITE(IU,'(A)') ' LENGTH_UNITS METERS'
  !## in case no output is desired, skip grb saving
  DO I=1,SIZE(PBMAN%ISAVE); IF(ASSOCIATED(PBMAN%ISAVE(I)%ILAY))EXIT; ENDDO
  IF(I.GT.SIZE(PBMAN%ISAVE))WRITE(IU,'(A)') ' NOGRB'
!  !## in case of ipestp - do not write a GRB file - mf6toidf can be performed via IDF-option
!  IF(PBMAN%IPESTP.EQ.1.AND.PEST%PE_MXITER.GE.0)WRITE(IU,'(A)') ' NOGRB'
  WRITE(IU,'(A)') ' XORIGIN '//TRIM(RTOS(PRJIDF%SX(0),'F',3))
  WRITE(IU,'(A)') ' YORIGIN '//TRIM(RTOS(PRJIDF%SY(PRJIDF%NROW),'F',3))
  WRITE(IU,'(A)') ' ANGROT 0.0'
  WRITE(IU,'(A)') 'END OPTIONS'  

  WRITE(IU,'(/A/)') '#Model Dimensions'
  WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
  N=0; DO I=1,SIZE(PBMAN%ILAY); IF(PBMAN%ILAY(I).EQ.1)N=N+1; ENDDO
  WRITE(IU,'(A)') ' NLAY '//TRIM(ITOS(N))
  WRITE(IU,'(A)') ' NROW '//TRIM(ITOS(PRJIDF%NROW))
  WRITE(IU,'(A)') ' NCOL '//TRIM(ITOS(PRJIDF%NCOL))
  WRITE(IU,'(A)') 'END DIMENSIONS'

  WRITE(IU,'(/A/)') '#Cell Sizes'
  WRITE(IU,'(A)') 'BEGIN GRIDDATA'
  WRITE(IU,'(A)') ' DELR'
  IF(PRJIDF%IEQ.EQ.0)THEN
   WRITE(IU,'(A)') '  CONSTANT '//TRIM(RTOS(PRJIDF%DX,'E',7))
  ELSE
   WRITE(IU,'(A)') '  INTERNAL FACTOR 1.0'
   WRITE(IU,*) (PRJIDF%SX(ICOL)-PRJIDF%SX(ICOL-1),ICOL=1,PRJIDF%NCOL)
  ENDIF
  WRITE(IU,'(A)') ' DELC'
  IF(PRJIDF%IEQ.EQ.0)THEN
   WRITE(IU,'(A)') '  CONSTANT '//TRIM(RTOS(PRJIDF%DY,'E',7))
  ELSE
   WRITE(IU,'(A)') '  INTERNAL FACTOR 1.0'
   WRITE(IU,*) (PRJIDF%SY(IROW-1)-PRJIDF%SY(IROW),IROW=1,PRJIDF%NROW)
  ENDIF
  
  !## Only 3d model
  
  WRITE(IU,'(/A/)') '#Vertical Configuration'
  ITOPIC=TTOP
  !## check by boundary
  IFBND=0
  
  !## get first model layer
  DO I=1,SIZE(PBMAN%ILAY); IF(PBMAN%ILAY(I).EQ.1)EXIT; ENDDO

  ITOPIC=TBOT
  JLAY=0; DO ILAY=I,SIZE(PBMAN%ILAY)

   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1

   IF(JLAY.EQ.1)WRITE(IU,'(A)') 'TOP'

   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DIS6\TOPM_L'//TRIM(ITOS(JLAY))//'.ARR', &
       TOP(ILAY),0,IU,ILAY,IFBND))RETURN 
   
   IF(JLAY.EQ.1.OR.N.EQ.1)WRITE(IU,'(A)') 'BOTM LAYERED'

   !## write idf for connection-purposes
   IF(.NOT.IDFWRITE(TOP(ILAY),TRIM(DIR)//'\DIS6\TOPM_L'//TRIM(ITOS(JLAY))//'.IDF',1))RETURN
   
   IF(JLAY.EQ.N)THEN
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DIS6\BOTM_L'//TRIM(ITOS(JLAY))//'.ARR', &
        BOT(ILAY),0,IU,ILAY,IFBND))RETURN 
   ENDIF
   
   !## write idf for connection-purposes
   IF(.NOT.IDFWRITE(BOT(ILAY),TRIM(DIR)//'\DIS6\BOTM_L'//TRIM(ITOS(JLAY))//'.IDF',1))RETURN
   
  ENDDO

  WRITE(IU,'(/A/)') '#Boundary Settings'
  WRITE(IU,'(A)') 'IDOMAIN LAYERED'
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
   
   !## modify bnd for idomain parameter
   PRJIDF%X=BND(ILAY)%X; PRJIDF%NODATA=BND(ILAY)%NODATA

   !## clean idomain which was the boundary condition
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(PRJIDF%X(ICOL,IROW).EQ.PRJIDF%NODATA)PRJIDF%X(ICOL,IROW)=0.0D0
    IF(PRJIDF%X(ICOL,IROW).LT.0.0)          PRJIDF%X(ICOL,IROW)=1.0D0
    IF(PRJIDF%X(ICOL,IROW).GT.1.0)          PRJIDF%X(ICOL,IROW)=1.0D0
   ENDDO; ENDDO

!### bovenste of onderste lagen niet -1 als er toch niks boven of onder zit.
   
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
    T=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
    IF(T.LE.0.0D0)THEN
     PRJIDF%X(ICOL,IROW)=-1.0D0
     !## make sure an active cells are not allowed on thickness of zero
     BND(ILAY)%X(ICOL,IROW)=0.0
    ENDIF
   ENDDO; ENDDO

   !## modify idomain a bit in case MF6 is used to force an export to an ARR-file
IRLOOP: DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(PRJIDF%X(ICOL,IROW).GT.0)THEN
     PRJIDF%X(ICOL,IROW)=2.0D0
     EXIT IRLOOP
    ENDIF
   ENDDO; ENDDO IRLOOP

   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DIS6\IBOUND_L'//TRIM(ITOS(JLAY))//'.ARR', &
       PRJIDF,1,IU,ILAY,0))RETURN

   !## write idf for connection-purposes
   IF(.NOT.IDFWRITE(PRJIDF,TRIM(DIR)//'\DIS6\BND_L'//TRIM(ITOS(JLAY))//'.IDF',1))RETURN

!idomain—is an optional array that characterizes the existence status of a cell. If the IDOMAIN array
!is not specified, then all model cells exist within the solution. If the IDOMAIN value for a cell is 0,
!the cell does not exist in the simulation. Input and output values will be read and written for the cell,
!but internal to the program, the cell is excluded from the solution. If the IDOMAIN value for a cell
!is 1, the cell exists in the simulation. If the IDOMAIN value for a cell is -1, the cell does not exist in
!the simulation. Furthermore, the first existing cell above will be connected to the first existing cell
!below. This type of cell is referred to as a “vertical pass through” cell.
  ENDDO
  WRITE(IU,'(A)') 'END GRIDDATA'

 ENDIF
 
 CLOSE(IU)

 PMANAGER_SAVEMF2005_DIS_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_DIS_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_BTN_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,JLAY,KPER,KKPER,ITOPIC,ICOL,IROW,N,I,LHMS,IFBND
 INTEGER,ALLOCATABLE,DIMENSION(:) :: LCBD
 REAL(KIND=DP_KIND) :: T
 CHARACTER(LEN=52) :: CLINE
 
 PMANAGER_SAVEMF2005_BTN_SAVE=.TRUE.
 IF(TOPICS(TPOR)%IACT_MODEL.EQ.0)RETURN
 IF(TOPICS(TCBI)%IACT_MODEL.EQ.0)RETURN
 IF(TOPICS(TSCO)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_BTN_SAVE=.FALSE.

 !## export only for seawat 
 IF(PBMAN%IFORMAT.NE.6.OR.WQ%VDF%MTDNCONC.EQ.0)THEN; PMANAGER_SAVEMF2005_BTN_SAVE=.TRUE.; RETURN; ENDIF
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.BTN1'//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.BTN1'//'...'
 
 !## construct dis-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.BTN1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN

 WRITE(IU,'(A/)') '# BTN1 File Generated by '//TRIM(UTL_IMODVERSION())

 LINE=TRIM(ITOS(PRJNLAY))//','//TRIM(ITOS(PRJIDF%NROW))//','//TRIM(ITOS(PRJIDF%NCOL))//','// &
      TRIM(ITOS(PRJNPER))//',1,1'
 WRITE(IU,'(A)') TRIM(LINE)
 !## time-, length and mass units
 WRITE(IU,'(3A4)') 'D','M','K'
 WRITE(IU,'(A)') ' T T T F F F F F F F'
! LINE='' 
! DO I=1,
!  IF(LINE=TRIM(LINE)' T'
!  IF(LINE=TRIM(LINE)' F'
! ENDDO
! WRITE(IU,'(A)') TRIM(LINE)

 ALLOCATE(LCBD(PRJNLAY))
 
 !## laycbd code
 LINE=''
 DO ILAY=1,PRJNLAY
  IF(ILAY.LT.PRJNLAY)THEN
   !## quasi-3d scheme
   IF(LQBD)THEN
    LCBD(ILAY)=1
   !## 3d no quasi confining bed
   ELSE
    LCBD(ILAY)=0
   ENDIF
  ELSE
   !## lowest layer has never a quasi-confining bed
   LCBD(ILAY)=0
  ENDIF
 ENDDO
 WRITE(IU,'(999I2)') LCBD
 DEALLOCATE(LCBD)
 
 IF(PRJIDF%IEQ.EQ.0)THEN
  WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(PRJIDF%DX,'E',7)); WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(PRJIDF%DY,'E',7))
 ELSE
  WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1'
  WRITE(IU,*) (PRJIDF%SX(ICOL)-PRJIDF%SX(ICOL-1),ICOL=1,PRJIDF%NCOL)
  WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1'
  WRITE(IU,*) (PRJIDF%SY(IROW-1)-PRJIDF%SY(IROW),IROW=1,PRJIDF%NROW)
 ENDIF

 !## no check with bnd
 IFBND=0

 !## quasi-3d scheme add top aquifer modellayer - find uppermost top
 PRJIDF%X=PRJIDF%NODATA
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  DO ILAY=1,PRJNLAY
   IF(BND(ILAY)%X(ICOL,IROW).NE.0)THEN
    PRJIDF%X(ICOL,IROW)=TOP(ILAY)%X(ICOL,IROW)
    EXIT
   ENDIF
  ENDDO
 ENDDO; ENDDO
 IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BTN1\TOP_L'//TRIM(ITOS(1))//'.ARR', &
     PRJIDF,0,IU,1,IFBND))RETURN 

 !## save thickness
 DO ILAY=1,PRJNLAY
 
  PRJIDF%X=0.0D0
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(BND(ILAY)%X(ICOL,IROW).NE.0)PRJIDF%X(ICOL,IROW)=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
  ENDDO; ENDDO
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BTN1\THK_L'//TRIM(ITOS(ILAY))//'.ARR', &
      PRJIDF,0,IU,1,IFBND))RETURN 
 
 ENDDO

 !## save porosity
 DO ILAY=1,PRJNLAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BTN1\POR_L'//TRIM(ITOS(ILAY))//'.ARR', &
      POR(ILAY),0,IU,1,IFBND))RETURN 
 ENDDO
 
 !## save boundary condition
 DO ILAY=1,PRJNLAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BTN1\CBI_L'//TRIM(ITOS(ILAY))//'.ARR', &
      CBI(ILAY),1,IU,1,IFBND))RETURN 
 ENDDO

 !## save starting concentration
 DO ILAY=1,PRJNLAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BTN1\SCO_L'//TRIM(ITOS(ILAY))//'.ARR', &
      SCO(ILAY),0,IU,1,IFBND))RETURN 
 ENDDO

 WRITE(IU,'(2F10.2)') -9999.,0.01       !## cinact,minthickness
 WRITE(IU,'(4I10,L10)') 0,0,0,0,.TRUE.  !## ifmtcn, ifmtnp, ifmtrf, ifmtdp, savucn
 WRITE(IU,'(I10)') 0  !## nprs
 WRITE(IU,'(2I10)') 0,1  !## nobs,nprobs
 WRITE(IU,'(L10,I10)') .TRUE.,1 !## chkmax,nprmas
         
 !## time information
 LHMS=0; DO KPER=1,PRJNPER
  !## set delt.eq.1 otherwise crash in UZF package
  IF(SIM(KPER)%DELT.GT.0.0D0)THEN
   IF(SIM(KPER)%IHR+SIM(KPER)%IMT+SIM(KPER)%ISC.NE.0)THEN; LHMS=1; EXIT; ENDIF
  ENDIF
 ENDDO
  
 !## time information
 DO KPER=1,PRJNPER
  !## set delt.eq.1 otherwise crash in UZF package
  IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
   LINE=TRIM(RTOS(1.0D0,'G',7))//','// &
        TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
        TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
  ELSE
   LINE=TRIM(RTOS(SIM(KPER)%DELT,'G',7))//','// &
        TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
        TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
  ENDIF
  IF(SIM(KPER)%DELT.EQ.0.0D0)LINE=TRIM(LINE)//',SS'
  IF(SIM(KPER)%DELT.NE.0.0D0)LINE=TRIM(LINE)//',TR'
  IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
   CLINE='STEADY-STATE'
  ELSE
   KKPER=KPER; IF(PBMAN%ISAVEENDDATE.EQ.1)KKPER=KKPER+1
    IF(LHMS.EQ.0)THEN
    WRITE(CLINE,'(I4.4,2I2.2)') SIM(KKPER)%IYR,SIM(KKPER)%IMH,SIM(KKPER)%IDY
   ELSE
    WRITE(CLINE,'(I4.4,5I2.2)') SIM(KKPER)%IYR,SIM(KKPER)%IMH,SIM(KKPER)%IDY,SIM(KKPER)%IHR,SIM(KKPER)%IMT,SIM(KKPER)%ISC
   ENDIF
  ENDIF
  LINE=TRIM(LINE)//' ['//TRIM(CLINE)//']'
  WRITE(IU,'(A)') TRIM(LINE)
  WRITE(IU,'(F10.2,I10,2F10.2)')  0.0E+00,50000,1.0,0.0E+00 !DT0, MXSTRN, TTSMULT, TTSMAX
 ENDDO
 
 CLOSE(IU)

 PMANAGER_SAVEMF2005_BTN_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_BTN_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_BCF_READ(ISS,IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISS,IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC
   
 PMANAGER_SAVEMF2005_BCF_READ=.TRUE.
 
 !## use bcf6
 IF(.NOT.LBCF)RETURN

 PMANAGER_SAVEMF2005_BCF_READ=.FALSE.

 ALLOCATE(FNAMES(1),PRJILIST(1))

 DO ILAY=1,PRJNLAY
  
  WRITE(6,'(A)') '+Reading BCF-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## transient simulation
  IF(ISS.EQ.1)THEN

   !## sf1
   ITOPIC=TSTO; SCL_D=PBMAN%INT(TSTO); SCL_U=2; IINV=0

   PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(STO(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,STO(ILAY),0,ITOPIC)

  ENDIF   

  !## kdw
  ITOPIC=TKDW; SCL_D=PBMAN%INT(TKDW); SCL_U=3; IINV=0

  PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KDW(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KDW(ILAY),0,ITOPIC)

  IF(ILAY.NE.PRJNLAY)THEN

   !## vcont=1/resistance
   ITOPIC=TVCW; SCL_D=PBMAN%INT(TVCW); SCL_U=6; IINV=1

   PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(VCW(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,VCW(ILAY),0,ITOPIC)

  ENDIF

 ENDDO  
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_BCF_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_BCF_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_BCF_SAVE(DIR,DIRMNAME,IBATCH,ISS)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,ISS
 INTEGER :: IU,ILAY,IFBND
  
 PMANAGER_SAVEMF2005_BCF_SAVE=.TRUE.
 
 !## use bcf6
 IF(.NOT.LBCF)RETURN; IF(PBMAN%IFORMAT.EQ.3)RETURN

 PMANAGER_SAVEMF2005_BCF_SAVE=.FALSE.

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

 !## construct bcf6-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.BCF6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 LINE=TRIM(ITOS(IBCFCB))//','//TRIM(RTOS(HNOFLOW,'G',7))//',0,1.0D0,1,0'
 IF(PBMAN%MINKD.NE.0.0D0)LINE=TRIM(LINE)//',MINKD '//TRIM(RTOS(PBMAN%MINKD,'G',5))
 IF(PBMAN%MINC .NE.0.0D0)LINE=TRIM(LINE)//',MINC ' //TRIM(RTOS(PBMAN%MINC ,'G',5))
 WRITE(IU,'(A)') TRIM(LINE)
 !## ltype code
 LINE=''; DO ILAY=1,PRJNLAY; 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

 IFBND=1

 DO ILAY=1,PRJNLAY

  !## transient simulation
  IF(ISS.EQ.1)THEN

   !## sf1
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BCF6\SF1_L'//TRIM(ITOS(ILAY))//'.ARR', &
       STO(ILAY),0,IU,ILAY,IFBND))RETURN

  ENDIF   

  !## kdw
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BCF6\TRAN_L'//TRIM(ITOS(ILAY))//'.ARR', &
      KDW(ILAY),0,IU,ILAY,IFBND))RETURN

  IF(ILAY.NE.PRJNLAY)THEN

   !## vcont=1/resistance
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\BCF6\VCONT_L'//TRIM(ITOS(ILAY))//'.ARR', &
       VCW(ILAY),0,IU,ILAY,IFBND))RETURN

  ENDIF

 ENDDO  

 CLOSE(IU)

 PMANAGER_SAVEMF2005_BCF_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_BCF_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LPF_READ(ISS,IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISS,IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC,IROW,ICOL,J,IILAY
 REAL(KIND=DP_KIND) :: T1,B1,T2,B2,KH,KV,KD,VC,MINDX,VA,HA
 TYPE(IDFOBJ),DIMENSION(4) :: IDFT
 
 PMANAGER_SAVEMF2005_LPF_READ=.TRUE.
 
 !## use lpf6
 IF(.NOT.LLPF.AND..NOT.LNPF)RETURN

 ALLOCATE(FNAMES(1),PRJILIST(1))

 PMANAGER_SAVEMF2005_LPF_READ=.FALSE.
 IF(PBMAN%APPLYTC.EQ.1)THEN; DO I=1,SIZE(IDFT); CALL IDFNULLIFY(IDFT(I)); ENDDO; ENDIF
 
 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading LPF-files Permeability components ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## compute kh/va/ha on basis of 1/c and kd=darcian(kd) instead of geom(kh) yielding hor.ani.

  IF(PBMAN%APPLYTC.EQ.1)THEN
   
   IINV=0
   
   !## get smallest cellsize of members of kd, and c computation, set tmpidf and read all files at that resolution
   DO J=1,SIZE(IDFT); CALL IDFDEALLOCATEX(IDFT(J)); CALL IDFDEALLOCATESX(IDFT(J)); ENDDO

   DO I=1,2
       
    !## top data
    ITOPIC=TTOP; PRJILIST=ITOPIC; SCL_D=PBMAN%INT(TTOP); SCL_U=2; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
    IF(I.EQ.1)THEN
     IF(FNAMES(I)%ICNST.EQ.2)THEN; IF(.NOT.IDFREAD(TOP(ILAY),FNAMES(1)%FNAME,0))RETURN; ENDIF
    ELSE
     CALL IDFCOPY(IDFT(1),TOP(ILAY))
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(TOP(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    ENDIF
    
    !## bot data
    ITOPIC=TBOT; PRJILIST=ITOPIC; SCL_D=PBMAN%INT(TBOT); SCL_U=2; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
    IF(I.EQ.1)THEN
     IF(FNAMES(I)%ICNST.EQ.2)THEN; IF(.NOT.IDFREAD(BOT(ILAY),FNAMES(1)%FNAME,0))RETURN; ENDIF
    ELSE
     CALL IDFCOPY(IDFT(1),BOT(ILAY))
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(BOT(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    ENDIF

    !## hkv
    ITOPIC=TKHV; PRJILIST=ITOPIC; SCL_D=PBMAN%INT(TKHV); SCL_U=3; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
    IF(I.EQ.1)THEN
     IF(FNAMES(I)%ICNST.EQ.2)THEN; IF(.NOT.IDFREAD(KHV(ILAY),FNAMES(1)%FNAME,0))RETURN; ENDIF
    ELSE
     CALL IDFCOPY(IDFT(1),KHV(ILAY))
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KHV(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    ENDIF
    
    !## vka
    ITOPIC=TKVA; PRJILIST=ITOPIC; SCL_D=PBMAN%INT(TKVA); SCL_U=2; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
    IF(I.EQ.1)THEN
     IF(FNAMES(I)%ICNST.EQ.2)THEN; IF(.NOT.IDFREAD(KVA(ILAY),FNAMES(1)%FNAME,0))RETURN; ENDIF
    ELSE
     CALL IDFCOPY(IDFT(1),KVA(ILAY))
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KVA(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    ENDIF
    
    IF(I.EQ.1)THEN

     MINDX=MIN(TOP(ILAY)%DX,BOT(ILAY)%DX,KHV(ILAY)%DX,KVA(ILAY)%DX)
     CALL IDFCOPY(PRJIDF,IDFT(1)); IDFT(1)%DX=MINDX; IDFT(1)%DY=IDFT(1)%DX; IDFT(1)%IEQ=0
     CALL UTL_IDFSNAPTOGRID(IDFT(1)%XMIN,IDFT(1)%XMAX,IDFT(1)%YMIN,IDFT(1)%YMAX,IDFT(1)%DX,IDFT(1)%NCOL,IDFT(1)%NROW)
     IF(.NOT.IDFALLOCATEX(IDFT(1)))STOP 'CANNOT ALLOCATE MEMORY FOR IDFT(1)'
     IF(.NOT.IDFALLOCATESXY(IDFT(1)))STOP 'CANNOT ALLOCATE MEMORY FOR IDFT(1)'
    
    !## compute transmissivity/total vertical resistance in node
    ELSE
     
     DO J=1,SIZE(IDFT); CALL IDFCOPY(TOP(ILAY),IDFT(J)); ENDDO
     
     DO IROW=1,TOP(ILAY)%NROW; DO ICOL=1,TOP(ILAY)%NCOL

      T1=TOP(ILAY)%X(ICOL,IROW); IDFT(1)%X(ICOL,IROW)=T1
      B1=BOT(ILAY)%X(ICOL,IROW); IDFT(2)%X(ICOL,IROW)=B1
      DO J=3,SIZE(IDFT); IDFT(J)%X(ICOL,IROW)=IDFT(J)%NODATA; ENDDO
      IF(T1.EQ.TOP(ILAY)%NODATA.OR.B1.EQ.BOT(ILAY)%NODATA)CYCLE
      
      !## make sure there is no negative thickness
      IF(B1.GT.T1)B1=T1
      IF(T1-B1.GT.0.0D0)THEN
      
       KH=KHV(ILAY)%X(ICOL,IROW); VA=KVA(ILAY)%X(ICOL,IROW)
       IF(VA.LE.0.0D0)VA=1.0D0
       KD=(T1-B1)* KH;     
       VC=(T1-B1)/(KH*VA)
      
      ELSE
       
       KD=0.0D0
       VC=0.0D0
       
      ENDIF
      
      IDFT(3)%X(ICOL,IROW)=KD
      IDFT(4)%X(ICOL,IROW)=0.5D0*VC
      
     ENDDO; ENDDO

     CALL IDFDEALLOCATEX(KHV(ILAY)); CALL IDFDEALLOCATEX(KVA(ILAY))

     !## scale top to modelnetwork
     CALL IDFCOPY(PRJIDF,TOP(ILAY))
     IF(.NOT.IDFREADSCALE_GETX(IDFT(1),TOP(ILAY),2,1,0.0D0))RETURN
     !## scale bottom to modelnetwork
     CALL IDFCOPY(PRJIDF,BOT(ILAY))
     IF(.NOT.IDFREADSCALE_GETX(IDFT(2),BOT(ILAY),2,1,0.0D0))RETURN
     !## scale transmissivity to modelnetwork in x-direction
     CALL IDFCOPY(PRJIDF,KHV(ILAY))
     IF(.NOT.IDFREADSCALE_GETX(IDFT(3),KHV(ILAY),19,1,0.0D0))RETURN
     !## scale transmissivity to modelnetwork in y-direction
     CALL IDFCOPY(PRJIDF,KHA(ILAY))
     IF(.NOT.IDFREADSCALE_GETX(IDFT(3),KHA(ILAY),20,1,0.0D0))RETURN
     !## scale resistance to modelnetwork in z-direction
     CALL IDFCOPY(PRJIDF,KVA(ILAY))
     IF(.NOT.IDFREADSCALE_GETX(IDFT(4),KVA(ILAY),6,1,0.0D0))RETURN

     !## compute permeability/vertical anisotropy from transmissivity/vertical resistance
     DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
     
      !## top
      T1=TOP(ILAY)%X(ICOL,IROW)
      !## bottom
      B1=BOT(ILAY)%X(ICOL,IROW)
      IF(T1.EQ.TOP(ILAY)%NODATA.OR.B1.EQ.BOT(ILAY)%NODATA)CYCLE
      !## horizontal transmissivity x direction
      KD=KHV(ILAY)%X(ICOL,IROW)
      !## horizontal transmissivity y direction
      HA=KHA(ILAY)%X(ICOL,IROW)
      !## vertical resistance z direction
      VC=KVA(ILAY)%X(ICOL,IROW)
      
      IF(T1-B1.GT.0.0D0)THEN
      
       !## horizontal permeability
       KH=KD/(T1-B1)
       !## vertical permeability 
       KV=(T1-B1)/VC
      
      ELSE
      
       KH=1.0D0
       HA=1.0D0
       KD=1.0D0
       
      ENDIF
      
      KHV(ILAY)%X(ICOL,IROW)=KH
      !## horizontal anisotropy ratio
      KHA(ILAY)%X(ICOL,IROW)=HA/KD
      !## vertical anisotropy (kh/kv as modflow needs it)
      KVA(ILAY)%X(ICOL,IROW)=KH/KV
     
     ENDDO; ENDDO
     
     ITOPIC=TKHV; CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KHV(ILAY),0,ITOPIC)
     ITOPIC=TKVA; CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KVA(ILAY),0,ITOPIC)
     
    ENDIF
    
   ENDDO
   
   CALL IDFDEALLOCATE(IDFT,SIZE(IDFT))
   
  ELSE

   !## hkv
   ITOPIC=TKHV; SCL_D=PBMAN%INT(TKHV); SCL_U=3; IINV=0; PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KHV(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KHV(ILAY),0,ITOPIC)

   !## vka
   ITOPIC=TKVA; SCL_D=PBMAN%INT(TKVA); SCL_U=2; IINV=1; PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KVA(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KVA(ILAY),0,ITOPIC)
  
  ENDIF
 
 ENDDO  
  
 DO ILAY=1,PRJNLAY
  !## quasi-3d scheme add vertical hydraulic conductivity of interbed
  IF(LQBD.AND.ILAY.NE.PRJNLAY)THEN

   !## kvv
   ITOPIC=TKVV; SCL_D=PBMAN%INT(TKVV); SCL_U=3; IINV=0; PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(KVV(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,KVV(ILAY),0,ITOPIC)

  ENDIF
 ENDDO
 
 !## transient simulation
 IF(ISS.EQ.1)THEN
  DO ILAY=1,PRJNLAY

   WRITE(6,'(A)') '+Reading LPF-files Storage components ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '
 
   !## sf1 - specific storage
   ITOPIC=TSTO; SCL_D=PBMAN%INT(TSTO); SCL_U=2; IINV=0

   PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(STO(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,STO(ILAY),0,ITOPIC)

   !## sf2 - specific yield in case not confined
   IF(LAYCON(ILAY).NE.1)THEN

    ITOPIC=TSPY; SCL_D=PBMAN%INT(TSPY); SCL_U=2; IINV=0

    PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

    IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SPY(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SPY(ILAY),0,ITOPIC)

   ENDIF

  ENDDO  
 ENDIF
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_LPF_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_LPF_READ

 !####====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_COMPUTE_KDW_VCW()
 !####====================================================================
 IMPLICIT NONE
 INTEGER :: ILAY,IROW,ICOL
 REAL(KIND=DP_KIND) :: T,B,K,T1,T2,T3,KD
 
 !## skip if bcf6 is used
 IF(LBCF)RETURN

 !## make sure no negative-thicknesses in original set
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(BND(ILAY)%X(ICOL,IROW).EQ.0)CYCLE
  IF(ILAY.GT.1)TOP(ILAY)%X(ICOL,IROW)=MIN(TOP(ILAY)%X(ICOL,IROW),BOT(ILAY-1)%X(ICOL,IROW))
  BOT(ILAY)%X(ICOL,IROW)=MIN(TOP(ILAY)%X(ICOL,IROW),BOT(ILAY)%X(ICOL,IROW))
 ENDDO; ENDDO; ENDDO

 !## compute transmissivity - could be used by packages to assign to modellayers
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(BND(ILAY)%X(ICOL,IROW).EQ.0)THEN
   KDW(ILAY)%X(ICOL,IROW)=0.0D0
   CYCLE
  ENDIF
  T=TOP(ILAY)%X(ICOL,IROW); B=BOT(ILAY)%X(ICOL,IROW); K=KHV(ILAY)%X(ICOL,IROW)
  KD=(T-B)*K; KD=MAX(PBMAN%MINKD,KD)
  IF(T-B.GT.0.0D0)THEN
   KHV(ILAY)%X(ICOL,IROW)=KD/(T-B)
  ELSE
   KHV(ILAY)%X(ICOL,IROW)=1.0D0
  ENDIF
  IF(T.NE.TOP(ILAY)%NODATA.AND.B.NE.BOT(ILAY)%NODATA.AND.K.NE.KHV(ILAY)%NODATA)THEN
   KDW(ILAY)%X(ICOL,IROW)=(T-B)*KHV(ILAY)%X(ICOL,IROW)
  ELSE
   KDW(ILAY)%X(ICOL,IROW)=HNOFLOW
  ENDIF
 ENDDO; ENDDO; ENDDO

 DO ILAY=1,PRJNLAY-1; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(BND(ILAY)%X(ICOL,IROW).NE.0.AND.BND(ILAY+1)%X(ICOL,IROW).NE.0)THEN

   !## top aquifer  
   T =0.5D0*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW))
   T1=0.0D0; IF(T.GT.0.0D0.AND.            &
      KHV(ILAY)%X(ICOL,IROW).GT.0.0D0.AND. &
      KVA(ILAY)%X(ICOL,IROW).GT.0.0D0)T1=T/(KHV(ILAY)%X(ICOL,IROW)/KVA(ILAY)%X(ICOL,IROW))
   
   !## intermediate aquitard
   T =BOT(ILAY)%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW)
   T2=0.0D0
   !## zero permeability - make sure resistance is equal to minc
   IF(KVV(ILAY)%X(ICOL,IROW).LE.0.0D0)THEN
    IF(T.GT.0.0D0)THEN
     IF(PBMAN%MINC.GT.0.0D0)THEN
      KVV(ILAY)%X(ICOL,IROW)=T/PBMAN%MINC
     ELSE
      KVV(ILAY)%X(ICOL,IROW)=1.0D0
     ENDIF
    ELSE
     !## irrelevant but need to have some value otherwise MF turns it into inactive nodes
     KVV(ILAY)%X(ICOL,IROW)=1.0D0
    ENDIF
   ENDIF
   T2=T/KVV(ILAY)%X(ICOL,IROW)
   
   !## bottom aquifer
   T =0.5D0*(TOP(ILAY+1)%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW))
!   IF(T.GT.0.0D0.AND.KHV(ILAY+1)%X(ICOL,IROW).LE.0.0D0)THEN
!    WRITE(*,'(/3G15.7,2I5/)') T,KHV(ILAY+1)%X(ICOL,IROW),KVA(ILAY+1)%X(ICOL,IROW),ILAY,IROW,ICOL
!   ENDIF
!   T3=0.0D0; IF(T.GT.0.0D0)T3=T/(KHV(ILAY+1)%X(ICOL,IROW)/KVA(ILAY+1)%X(ICOL,IROW))
   T3=0.0D0; IF(T.GT.0.0D0.AND.              &
      KHV(ILAY+1)%X(ICOL,IROW).GT.0.0D0.AND. &
      KVA(ILAY+1)%X(ICOL,IROW).GT.0.0D0)T3=T/(KHV(ILAY+1)%X(ICOL,IROW)/KVA(ILAY+1)%X(ICOL,IROW))

   !## total resistance
   VCW(ILAY)%X(ICOL,IROW)=T1+T2+T3
  ELSE
   VCW(ILAY)%X(ICOL,IROW)=HNOFLOW
  ENDIF
 ENDDO; ENDDO; ENDDO
  
 END SUBROUTINE PMANAGER_SAVEMF2005_COMPUTE_KDW_VCW
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LPF_SAVE(DIR,DIRMNAME,IBATCH,ISS)
 !####====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: WETDRYTHRESS=0.1D0 !## percentage of aquifer
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,ISS
 REAL(KIND=DP_KIND) :: WETFCT,T,KD,D,NT
 INTEGER :: IU,ILAY,IFBND,IHDWET,IWETIT,IROW,ICOL,JR,JC
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_LPF_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.3)RETURN; IF(.NOT.LLPF)RETURN
 
 !## use lpf6
 PMANAGER_SAVEMF2005_LPF_SAVE=.FALSE.

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

 !## construct lpf7-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.LPF7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# LPF7 File Generated by '//TRIM(UTL_IMODVERSION())
 !## dry cells negative for restart
 IF(PBMAN%SPECIFICSTORAGE.EQ.0)THEN
  LINE=TRIM(ITOS(IBCFCB))//','//TRIM(RTOS(HNOFLOW,'G',7))//',0,STORAGECOEFFICIENT,THICKSTRT,CONSTANTCV,NOCVCORRECTION'
 ELSE
  LINE=TRIM(ITOS(IBCFCB))//','//TRIM(RTOS(HNOFLOW,'G',7))//',0,THICKSTRT,CONSTANTCV,NOCVCORRECTION'
 ENDIF
 IF(PBMAN%MINKD.NE.0.0D0)LINE=TRIM(LINE)//',MINKD '//TRIM(RTOS(PBMAN%MINKD,'G',5))
 IF(PBMAN%MINC .NE.0.0D0)LINE=TRIM(LINE)//',MINC ' //TRIM(RTOS(PBMAN%MINC ,'G',5))
  
 WRITE(IU,'(A)') TRIM(LINE)

 !## laycon=1: 0
 !## laycon=2: 1
 !## laycon=3:-1
 !## laycon=4: constant head

 !## laytyp code
 LINE=''; DO ILAY=1,PRJNLAY
  SELECT CASE (LAYCON(ILAY))
   CASE (1); LINE=TRIM(LINE)//' 0,' !## confined
   CASE (2); LINE=TRIM(LINE)//' 1,' !## convertible head-bot
   CASE (3); LINE=TRIM(LINE)//'-1,' !## convertible shd/top-bot
   CASE (4); LINE=TRIM(LINE)//' 0,' !## constant head
  END SELECT
  IF(MOD(ILAY,40).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
 ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)
 !## layavg code
 LINE=''; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//'0,'
  IF(MOD(ILAY,40).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
 ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)
 !## chani code
 IF(PBMAN%APPLYTC.EQ.0)THEN
  LINE=''; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//'1.0,'
   IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)
 ELSE
  LINE=''; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//'0.0,'
   IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
  ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)
 ENDIF
 !## lvka code
 LINE=''; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//'1,'
  IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
 ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)

 !## laywet code - if unconfined always use wetdry
 LINE=''; IWETIT=0
 DO ILAY=1,PRJNLAY
  !## not unconfined
  IF(LAYCON(ILAY).NE.2)LINE=TRIM(LINE)//'0,'
  !## unconfined
  IF(LAYCON(ILAY).EQ.2)THEN; LINE=TRIM(LINE)//'1,'; IWETIT=1; ENDIF
  IF(MOD(ILAY,20).EQ.0)THEN; WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1); LINE=''; ENDIF
 ENDDO; IF(LEN_TRIM(LINE).NE.0)WRITE(IU,'(A)') LINE(:LEN_TRIM(LINE)-1)
 !## include wetdry options
 IF(IWETIT.EQ.1)THEN
  !## At iterations for which no wetting is allowed, cells may still convert to dry
  WETFCT=0.5D0 !## multiplication to determine head in dry cell 
  IHDWET=0   !## option to compute rewetted model layers; h = BOT + WETFCT (hn - BOT) (most stable)
  !## see McDonald and other: A method of converting no-flow cells to variable-head cell
!  IHDWET=1   !## option to compute rewetted head as h + BOT + WETFCT(THRESS)
  LINE=TRIM(RTOS(WETFCT,'F',2))//','//TRIM(ITOS(IWETIT))//','//TRIM(ITOS(IHDWET))
  WRITE(IU,'(A)') TRIM(LINE)
 ENDIF
  
 !## check all on active cells, except wetdry
 IFBND=1

 !## if ipestp and storage is optimized
 LEX=.FALSE.; IF(PBMAN%IPESTP.EQ.1.OR.PBMAN%IIES.EQ.1)THEN
  DO I=1,SIZE(PEST%PARAM); IF(PEST%PARAM(I)%PPARAM.EQ.'KH')THEN; LEX=.TRUE.; EXIT; ENDIF; ENDDO
 ENDIF
 
 DO ILAY=1,PRJNLAY

  IF(PBMAN%MINKD.GT.0.0D0)THEN
   DO IROW=1,KHV(ILAY)%NROW; DO ICOL=1,KHV(ILAY)%NCOL
    D=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
    IF(D.GT.0.0D0)THEN
     KD=D*KHV(ILAY)%X(ICOL,IROW)
     IF(KD.LT.PBMAN%MINKD)KHV(ILAY)%X(ICOL,IROW)=PBMAN%MINKD/D
    ENDIF
   ENDDO; ENDDO
  ENDIF
  
  !## include a minor modification to ensure a save in ARR files
  IFBND=1; IF(LEX)IFBND=-1
  !## hk
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\HK_L'//TRIM(ITOS(ILAY))//'.ARR', &
      KHV(ILAY),0,IU,ILAY,IFBND))RETURN

  IF(PBMAN%APPLYTC.EQ.1)THEN
   !## include a minor modification to ensure a save in ARR files
   IFBND=1; IF(LEX)IFBND=-1
   !## hk
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\HA_L'//TRIM(ITOS(ILAY))//'.ARR', &
       KHA(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDIF
  
  !## include a minor modification to ensure a save in ARR files
  IFBND=1; IF(LEX)IFBND=-1
  !## vka
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\VKA_L'//TRIM(ITOS(ILAY))//'.ARR', &
      KVA(ILAY),0,IU,ILAY,IFBND))RETURN

  !## transient simulation
  IF(ISS.EQ.1)THEN

   !## sf1 - specific storage
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\SF1_L'//TRIM(ITOS(ILAY))//'.ARR', &
       STO(ILAY),0,IU,ILAY,IFBND))RETURN

   !## sf2 - specific yield in case not confined
   IF(LAYCON(ILAY).EQ.2)THEN
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\SF2_L'//TRIM(ITOS(ILAY))//'.ARR', &
        SPY(ILAY),0,IU,ILAY,IFBND))RETURN
   ENDIF
      
  ENDIF
   
  !## quasi-3d scheme add vertical hydraulic conductivity of interbed
  IF(LQBD.AND.ILAY.NE.PRJNLAY)THEN

   !## kvv
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\VKCB_L'//TRIM(ITOS(ILAY))//'.ARR', &
       KVV(ILAY),0,IU,ILAY,IFBND))RETURN

  ENDIF

  !## add wetdry options - lakes/inactive cells cannot be rewetted)
  IF(LAYCON(ILAY).EQ.2.AND.IWETIT.EQ.1)THEN
   !## fill wetdry thresholds
   PRJIDF%X=0.0D0 
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
!     T=0.0D0; NT=0.0D0; DO JR=MAX(1,IROW-1),MIN(PRJIDF%NROW,IROW+1)
!      DO JC=MAX(1,ICOL-1),MIN(PRJIDF%NCOL,ICOL+1)
!       IF(BND(ILAY)%X(JC,JR).GT.0)THEN
!        T =T+ TOP(ILAY)%X(JC,JR)-BOT(ILAY)%X(JC,JR)
!        NT=NT+1.0D0
!       ENDIF
!      ENDDO
!     ENDDO
!     IF(NT.GT.0.0D0)THEN
!      T=T/NT
     T=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
!      !## only cells below can rewet - more stable
!      T=WETDRYTHRESS*T
      IF(ILAY.LT.PRJNLAY)THEN
!       PRJIDF%X(ICOL,IROW)=-T !MIN(WETDRYTHRESS,MAX(0.0D0,T))
       PRJIDF%X(ICOL,IROW)=-MIN(WETDRYTHRESS,MAX(0.0D0,T))
      !## lowest layer cannot become dry
      ELSE
       PRJIDF%X(ICOL,IROW)= MIN(WETDRYTHRESS,MAX(0.0,T))
!       PRJIDF%X(ICOL,IROW)= T !MIN(WETDRYTHRESS,MAX(0.0,T))
      ENDIF
!     ELSE
!      PRJIDF%X(ICOL,IROW)= 0.0D0
!     ENDIF
    ENDIF
   ENDDO; ENDDO
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LPF7\WETDRY_L'//TRIM(ITOS(ILAY))//'.ARR', &
       PRJIDF,0,IU,ILAY,0))RETURN
  ENDIF

!The two most important variables that affect stability are the wetting 
!threshold and which neighboring cells are checked to determine if a cell 
!should be wetted. Both of these are controlled through WETDRY. It is 
!often useful to look at the output file and identify cells that convert 
!repeatedly from wet to dry. Try raising the wetting threshold for those 
!cells. It may also be worthwhile looking at the boundary conditions 
!associated with dry cells. 

 ENDDO  
  
 CLOSE(IU)

 PMANAGER_SAVEMF2005_LPF_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_LPF_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_NPF_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: WETDRYTHRESS=0.1D0
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 REAL(KIND=DP_KIND) :: WETFCT,T,B,THICK,ROT,H
 INTEGER :: IU,ILAY,JLAY,IFBND,IHDWET,IWETIT,IROW,ICOL
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_NPF_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)RETURN;  IF(.NOT.LNPF)RETURN

 !## use npf6
 PMANAGER_SAVEMF2005_NPF_SAVE=.FALSE.

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

 !## construct npf6-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.NPF6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# NPF6 File Generated by '//TRIM(UTL_IMODVERSION())

 WRITE(IU,'(/A/)') '#General Options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 IF(PRJNLAY.GT.1)WRITE(IU,'(A)') ' K33OVERK'
 LEX=.FALSE.
 IF(ASSOCIATED(PBMAN%ISAVE(TBND)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TSTO)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TSPY)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TKHV)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TKVV)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TKVA)%ILAY))LEX=.TRUE.
 IF(LEX)WRITE(IU,'(A)') ' SAVE_FLOWS'
 IF(TOPICS(TANI)%IACT_MODEL.EQ.0)THEN
  !## arithmetic mean thickness and harmonic-mean k
  WRITE(IU,'(A)') ' ALTERNATIVE_CELL_AVERAGING AMT-HMK'
 ENDIF

!   CASE (1); LINE=TRIM(LINE)//' 0,' !## confined
!   CASE (2); LINE=TRIM(LINE)//' 1,' !## convertible head-bot
!   CASE (3); LINE=TRIM(LINE)//'-1,' !## convertible shd/top-bot
!   CASE (4); LINE=TRIM(LINE)//' 0,' !## constant head

 DO ILAY=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  !## convertible shd/top-bot
  IF(LAYCON(ILAY).EQ.3)THEN
!THICKSTRT—indicates that cells having a negative ICELLTYPE are confined, and their cell thickness
   WRITE(IU,'(A)') ' THICKSTRT'; EXIT
  ENDIF
 ENDDO
 
!If these keywords are not specified, then the default condition is to calculate the
!vertical conductance at the start of the simulation using the initial head and the cell properties. The
!vertical conductance remains constant for the entire simulation. WRITE(IU,'(A)') ' [PERCHED]'
 !## see if layer is unconfined and wettable
 WETFCT=0.1D0 !## multiplication to determine head in dry cell 
 IHDWET=0   !## is a keyword and integer flag that determines which equation is used to define the initial head at cells that become wet.
 IWETIT=0   !## is a keyword and iteration interval for attempting to wet cells
 DO ILAY=1,PRJNLAY
  !## unconfined
  IF(LAYCON(ILAY).EQ.2)THEN
   !##  issue above seems to be incorrect as resistance is removed if no water exists
   !WRITE(IU,'(A)') ' VARIABLECV DEWATERED'
   !## vertical flux dampens as thickness of saturation declines, correct approach
   IF(PBMAN%NEWTON.EQ.0)THEN
    IWETIT=1   !## is a keyword and iteration interval for attempting to wet cells  
    !## optie perched laat laagje water staan
    WRITE(IU,'(A)') ' PERCHED'
    WRITE(IU,'(A)') ' REWET WETFCT '//TRIM(RTOS(WETFCT,'F',3))// &
      ' IWETIT '//TRIM(ITOS(IWETIT))//' IHDWET '//TRIM(ITOS(IHDWET))
   ENDIF
  ENDIF
  IF(LAYCON(ILAY).EQ.2.OR.LAYCON(ILAY).EQ.3)THEN
   WRITE(IU,'(A)') ' SAVE_SATURATION'
   EXIT
  ENDIF
 ENDDO
 IF(TOPICS(TANI)%IACT_MODEL.NE.0)THEN
  WRITE(IU,'(A)') ' XT3D'! [RHS]]'
 ENDIF
! WRITE(IU,'(A)') ' [SAVE_SPECIFIC_DISCHARGE]'
 WRITE(IU,'(A)') 'END OPTIONS'

 WRITE(IU,'(/A/)') '#Geology Options'
 WRITE(IU,'(A)') 'BEGIN GRIDDATA'
 WRITE(IU,'(A)') ' ICELLTYPE LAYERED'
 DO ILAY=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  IF(LAYCON(ILAY).EQ.1)WRITE(IU,'(A)') '  CONSTANT 0'    !## confined
  !## write array, might be overwritten by riv/ghb-package
  IF(LAYCON(ILAY).NE.1)THEN
   IF(LAYCON(ILAY).EQ.2)PRJIDF%X= 1.0D0
   IF(LAYCON(ILAY).EQ.3)PRJIDF%X=-1.0D0
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    !## make sure an inactive cells/cells that are skipped cannot be rewetted
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)PRJIDF%X(ICOL,IROW)=0.0D0
    T=TOP(ILAY)%X(ICOL,IROW); B=BOT(ILAY)%X(ICOL,IROW)
    IF(T-B.LE.0.0D0)PRJIDF%X(ICOL,IROW)=0.0D0
    
!    !## thickness of unsaturated zone significant enough to apply unconfinedness?
!    T=TOP(1)%X(ICOL,IROW); H=SHD(ILAY)%X(ICOL,IROW)
!    IF(PRJIDF%X(ICOL,IROW).NE.0.0D0.AND.T-H.LT.50.0D0)THEN
!     IF(H.GT.BOT(ILAY)%X(ICOL,IROW))THEN
!      PRJIDF%X(ICOL,IROW)=0.0D0
!     ENDIF
!    ENDIF
   
   ENDDO; ENDDO
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\ICELLTYPE_L'//TRIM(ITOS(ILAY))//'.ARR', &
      PRJIDF,1,IU,ILAY,-1))RETURN
  ENDIF
!  IF(LAYCON(ILAY).EQ.3)WRITE(IU,'(A)') '  CONSTANT -1'   !## convertible shd/top-bot
 ENDDO
 
 !## mf6 needs minimal k for layers with thickness of zero
 DO ILAY=1,SIZE(PBMAN%ILAY)
  DO IROW=1,KHV(ILAY)%NROW; DO ICOL=1,KHV(ILAY)%NCOL
   THICK=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
   IF(THICK.LE.0.0D0)THEN
    KHV(ILAY)%X(ICOL,IROW)=1.0D0
   ENDIF
  ENDDO; ENDDO
 ENDDO

 !## if ipestp and permeability is optimized
 LEX=.FALSE.; IF(PBMAN%IPESTP.EQ.1)THEN
  DO I=1,SIZE(PEST%PARAM); IF(PEST%PARAM(I)%PPARAM.EQ.'KH')THEN; LEX=.TRUE.; EXIT; ENDIF; ENDDO
 ENDIF

 WRITE(IU,'(A)') ' K LAYERED'
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  !## do not check with boundary for mf6; include a minor modification to ensure a save in ARR files
  IFBND=0; IF(LEX)IFBND=-1
  !## hk
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\K_L'//TRIM(ITOS(JLAY))//'.ARR', &
      KHV(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO

 !## vertical k-value
 WRITE(IU,'(A)') ' K33 LAYERED'
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  PRJIDF%X=0.0D0
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(BND(ILAY)%X(ICOL,IROW).NE.0)THEN
    PRJIDF%X(ICOL,IROW)=1.0D0/KVA(ILAY)%X(ICOL,IROW)
!    PRJIDF%X(ICOL,IROW)=KHV(ILAY)%X(ICOL,IROW)/KVA(ILAY)%X(ICOL,IROW)
   ELSE
    PRJIDF%X(ICOL,IROW)=1.0D0
   ENDIF
  ENDDO; ENDDO
  !## do not check with boundary for mf6; include a minor modification to ensure a save in ARR files
  IFBND=0; IF(LEX)IFBND=-1
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\K33_L'//TRIM(ITOS(JLAY))//'.ARR', &
     PRJIDF,0,IU,ILAY,IFBND))RETURN
 ENDDO

 !## use ani - compute k-minor
 IF(TOPICS(TANI)%IACT_MODEL.NE.0)THEN
  WRITE(IU,'(A)') ' K22 LAYERED'
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
   PRJIDF%X=0.0D0
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).NE.0)THEN
     PRJIDF%X(ICOL,IROW)=KHV(ILAY)%X(ICOL,IROW)*ANF(ILAY)%X(ICOL,IROW)
    ELSE
     PRJIDF%X(ICOL,IROW)=1.0D0
    ENDIF
   ENDDO; ENDDO
   !## do not check with boundary for mf6; include a minor modification to ensure a save in ARR files
   IFBND=0; IF(PBMAN%IPESTP.EQ.1)IFBND=-1
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\K22_L'//TRIM(ITOS(JLAY))//'.ARR', &
      PRJIDF,0,IU,ILAY,IFBND))RETURN
  ENDDO

  WRITE(IU,'(A)') ' ANGLE1 LAYERED'
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
   PRJIDF%X=0.0D0
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).NE.0)THEN
     !## angle
     ROT=(360.0D0-ANA(ILAY)%X(ICOL,IROW))+90.0D0
     IF(ROT.GT.360.0D0)ROT=ROT-360.0D0
     PRJIDF%X(ICOL,IROW)=ROT
    ELSE
     PRJIDF%X(ICOL,IROW)=0.0D0
    ENDIF
   ENDDO; ENDDO
   IFBND=0
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\ANGLE1_L'//TRIM(ITOS(JLAY))//'.ARR', &
      PRJIDF,0,IU,ILAY,IFBND))RETURN
  ENDDO
! WRITE(IU,'(A)') ' ANGLE2 LAYERED'
! WRITE(IU,'(A)') ' ANGLE3 LAYERED'
 ENDIF
 
 IF(IWETIT.EQ.1)THEN
  WRITE(IU,'(A)') ' WETDRY LAYERED'
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
!   !## add wetdry options - lakes/inactive cells cannot be rewetted)
!   IF(LAYCON(ILAY).NE.1)THEN
   !## fill wetdry thresholds
   PRJIDF%X=0.0D0 
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
     T=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
     !## only cells below can rewet - more stable
     IF(ILAY.LT.PRJNLAY)THEN
      PRJIDF%X(ICOL,IROW)=-MIN(WETDRYTHRESS,T)
     ELSE
      PRJIDF%X(ICOL,IROW)= MIN(WETDRYTHRESS,T)
     ENDIF
    ENDIF
   ENDDO; ENDDO
   IFBND=0
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\WETDRY_L'//TRIM(ITOS(JLAY))//'.ARR', &
       PRJIDF,0,IU,ILAY,IFBND))RETURN
!   ENDIF
  ENDDO
 ENDIF
 WRITE(IU,'(A)') 'END GRIDDATA'
  
 CLOSE(IU)

 PMANAGER_SAVEMF2005_NPF_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_NPF_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SCR_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC,NSYS,NTOP,ISYS,KTOP
 
 PMANAGER_SAVEMF2005_SCR_READ=.TRUE.

 IF(TOPICS(TSCR)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3)RETURN
 
 ITOPIC=TSCR
 ALLOCATE(FNAMES(TOPICS(ITOPIC)%NSUBTOPICS),PRJILIST(1)); PRJILIST=ITOPIC

 PMANAGER_SAVEMF2005_SCR_READ=.FALSE.
 
 !## allocate memory for packages
 NTOP=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)

 !## number of systems
 DO ISYS=1,NSYS

  IF(PMANAGER_GETFNAMES(0,0,ISYS,0,0).LE.0)RETURN

  !## thickness for scr-package
  SCL_D=PBMAN%INT(ITOPIC); SCL_U=2; IINV=0
  WRITE(6,'(A)') '+Reading SCR-files ('//TRIM(RTOS(REAL(100*ISYS,8)/REAL(NSYS,8),'F',2))//'%)'     

  !## thickness
  ILAY=FNAMES(1)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(THK(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,THK(ILAY),0,ITOPIC)
  !## arr
  ILAY=FNAMES(2)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(ARR(ILAY),ITOPIC,2,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,ARR(ILAY),0,ITOPIC)
  !## bcr
  ILAY=FNAMES(3)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(BCR(ILAY),ITOPIC,3,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,BCR(ILAY),0,ITOPIC)
  !## cca
  ILAY=FNAMES(4)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(CCA(ILAY),ITOPIC,4,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,CCA(ILAY),0,ITOPIC)
  !## voi
  ILAY=FNAMES(5)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(VOI(ILAY),ITOPIC,5,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,VOI(ILAY),0,ITOPIC)
  !## sub
  ILAY=FNAMES(6)%ILAY  
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SUB(ILAY),ITOPIC,6,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SUB(ILAY),0,ITOPIC)

  IF(PBMAN%SCR_ISTPCS.EQ.0.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   ILAY=FNAMES(7)%ILAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(PCS(ILAY),ITOPIC,7,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,PCS(ILAY),0,ITOPIC)
  ELSEIF(PBMAN%SCR_ISTPCS.EQ.1.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   ILAY=FNAMES(8)%ILAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(PC0(ILAY),ITOPIC,8,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,PC0(ILAY),0,ITOPIC)
  ELSEIF(PBMAN%SCR_ISTPCS.EQ.2.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   ILAY=FNAMES(9)%ILAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(OCR(ILAY),ITOPIC,9,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,OCR(ILAY),0,ITOPIC)
  ENDIF
  IF(PBMAN%SCR_ISTPCS.EQ.3)THEN
   ILAY=FNAMES(10)%ILAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(TH0(ILAY),ITOPIC,10,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,TH0(ILAY),0,ITOPIC)
  ENDIF

  ILAY=FNAMES(11)%ILAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(GL0(ILAY),ITOPIC,11,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,GL0(ILAY),0,ITOPIC)
  ILAY=FNAMES(12)%ILAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SGS(ILAY),ITOPIC,12,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SGS(ILAY),0,ITOPIC)
  ILAY=FNAMES(13)%ILAY
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SGM(ILAY),ITOPIC,13,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SGM(ILAY),0,ITOPIC)

 ENDDO
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_SCR_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_SCR_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SCR_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,IU,ILAY,JLAY,IFBND,IROW,ICOL,NSYSTEM,NOBSSUB
 INTEGER,DIMENSION(:),ALLOCATABLE :: ISCRLAY
 
 !## return if modflow6 export
 PMANAGER_SAVEMF2005_SCR_SAVE=.TRUE.; IF(TOPICS(TSCR)%IACT_MODEL.EQ.0)RETURN
 
 IF(PBMAN%IFORMAT.EQ.3)RETURN

 !## use scr
 IF(TOPICS(TSCR)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_SCR_SAVE=.FALSE.

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

 !## construct scr-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.SCR1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 
 !prjnlay is aantla lagen met boeomdaing
 ALLOCATE(ISCRLAY(PRJNLAY)); ISCRLAY=0
 
 !## determine how many layers with interbeds
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1; I=0
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(BND(ILAY)%X(ICOL,IROW).LE.0.0)THK(ILAY)%X(ICOL,IROW)=0.0D0
   IF(THK(ILAY)%X(ICOL,IROW).GT.0.0)ISCRLAY(JLAY)=1
  ENDDO; ENDDO
 ENDDO
 NSYSTEM=0; DO ILAY=1,PRJNLAY; IF(ISCRLAY(ILAY).EQ.1)NSYSTEM=NSYSTEM+1; ENDDO 

 !## number of observations
 NOBSSUB=0
 
 WRITE(IU,'(6I10)') ISCRCB,PBMAN%SCR_ISCROC,NSYSTEM,NOBSSUB,PBMAN%SCR_IMETHOD,PBMAN%SCR_ISTPCS
 LINE=''; DO I=1,PRJNLAY; IF(ISCRLAY(I).EQ.0)CYCLE; LINE=TRIM(LINE)//' '//TRIM(ITOS(I)); ENDDO
 WRITE(IU,'(A)') TRIM(LINE)
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  !## gl0
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\GL0_L'//TRIM(ITOS(JLAY))//'.ARR', &
      GL0(ILAY),0,IU,ILAY,IFBND))RETURN
  !## sgs
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\SGS_L'//TRIM(ITOS(JLAY))//'.ARR', &
      SGS(ILAY),0,IU,ILAY,IFBND))RETURN
  !## sgm
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\SGM_L'//TRIM(ITOS(JLAY))//'.ARR', &
      SGM(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO
 
! WRITE(IU,'(A)') 'CONSTANT 0.0 GL0'
! WRITE(IU,'(A)') 'CONSTANT 1.6 SGM'
! WRITE(IU,'(A)') 'CONSTANT 1.8 SGS'
 
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  !## skip none-available interbed
  IF(ISCRLAY(ILAY).EQ.0)CYCLE
  !## thickness
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\THK_L'//TRIM(ITOS(JLAY))//'.ARR', &
      THK(ILAY),0,IU,ILAY,IFBND))RETURN
  IF(PBMAN%SCR_ISTPCS.EQ.3)THEN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\TH0_L'//TRIM(ITOS(JLAY))//'.ARR', &
      TH0(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDIF      
  !## arr
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\ARR_L'//TRIM(ITOS(JLAY))//'.ARR', &
      ARR(ILAY),0,IU,ILAY,IFBND))RETURN
  !## bcr
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\BCR_L'//TRIM(ITOS(JLAY))//'.ARR', &
      BCR(ILAY),0,IU,ILAY,IFBND))RETURN
  !## cca
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\CCA_L'//TRIM(ITOS(JLAY))//'.ARR', &
      CCA(ILAY),0,IU,ILAY,IFBND))RETURN
  !## voi
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\VOI_L'//TRIM(ITOS(JLAY))//'.ARR', &
      VOI(ILAY),0,IU,ILAY,IFBND))RETURN
  !## sub
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\SUB_L'//TRIM(ITOS(JLAY))//'.ARR', &
      SUB(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO
 
 DEALLOCATE(ISCRLAY)
 
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  IF(PBMAN%SCR_ISTPCS.EQ.0.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\PCS_L'//TRIM(ITOS(JLAY))//'.ARR', &
      PCS(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDIF
  IF(PBMAN%SCR_ISTPCS.EQ.1)THEN !.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\PC0_L'//TRIM(ITOS(JLAY))//'.ARR', &
      PC0(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDIF
  IF(PBMAN%SCR_ISTPCS.EQ.2)THEN !.OR.PBMAN%SCR_ISTPCS.EQ.3)THEN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SCR1\OCR'//TRIM(ITOS(JLAY))//'.ARR', &
      OCR(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDIF
 ENDDO
 
 CLOSE(IU)

 PMANAGER_SAVEMF2005_SCR_SAVE=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_SCR_SAVE
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_CON_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC,NCON,IROW,ICOL
 
 PMANAGER_SAVEMF2005_CON_READ=.TRUE.

 IF(TOPICS(TCON)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3.OR.WQ%VDF%MTDNCONC.EQ.1)RETURN
 IF(TOPICS(TVDF)%IACT_MODEL.EQ.0.OR.WQ%VDF%MTDNCONC.EQ.1)RETURN
 
 ALLOCATE(FNAMES(1),PRJILIST(1))

 PMANAGER_SAVEMF2005_CON_READ=.FALSE.

 NCON=0; DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading CON-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## concentration for vdf-package
  ITOPIC=TCON; SCL_D=PBMAN%INT(TCON); SCL_U=2; IINV=0

  PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(CON(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,CON(ILAY),0,ITOPIC)
  DO IROW=1,CON(ILAY)%NROW; DO ICOL=1,CON(ILAY)%NCOL
   IF(BND(ILAY)%X(ICOL,IROW).NE.0)THEN
    IF(CON(ILAY)%X(ICOL,IROW).LT.0.0D0)THEN
     NCON=NCON+1; CON(ILAY)%X(ICOL,IROW)=0.0D0
    ENDIF
    CON(ILAY)%X(ICOL,IROW)=(CON(ILAY)%X(ICOL,IROW)/WQ%VDF%DENSESLP)+WQ%VDF%DENSEREF
   ENDIF
  ENDDO; ENDDO

 ENDDO  
 IF(NCON.GT.0)WRITE(*,'(/A,I10,A/)') 'Set ',NCON,' cells with concentration < 0 to 0.0'
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_CON_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_CON_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_POR_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC
 
 PMANAGER_SAVEMF2005_POR_READ=.TRUE.

 IF(TOPICS(TPOR)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3)RETURN
 
 ALLOCATE(FNAMES(1),PRJILIST(1))

 PMANAGER_SAVEMF2005_POR_READ=.FALSE.

 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading POR-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## concentration for vdf-package
  ITOPIC=TPOR; SCL_D=PBMAN%INT(TPOR); SCL_U=2; IINV=0

  PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(POR(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,POR(ILAY),0,ITOPIC)

 ENDDO  
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_POR_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_POR_READ

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_CBI_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC
 
 PMANAGER_SAVEMF2005_CBI_READ=.TRUE.

 IF(TOPICS(TCBI)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3)RETURN
 
 ALLOCATE(FNAMES(1),PRJILIST(1))

 PMANAGER_SAVEMF2005_CBI_READ=.FALSE.

 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading CBI-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## boundary condition for concentrations (<0 constant conc. >0 variable conc =0 inactive for all conc.)
  !## cbi is not perse equal to ibound as it is the status of concentration
  ITOPIC=TCBI; SCL_D=PBMAN%INT(TCBI); SCL_U=2; IINV=0

  PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(CBI(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,CBI(ILAY),0,ITOPIC)
  
 ENDDO  
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_CBI_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_CBI_READ
 
  !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SCO_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC
 
 PMANAGER_SAVEMF2005_SCO_READ=.TRUE.

 IF(TOPICS(TSCO)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3)RETURN
 
 ALLOCATE(FNAMES(1),PRJILIST(1))

 PMANAGER_SAVEMF2005_SCO_READ=.FALSE.

 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading SCO-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  !## concentration for vdf-package
  ITOPIC=TSCO; SCL_D=PBMAN%INT(TSCO); SCL_U=2; IINV=0

  PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(ILAY,ILAY,0,1,0).LE.0)RETURN

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(SCO(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SCO(ILAY),0,ITOPIC)

 ENDDO  
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_SCO_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_SCO_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_DSP_READSAVE(DIR,DIRMNAME,IBATCH,IPRT)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC,NTOP,NSYS,ISYS,KTOP,ICNST,IU,JLAY,IFBND
 REAL(KIND=DP_KIND) :: CNST,IMP,FCT
 REAL(KIND=DP_KIND),ALLOCATABLE, DIMENSION(:,:) :: XVAL
 
 PMANAGER_SAVEMF2005_DSP_READSAVE=.TRUE.

 IF(TOPICS(TDSP)%IACT_MODEL.EQ.0)RETURN
 IF(PBMAN%IFORMAT.EQ.3.OR.WQ%VDF%MTDNCONC.EQ.0)RETURN
 
 PMANAGER_SAVEMF2005_DSP_READSAVE=.FALSE.

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

 !## construct con1-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.DSP1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 
 !## dispersion parameters
 IINV=0; ITOPIC=TDSP
 
 !## allocate memory for packages
 NTOP=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
 ALLOCATE(XVAL(NSYS,NTOP)); XVAL=0.0D0
 
 ALLOCATE(FNAMES(TOPICS(ITOPIC)%NSUBTOPICS),PRJILIST(1)); PRJILIST=ITOPIC

 !## concentration for vdf-package
 ITOPIC=TDSP; SCL_D=PBMAN%INT(TDSP); SCL_U=2; IINV=0
 PRJILIST=ITOPIC; IF(PMANAGER_GETFNAMES(0,0,0,1,0).LE.0)RETURN

 DO ILAY=1,PRJNLAY

  WRITE(6,'(A)') '+Reading DSP-files ('//TRIM(RTOS(REAL(100*ILAY,8)/REAL(PRJNLAY,8),'F',2))//'%)      '

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(LON(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,LON(ILAY),0,ITOPIC)
  !## longutidual dispersion
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DSP1\LON_L'//TRIM(ITOS(ILAY))//'.ARR', &
      LON(ILAY),0,IU,ILAY,IFBND))RETURN

 ENDDO

 !## number of systems
 DO ISYS=1,NSYS

  IF(PMANAGER_GETFNAMES(0,0,ISYS,0,0).LE.0)RETURN
 
  !## number of subtopics - skip first is array
  DO KTOP=2,NTOP
  
   ILAY =FNAMES(KTOP)%ILAY
   ICNST=FNAMES(KTOP)%ICNST
   IF(ICNST.NE.1)STOP 'ICNST NE 1'
   CNST =FNAMES(KTOP)%CNST  
   FCT  =FNAMES(KTOP)%FCT   
   IMP  =FNAMES(KTOP)%IMP   

   XVAL(ISYS,KTOP)=CNST*FCT+IMP

  ENDDO
 ENDDO
 
 WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1' 
 WRITE(IU,'(999E15.7)') (XVAL(ISYS,2),ISYS=1,NSYS)
 WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1' 
 WRITE(IU,'(999E15.7)') (XVAL(ISYS,3),ISYS=1,NSYS)
 WRITE(IU,'(A)') 'INTERNAL,1.0D0,(FREE),-1' 
 WRITE(IU,'(999E15.7)') (XVAL(ISYS,4),ISYS=1,NSYS)
 CLOSE(IU)
 DEALLOCATE(FNAMES,PRJILIST,XVAL)

 PMANAGER_SAVEMF2005_DSP_READSAVE=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_DSP_READSAVE

 !!####====================================================================
 !LOGICAL FUNCTION PMANAGER_SAVEMF2005_CON_SAVE(DIR,DIRMNAME,IBATCH)
 !!####====================================================================
 !IMPLICIT NONE
 !CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 !INTEGER,INTENT(IN) :: IBATCH
 !INTEGER :: IU,ILAY,JLAY,IFBND
 !
 !PMANAGER_SAVEMF2005_CON_SAVE=.TRUE. 
 !
 !IF(TOPICS(TCON)%IACT_MODEL.EQ.0)RETURN
 !IF(PBMAN%IFORMAT.EQ.3)RETURN
 !
 !!## use vdf6
 !PMANAGER_SAVEMF2005_CON_SAVE=.FALSE.
 !
 !IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.VDF1'//'...')
 !IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.VDF1'//'...'
 !
 !!## construct con1-file
 !IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.VDF1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 !
 !JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
 ! IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
 ! JLAY=JLAY+1
 !
 ! !## con
 ! IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\VDF1\VDF_L'//TRIM(ITOS(JLAY))//'.ARR', &
 !     CON(ILAY),0,IU,ILAY,IFBND))RETURN
 !
 !ENDDO
 !
 !CLOSE(IU)
 !
 !PMANAGER_SAVEMF2005_CON_SAVE=.TRUE.
 !
 !END FUNCTION PMANAGER_SAVEMF2005_CON_SAVE
 
 !!####====================================================================
 !LOGICAL FUNCTION PMANAGER_SAVEMF2005_DSP_SAVE(DIR,DIRMNAME,IBATCH)
 !!####====================================================================
 !IMPLICIT NONE
 !CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 !INTEGER,INTENT(IN) :: IBATCH
 !INTEGER :: IU,ILAY,JLAY,IFBND
 !
 !PMANAGER_SAVEMF2005_DSP_SAVE=.TRUE. 
 !
 !IF(TOPICS(TDSP)%IACT_MODEL.EQ.0)RETURN
 !IF(PBMAN%IFORMAT.EQ.3)RETURN
 !
 !!## use dsp
 !PMANAGER_SAVEMF2005_DSP_SAVE=.FALSE.
 !
 !IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.DSP1'//'...')
 !IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.DSP1'//'...'
 !
 !!## construct dsp1-file
 !IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.DSP1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 !
 !JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
 ! IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
 ! JLAY=JLAY+1
 !
 ! !## longutidual dispersion
 ! IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DSP1\LON_L'//TRIM(ITOS(JLAY))//'.ARR', &
 !     LON(ILAY),0,IU,ILAY,IFBND))RETURN
 ! !## ratio horizontal dispersion
 ! IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DSP1\RHD_L'//TRIM(ITOS(JLAY))//'.ARR', &
 !     RHD(ILAY),0,IU,ILAY,IFBND))RETURN
 ! !## ratio vertical dispersion
 ! IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DSP1\RVD_L'//TRIM(ITOS(JLAY))//'.ARR', &
 !     RVD(ILAY),0,IU,ILAY,IFBND))RETURN
 ! !## add effective molecular diffusion coefficient
 ! IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\DSP1\MDC_L'//TRIM(ITOS(JLAY))//'.ARR', &
 !     MDC(ILAY),0,IU,ILAY,IFBND))RETURN
 !
 !ENDDO
 !
 !CLOSE(IU)
 !
 !PMANAGER_SAVEMF2005_DSP_SAVE=.TRUE.
 !
 !END FUNCTION PMANAGER_SAVEMF2005_DSP_SAVE
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_ADV_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU

 PMANAGER_SAVEMF2005_ADV_SAVE=.TRUE. 

 IF(PBMAN%IFORMAT.NE.6.OR.WQ%VDF%MTDNCONC.EQ.0)RETURN
 
 !## use dsp
 PMANAGER_SAVEMF2005_ADV_SAVE=.FALSE.

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

 !## construct dsp1-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.ADV1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 
 WRITE(IU,'(I10,F10.2,2I10)') PBMAN%ADV%MIXELM, PBMAN%ADV%PERCEL, 0, PBMAN%ADV%NADVFD

! WRITE(IU,'(/A)') '#-------------------------------------------'
! WRITE(IU,'(A)') '[ADV] # MT3DMS ADVection package'
! WRITE(IU,'(1X,A)') 'MIXELM =  '//TRIM(ITOS(PBMAN%ADV%MIXELM))
! WRITE(IU,'(1X,A)') 'PERCEL =  '//TRIM(RTOS(PBMAN%ADV%PERCEL,'G',7))
!! WRITE(IU,'(1X,A)') '#MXPART = '//TRIM(ITOS(PBMAN%ADV%MXPART))
! WRITE(IU,'(1X,A)') 'NADVFD =  '//TRIM(ITOS(PBMAN%ADV%NADVFD))  
!         -1        1.         0         0
!#MIXELM integer -1 Advection solution option (= 0: Finite-Difference;
!#= 1: MOC; = 2: MMOC; = 3: HMOC; = -1: TVD)
!#ADV PERCEL real 1 Number of cells that advection is allowed
!#to move in one transport step (Courant number)
!#ADV MXPART integer 0 Maximum number of moving particles allowed
!#ADV NADVFD integer 0 Weighting scheme for the Finite-difference
!#method
 CLOSE(IU)

 PMANAGER_SAVEMF2005_ADV_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_ADV_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_VDF_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,JLAY,IFBND,KPER

 PMANAGER_SAVEMF2005_VDF_SAVE=.TRUE.; IF(TOPICS(TVDF)%IACT_MODEL.EQ.0)RETURN

 IF(PBMAN%IFORMAT.NE.6)RETURN
 
 !## use vdf
 PMANAGER_SAVEMF2005_VDF_SAVE=.FALSE.

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

 !## construct vdf1-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.VDF1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 
 WRITE(IU,'(4I10)')   WQ%VDF%MTDNCONC,WQ%VDF%MFNADVFD,WQ%VDF%NSWTCPL,WQ%VDF%IWTABLE
 WRITE(IU,'(2F15.7)') WQ%VDF%DENSEMIN,WQ%VDF%DENSEMAX
 WRITE(IU,'(2F15.7)') WQ%VDF%DENSEREF,WQ%VDF%DENSESLP
 WRITE(IU,'( F15.7)') WQ%VDF%FIRSTDT

 IF(WQ%VDF%MTDNCONC.EQ.0)THEN
  WRITE(IU,'(I10)') 1
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
 
   !## con
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\VDF1\VDF_L'//TRIM(ITOS(JLAY))//'.ARR', &
       CON(ILAY),0,IU,ILAY,IFBND))RETURN

  ENDDO
  !## fill for remaining stress-periods (concentration remains constant in time)
  DO KPER=2,PRJNPER; WRITE(IU,'(I10)') -1; ENDDO
 ENDIF
 
 PMANAGER_SAVEMF2005_VDF_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_VDF_SAVE
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_STO_SAVE(DIR,DIRMNAME,IBATCH,ISS)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,ISS
 INTEGER :: IU,ILAY,ISY,KPER,JLAY,IFBND
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_STO_SAVE=.TRUE.; IF(TOPICS(TSTO)%IACT_MODEL.EQ.0)RETURN

 ISY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  IF(LAYCON(ILAY).NE.1)ISY=1
 ENDDO
 
 IF(ISY.EQ.1)THEN; IF(TOPICS(TSPY)%IACT_MODEL.EQ.0)RETURN; ENDIF
 
 IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)RETURN; IF(ISS.EQ.0)RETURN

 !## use sto6
 PMANAGER_SAVEMF2005_STO_SAVE=.FALSE.

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

 !## construct npf6-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.STO6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# STO6 File Generated by '//TRIM(UTL_IMODVERSION())

 WRITE(IU,'(/A/)') '#General Options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 LEX=.FALSE.
 IF(ASSOCIATED(PBMAN%ISAVE(TSTO)%ILAY))LEX=.TRUE.
 IF(ASSOCIATED(PBMAN%ISAVE(TSPY)%ILAY))LEX=.TRUE.
 IF(LEX)WRITE(IU,'(A)') ' SAVE_FLOWS'
 IF(PBMAN%SPECIFICSTORAGE.EQ.0)WRITE(IU,'(A)') ' STORAGECOEFFICIENT'  !## specific coefficient given if NOT mentioned
! IF(ISY.EQ.1)WRITE(IU,'(A)') ' SS_CONFINED_ONLY'    !## usage of ss and sy as in MF2005 - why?
 WRITE(IU,'(A)') 'END OPTIONS'

 WRITE(IU,'(/A/)') '#Geology Options'
 WRITE(IU,'(A)') 'BEGIN GRIDDATA'
 WRITE(IU,'(A)') ' ICONVERT LAYERED'
! ISY=0
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
 IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  IF(LAYCON(ILAY).EQ.1)THEN
   WRITE(IU,'(A)') '  CONSTANT 0'    !## confined storage
  ELSE
   WRITE(IU,'(A)') '  CONSTANT 1'    !## convertible storage
!   ISY=1
  ENDIF
 ENDDO
 
 !## if ipestp and storage is optimized
 LEX=.FALSE.; IF(PBMAN%IPESTP.EQ.1)THEN
  DO I=1,SIZE(PEST%PARAM); IF(PEST%PARAM(I)%PPARAM.EQ.'SC')THEN; LEX=.TRUE.; EXIT; ENDIF; ENDDO
 ENDIF
 
 WRITE(IU,'(A)') ' SS LAYERED'
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  !## include a minor modification to ensure a save in ARR files
  IFBND=1; IF(LEX)IFBND=-1
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\STO6\SS_L'//TRIM(ITOS(JLAY))//'.ARR', &
      STO(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO

 IF(ISY.EQ.1)THEN
  
  !## if ipestp and storage is optimized
  LEX=.FALSE.; IF(PBMAN%IPESTP.EQ.1)THEN
   DO I=1,SIZE(PEST%PARAM); IF(PEST%PARAM(I)%PPARAM.EQ.'SY')THEN; LEX=.TRUE.; EXIT; ENDIF; ENDDO
  ENDIF
 
  WRITE(IU,'(A)') ' SY LAYERED'
  JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
   IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
   JLAY=JLAY+1
   !## include a minor modification to ensure a save in ARR files
   IFBND=1; IF(LEX)IFBND=-1
   !## spy
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\STO6\SY_L'//TRIM(ITOS(JLAY))//'.ARR', &
       SPY(ILAY),0,IU,ILAY,IFBND))RETURN
  ENDDO
 ENDIF
 WRITE(IU,'(A)') 'END GRIDDATA'
  
 WRITE(IU,'(/A/)') '#Time Storage Options'
 DO KPER=1,PRJNPER
  WRITE(IU,'(A)') 'BEGIN PERIOD '//TRIM(ITOS(KPER))
  IF(SIM(KPER)%DELT.EQ.0.0D0)WRITE(IU,'(A)') ' STEADY-STATE'
  IF(SIM(KPER)%DELT.NE.0.0D0)WRITE(IU,'(A)') ' TRANSIENT'
  WRITE(IU,'(A)') 'END PERIOD'
 ENDDO
 
 CLOSE(IU)

 PMANAGER_SAVEMF2005_STO_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_STO_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_ANI_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ILAY,SCL_D,SCL_U,IINV,ITOPIC,NTOP,NSYS,ISYS,KTOP,ICNST
 REAL(KIND=DP_KIND) :: FCT,CNST,IMP
 CHARACTER(LEN=256) :: SFNAME
  
 PMANAGER_SAVEMF2005_ANI_READ=.TRUE.

 !## use ani1
 IF(TOPICS(TANI)%IACT_MODEL.EQ.0)RETURN

 WRITE(6,'(A)') '+Reading ANI-files ...'

 PMANAGER_SAVEMF2005_ANI_READ=.FALSE.

 !## ani angle
 IINV=0; ITOPIC=TANI
 
 !## allocate memory for packages
 NTOP=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
 
 ALLOCATE(FNAMES(TOPICS(ITOPIC)%NSUBTOPICS),PRJILIST(1)); PRJILIST=ITOPIC

 !## fill with default values 
 DO ILAY=1,PRJNLAY; ANF(ILAY)%X=1.0D0; ANA(ILAY)%X=0.0D0; ANF(ILAY)%NODATA=HUGE(1.0); ANA(ILAY)%NODATA=HUGE(1.0); ENDDO

 !## number of systems
 DO ISYS=1,NSYS

  IF(PMANAGER_GETFNAMES(0,0,ISYS,0,0).LE.0)RETURN
 
  SCL_D=PBMAN%INT(ITOPIC); SCL_U=2; IINV=0
  WRITE(6,'(A)') '+Reading ANI-files ('//TRIM(RTOS(REAL(100*ISYS,8)/REAL(NSYS,8),'F',2))//'%)'     

  ILAY=FNAMES(1)%ILAY  
  SCL_U=2; SCL_D=PBMAN%INT(TANI) 
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(ANF(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,ANF(ILAY),0,ITOPIC)

  ILAY=FNAMES(1)%ILAY  
  SCL_U=7; SCL_D=0
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(ANA(ILAY),ITOPIC,2,SCL_D,SCL_U,IINV,IPRT))RETURN
  CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,ANA(ILAY),0,ITOPIC)
   
 ENDDO
 
 DEALLOCATE(FNAMES,PRJILIST)
 
 PMANAGER_SAVEMF2005_ANI_READ=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_ANI_READ

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_ANI_SAVE(DIR,DIRMNAME,IBATCH)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,ILAY,JLAY,IFBND
  
 !## return if modflow6 export
 PMANAGER_SAVEMF2005_ANI_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.3)RETURN

 !## use ani
 IF(TOPICS(TANI)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_ANI_SAVE=.FALSE.

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

 !## construct ani1-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.ANI1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN

 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY) 
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  JLAY=JLAY+1
  !## anisotropy factors
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\ANI1\ANF_L'//TRIM(ITOS(JLAY))//'.ARR', &
      ANF(ILAY),0,IU,ILAY,IFBND))RETURN
  !## anisotropy angle
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\ANI1\ANA_L'//TRIM(ITOS(JLAY))//'.ARR', &
      ANA(ILAY),0,IU,ILAY,IFBND))RETURN
 ENDDO
 
 CLOSE(IU)

 PMANAGER_SAVEMF2005_ANI_SAVE=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_ANI_SAVE
  
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_WEL(DIR,DIRMNAME,IBATCH,IACT,ITOPIC,ICB,CPCK,IPRT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ICB,ITOPIC,IPRT,IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: X,Y,Q,Z1,Z2,FCT,IMP,CNST,NCOUNT,CONC
 CHARACTER(LEN=256) :: SFNAME,EXFNAME,ID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=30) :: FRM
 CHARACTER(LEN=126) :: ERRORMSG
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: STRING
 INTEGER :: IU,JU,KU,ILAY,IROW,ICOL,I,J,NROWIPF,NCOLIPF,IEXT,IOS,N,KPER,IPER,NP,MP,ICNST,ISYS,&
  NSYS,ISS,JLAY,ISYSMF6,NSYSMF6,IS1,IS2,NINACTIVE
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
 INTEGER(KIND=8) :: ITIME,JTIME
 REAL(KIND=DP_KIND),PARAMETER :: MINKHT=0.0D0
 CHARACTER(LEN=1) :: VTXT
 LOGICAL :: LEX
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_WEL=.TRUE.; RETURN; ENDIF

 PMANAGER_SAVEMF2005_WEL=.FALSE.
 
 VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6'

 !## only export if not existing currently
 IF(PBMAN%IEXPORTMF2005.EQ.-1)THEN
  INQUIRE(FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,EXIST=LEX)
  IF(LEX)THEN; PMANAGER_SAVEMF2005_WEL=.TRUE.; RETURN; ENDIF
 ENDIF
 
 !## in case MF6 is used, apply systems per package
 IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(TWEL,2)
 ELSE
  NSYSMF6=1
 ENDIF
 
 DO ISYSMF6=1,NSYSMF6
 
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...'

  IU=UTL_GETUNIT()
  IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
   IF(PBMAN%SSYSTEM.EQ.0)THEN
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ENDIF
  ELSE
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  IF(IU.EQ.0)RETURN

  IF(PBMAN%IFORMAT.EQ.3)THEN
   WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'  
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
 !  WRITE(IU,'(A)') ' AUXILIARY <auxiliary(naux)>'
 !  WRITE(IU,'(A)') ' AUXMULTNAME <auxmultname>'
   IF(PBMAN%QWEL.GT.0.0D0)WRITE(IU,'(A)') ' AUTO_FLOW_REDUCE '//TRIM(RTOS(PBMAN%QWEL,'F',2))
 !  WRITE(IU,'(A)') ' BOUNDNAMES'
 !  WRITE(IU,'(A)') ' PRINT_INPUT'
 !  WRITE(IU,'(A)') ' PRINT_FLOWS'
   IF(ASSOCIATED(PBMAN%ISAVE(TWEL)%ILAY))WRITE(IU,'(A)') ' SAVE_FLOWS'
 !  WRITE(IU,'(A)') ' TS6 FILEIN <ts6_filename>'
 !  WRITE(IU,'(A)') ' OBS6 FILEIN <obs6_filename>'
 !  WRITE(IU,'(A)') ' MOVER'
   WRITE(IU,'(A)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#General Dimensions'  
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   WRITE(IU,'(A)') 'MAXBOUND NaN1#'
   WRITE(IU,'(A)') 'END DIMENSIONS'
  ENDIF

  !## header
  LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT'
  IF(PBMAN%IFORMAT.EQ.6.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1)THEN
   IF(WQ%VDF%MTDNCONC.EQ.0)LINE=TRIM(LINE)//' AUX WELDEN'
   IF(WQ%VDF%MTDNCONC.EQ.1)LINE=TRIM(LINE)//' WELSSMDENSE AUX WELDEN'
  ENDIF
  LINE=TRIM(LINE)//' AUX ISUB WSUBSYS ISUB'
  IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE) 

  !## fill tlp for each modellayer
  IF(ALLOCATED(TLP))DEALLOCATE(TLP); IF(ALLOCATED(KH)) DEALLOCATE(KH)
  IF(ALLOCATED(TP)) DEALLOCATE(TP);  IF(ALLOCATED(BT)) DEALLOCATE(BT)
  ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))

  IF(PBMAN%IFORMAT.EQ.6)THEN
   WRITE(FRM,'(A9,I2.2,A15)') '(3(I5,1X),',2,'(G15.7,1X),I10)'
  ELSE
   WRITE(FRM,'(A9,I2.2,A15)') '(3(I5,1X),',1,'(G15.7,1X),I10)'
  ENDIF

  !## create subfolders
  IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'7')

  !## maximum number of well in simulation
  MP=0
  IOS=0
  NINACTIVE=0
  
  DO IPER=1,PRJNPER

   !## number of wells per stressperiod
   NP=0
  
   !## get appropriate stress-period to store in runfile   
   KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
  
   !## always export wells per stress-period
   IF(PBMAN%DWEL.EQ.1)KPER=ABS(KPER)
  
   !## output
   WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
   IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  
  
   !## reuse previous timestep
   IF(KPER.LE.0)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
     IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
     ELSE; WRITE(IU,'(I10)') -1; ENDIF
    ENDIF
    !## goto next timestep
    CYCLE
   ENDIF

   JU=0
   !## create subfolders
   IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
    CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'7')
    EXFNAME=TRIM(DIR)//'\'//CPCK//'7'//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
   ELSE
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6)))
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ELSE
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6')
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ENDIF
   ENDIF
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IOS=0; IF(JU.EQ.0)THEN; IOS=-1; EXIT; ENDIF

   !## number of systems
   NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)

   IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
    !## skip system if 
    IS1=ISYSMF6; IS2=IS1; IF(ISYSMF6.GT.NSYS)THEN; IS1=0; IS2=-1; ENDIF
   ELSE
    !## export all systems
    IS1=1; IS2=NSYS
   ENDIF

   DO ISYS=IS1,IS2

    ICNST =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ICNST
    CNST  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%CNST
    FCT   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FCT
    IMP   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%IMP
    ILAY  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ILAY
    SFNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FNAME

    WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
       ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)
   
    CDIR=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1)   
 
    KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,SFNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)RETURN
    READ(KU,*,IOSTAT=IOS) NROWIPF; IF(IOS.NE.0)THEN; ERRORMSG="reading NRECORDS from the header." ; EXIT; ENDIF
    READ(KU,*,IOSTAT=IOS) NCOLIPF; IF(IOS.NE.0)THEN; ERRORMSG="reading NFIELDS from the header." ; EXIT; ENDIF
    DO I=1,NCOLIPF
     READ(KU,*,IOSTAT=IOS); IF(IOS.NE.0)THEN; ERRORMSG="reading FIELDNAME from the header." ; EXIT; ENDIF
    ENDDO
    READ(KU,*,IOSTAT=IOS) IEXT,EXT; IF(IOS.NE.0)THEN; ERRORMSG="reading INDEXCOLUMN,EXTENT from the header." ; EXIT; ENDIF

    N=NCOLIPF; ALLOCATE(STRING(N)); STRING=''
    
    !## steady-state/transient timestep  
    !## NB different use of local variable ISS for Steady state (ISS=1, not 0) and Transient (ISS=2, not 1)
    ISS=1; IF(SIM(IPER)%DELT.GT.0.0D0)ISS=2

    !## compute average in case model is STEADY STATE but IPF is transient and uses column 3 as reference to associated files
    IF(ISS.EQ.1.AND.IEXT.GT.0)THEN
     WRITE(*,'(/A)') 'IMOD COMPUTES AVERAGE EXTRACTION VOLUMES FOR:'
     WRITE(*,'(A)') '  >>> '//TRIM(SFNAME)//' <<<'
    ENDIF     
   
    DO I=1,NROWIPF

     !## start with current given layer number
     ILAY=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ILAY

     !## read csv entry
     IF(.NOT.UTL_READCSVENTRY(KU,STRING))THEN; ERRORMSG="reading "//TRIM(ITOS(N))//" columns." ; EXIT; ENDIF
 
     READ(STRING(1),*,IOSTAT=IOS) X; IF(IOS.NE.0)THEN; ERRORMSG="reading the X coordinate in column 1." ; EXIT; ENDIF
     READ(STRING(2),*,IOSTAT=IOS) Y; IF(IOS.NE.0)THEN; ERRORMSG="reading the Y coordinate in column 2." ; EXIT; 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

     !## get discharge - always on position 3
     IF(IEXT.EQ.0)THEN
      READ(STRING(3),*,IOSTAT=IOS) Q; IF(IOS.NE.0)THEN; ERRORMSG="reading discharge (value) in column 3." ; EXIT ; ENDIF
     ELSE
      !## get id number - can be any column
      READ(STRING(IEXT),'(A)',IOSTAT=IOS) ID; IF(IOS.NE.0)THEN; ERRORMSG="reading the ID name in column "//TRIM(ITOS(IEXT))//"." ; EXIT; ENDIF
     ENDIF

     !## assign to several layer
     IF(ILAY.EQ.0)THEN
      
      READ(STRING(4),*,IOSTAT=IOS) Z1; IF(IOS.NE.0)THEN; ERRORMSG="reading Z1 in column 4." ; EXIT; ENDIF
      READ(STRING(5),*,IOSTAT=IOS) Z2; IF(IOS.NE.0)THEN; ERRORMSG="reading Z2 in column 5." ; EXIT; ENDIF

      !## get filter fractions
      CALL PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KDW,TP,BT,KH,.TRUE.)
      CALL UTL_PCK_GETTLP(PRJNLAY,TLP,KH,TP,BT,Z1,Z2,MINKHT) 

     !## find uppermost layer
     ELSE
       
      IF(ILAY.EQ.-1)THEN
       DO ILAY=1,PRJNLAY
        IF(BND(ILAY)%X(ICOL,IROW).GT.0)EXIT !## no active BND cell found in the vertical 
       ENDDO
      ENDIF
      !## outside current model dimensions, set ilay=0
      IF(ILAY.GT.PRJNLAY)ILAY=0; TLP=0.0D0; IF(ILAY.NE.0)TLP(ILAY)=1.0D0

      !## read concentration (injection wells only)
      CONC=0.0D0
      IF(PBMAN%IFORMAT.EQ.6.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1.AND.Q.GT.0.0D0)THEN
       READ(STRING(4),*,IOSTAT=IOS) CONC; IF(IOS.NE.0)THEN; ERRORMSG="reading CONC in column 4." ; EXIT; ENDIF
      ENDIF
      
     ENDIF
     
     IF(IEXT.GT.0)THEN
      IF(.NOT.UTL_PCK_READTXT(2,ITIME,JTIME,Q,TRIM(CDIR)//'\'//TRIM(ID)//'.'//TRIM(EXT),0,'',ISS,NCOUNT))THEN
       IOS=-1; EXIT
      ENDIF
      IF(NCOUNT.LE.0.0D0)Q=0.0D0
     ENDIF
         
     !## use factor/impulse
     Q=Q*FCT; Q=Q+IMP  

     IF(Q.NE.0.0D0)THEN
    
      !## only active cells
      DO ILAY=1,PRJNLAY
       IF(TLP(ILAY).EQ.0.0)CYCLE
       IF(BND(ILAY)%X(ICOL,IROW).LE.0.0D0)THEN
        NINACTIVE=NINACTIVE+1
!        IF(NINACTIVE.EQ.1)THEN
!         WRITE(*,'(/A)') 'Number of removed wells that are in inactive/constant heads.'
!         WRITE(*,'(3A10,A15)') 'Nr_inactive','icol','irow','volume'
!        ENDIF
!        WRITE(*,'(3I10,F15.7)') NINACTIVE,ICOL,IROW,TLP(ILAY)*Q
        !## normalize tlp() again
        TLP(ILAY)=0.0D0; IF(SUM(TLP).GT.0.0D0)TLP=(1.0D0/SUM(TLP))*TLP
       ENDIF
      ENDDO

      JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
       IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; JLAY=JLAY+1
       IF(TLP(ILAY).GT.0.0D0)THEN
        IF(PBMAN%IFORMAT.EQ.6)THEN
         WRITE(JU,FRM) JLAY,IROW,ICOL,Q*TLP(ILAY),CONC,ISYS
        ELSE
         WRITE(JU,FRM) JLAY,IROW,ICOL,Q*TLP(ILAY),ISYS
        ENDIF
        NP=NP+1
       ENDIF
      ENDDO
     ENDIF
     
    ENDDO
  
    DEALLOCATE(STRING)
    CLOSE(KU)

    IF(IOS.NE.0)THEN
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading IPF file:'//CHAR(13)//TRIM(SFNAME)//CHAR(13)// &
        'Linenumber '//TRIM(ITOS(I))//': '//TRIM(ERRORMSG),'Error'); RETURN
    ENDIF     
   
   ENDDO

   IF(NP.GT.0)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)CALL IDFWRITEFREE_HEADER(JU,PRJIDF)
    CLOSE(JU)
   ELSE
    CLOSE(JU,STATUS='DELETE')
   ENDIF
  
   IF(IOS.NE.0)EXIT
  
   !## store maximum number of well in simulation
   MP=MAX(MP,NP)
  
   IF(PBMAN%IFORMAT.GE.2)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
     LINE=TRIM(ITOS(NP)); WRITE(IU,'(A)') TRIM(LINE)
    ENDIF
    IF(NP.GT.0)THEN
     SFNAME=EXFNAME
     N=3
     IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)N=5
     IF(PBMAN%SSYSTEM.EQ.1.AND.PBMAN%IFORMAT.EQ.3)N=4
     DO I=1,N; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
     I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
     IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%IPESTP.EQ.1)SFNAME='.'//TRIM(SFNAME)
     IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
     WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
     IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD'
    ELSE
     !## write period-block to make sure new information is contained
     IF(PBMAN%IFORMAT.EQ.3)THEN
      WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
      WRITE(IU,'(A)') 'END PERIOD'
     ENDIF
    ENDIF

   ENDIF
  
  ENDDO
 
  CLOSE(IU); DEALLOCATE(TLP,TP,BT,KH)

  IF(IOS.EQ.0)THEN
   !## mf6 does not accept zero boundaries
   IF(PBMAN%IFORMAT.EQ.3)THEN
    MP=MAX(1,MP)
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',(/MP/))
    ELSE
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/MP/))
    ENDIF
   ELSE
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/MP/))
   ENDIF
   PMANAGER_SAVEMF2005_WEL=.TRUE.
  ENDIF

 ENDDO
 
 IF(NINACTIVE.GT.0)THEN
  WRITE(*,'(/A)') 'Number of removed wells that are in inactive/constant heads is '//TRIM(ITOS(NINACTIVE))
 ENDIF
 
 END FUNCTION PMANAGER_SAVEMF2005_WEL
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_OBS(DIR,DIRMNAME,IBATCH,IACT,ITOPIC,CPCK,IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ITOPIC,IACT,IOPTION
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: X,Y,Z1,Z2,FCT,IMP,CNST,H,NCOUNT,W,ROFF,COFF,X1,Y1,X2,Y2
 CHARACTER(LEN=256) :: SFNAME,EXFNAME,OBSNAME,CID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=126) :: ERRORMSG
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: STRING
 INTEGER :: IU,JU,KU,ILAY,IROW,ICOL,I,J,II,NROWIPF,NCOLIPF,IEXT,IOS,N,NP,ICNST,ISYS,NSYS,IPER,KPER,IP, &
   IXCOL,IYCOL,ILCOL,IMCOL,IVCOL,IZ1CL,IZ2CL
 INTEGER(KIND=8) :: ITIME,JTIME
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
 CHARACTER(LEN=1) :: VTXT
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_OBS=.TRUE.; RETURN; ENDIF

 PMANAGER_SAVEMF2005_OBS=.FALSE.
 
 IF(PBMAN%IFORMAT.EQ.3)VTXT='6' !## mf5
 IF(PBMAN%IFORMAT.EQ.6)VTXT='7' !## seawat

 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...'
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
 IF(IU.EQ.0)RETURN
 
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(DIRMNAME)//'.MES'//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
 IF(JU.EQ.0)THEN; CLOSE(IU); RETURN; ENDIF

 IF(PBMAN%IFORMAT.EQ.3)THEN
  WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(IU,'(/A/)') '#General Options'  
  WRITE(IU,'(A)') 'BEGIN OPTIONS'
  WRITE(IU,'(A)') ' DIGITS 7'
  WRITE(IU,'(A)') ' PRINT_INPUT'
  WRITE(IU,'(A)') 'END OPTIONS'
 ELSEIF(PBMAN%IFORMAT.EQ.6)THEN
  WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(IU,'(A)') DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\OBS\OBS -1'; CLOSE(IU)
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.HOB'//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  WRITE(IU,'(A,2I10)') 'NaN1#',0,1
  WRITE(IU,'(2F15.3)') 1.0,1.0
 ENDIF
 
 WRITE(JU,'(A)') '# MES'//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
 WRITE(JU,'(/A)') 'TIMESTEPS '//TRIM(ITOS(PRJNPER))
 WRITE(JU,'(A/)') 'MAXOBS NaN1#'

 !## fill tlp for each modellayer
 ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))

 !## maximum number of well in simulation
 IOS=0
 
 IF(PBMAN%IFORMAT.EQ.3)THEN
  EXFNAME='.\GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELOUTPUT\OUTPUT_OBS.TXT'
  IF(PBMAN%IPESTP.EQ.1)EXFNAME='.'//TRIM(EXFNAME)
  WRITE(IU,'(/A)') 'BEGIN CONTINUOUS FILEOUT '//TRIM(EXFNAME)
 ENDIF
 
 NSYS=0
 IF(IOPTION.EQ.1)THEN
  NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
 ELSEIF(IOPTION.EQ.2)THEN
  IF(ASSOCIATED(PEST%MEASURES))NSYS=SIZE(PEST%MEASURES)
 ENDIF
 
 NP=0; DO ISYS=1,NSYS
 
  !## obs-package
  IF(IOPTION.EQ.1)THEN
   ICNST =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ICNST
   CNST  =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%CNST
   FCT   =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FCT
   IMP   =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%IMP
   ILAY  =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ILAY
   SFNAME=TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FNAME
   IXCOL =1
   IYCOL =2
   ILCOL=0; IF(ILAY.LT.0)ILCOL=ABS(ILAY)
   IMCOL =4
   IVCOL =5
   IZ1CL =6
   IZ2CL =7
  !## pst-package
  ELSEIF(IOPTION.EQ.2)THEN
   SFNAME=PEST%MEASURES(ISYS)%IPFNAME
   IXCOL=PEST%MEASURES(ISYS)%IXCOL
   IYCOL=PEST%MEASURES(ISYS)%IYCOL
   ILCOL=PEST%MEASURES(ISYS)%ILCOL
   IMCOL=PEST%MEASURES(ISYS)%IMCOL
   IVCOL=PEST%MEASURES(ISYS)%IVCOL
   IZ1CL=PEST%MEASURES(ISYS)%IZ1CL
   IZ2CL=PEST%MEASURES(ISYS)%IZ2CL
   FCT=1.0D0
   IMP=0.0D0
  ENDIF
  
  CDIR=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1)   

  KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,SFNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)RETURN
  READ(KU,*,IOSTAT=IOS) NROWIPF; IF(IOS.NE.0)THEN; ERRORMSG="reading NRECORDS from the header." ; EXIT; ENDIF
  READ(KU,*,IOSTAT=IOS) NCOLIPF; IF(IOS.NE.0)THEN; ERRORMSG="reading NFIELDS from the header." ; EXIT; ENDIF
  DO I=1,NCOLIPF
    READ(KU,*,IOSTAT=IOS); IF(IOS.NE.0)THEN; ERRORMSG="reading FIELDNAME from the header." ; EXIT; ENDIF
  ENDDO
  READ(KU,*,IOSTAT=IOS) IEXT,EXT; IF(IOS.NE.0)THEN; ERRORMSG="reading INDEXCOLUMN,EXTENT from the header." ; EXIT; ENDIF

  IF(IOPTION.EQ.1)THEN
   N=MAX(5,IEXT); IF(ILAY.EQ.0)N=MAX(6,IEXT)
  ELSEIF(IOPTION.EQ.2)THEN
   N=MAX(IXCOL,IYCOL,ILCOL,IMCOL,ABS(IVCOL))
  ENDIF
  
  IF(N.GT.NCOLIPF)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD need at least '//TRIM(ITOS(N))//' columns however it reads only '//TRIM(ITOS(NCOLIPF))//' from:'//CHAR(13)// &
      TRIM(SFNAME),'Error'); RETURN
  ENDIF
  ALLOCATE(STRING(N)); STRING=''
    
  DO I=1,NROWIPF
   
   READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,N); IF(IOS.NE.0)THEN; ERRORMSG="reading "//TRIM(ITOS(N))//" columns." ; EXIT; ENDIF

   IF(IOPTION.EQ.1)THEN
    !## start with current given layer number
    IF(ILCOL.EQ.0)THEN
     ILAY=TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ILAY
    ELSE
     READ(STRING(ILCOL),*,IOSTAT=IOS) ILAY; IF(IOS.NE.0)THEN; ERRORMSG="reading value in ILCOL." ; EXIT; ENDIF
    ENDIF
   ELSEIF(IOPTION.EQ.2)THEN
    IF(ILCOL.GT.0)THEN
     READ(STRING(ILCOL),*,IOSTAT=IOS) ILAY; IF(IOS.NE.0)THEN; ERRORMSG="reading value in ILCOL." ; EXIT; ENDIF
    ELSE
     ILAY=ABS(ILCOL)
    ENDIF
   ENDIF
    
   READ(STRING(IXCOL),*,IOSTAT=IOS) X; IF(IOS.NE.0)THEN; ERRORMSG="reading the X coordinate." ; EXIT; ENDIF
   READ(STRING(IYCOL),*,IOSTAT=IOS) Y; IF(IOS.NE.0)THEN; ERRORMSG="reading the Y coordinate." ; EXIT; ENDIF

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

   SELECT CASE (ILAY)
    CASE (0  ); IP=5
    CASE (:-1); IP=3
    CASE (1: ); IP=4
   END SELECT

   !## assign to several layers only for standard obs package
   IF(ILAY.EQ.0)THEN

    READ(STRING(IZ1CL),*,IOSTAT=IOS) Z1; IF(IOS.NE.0)THEN; ERRORMSG="reading Z1 in column IZ1COL." ; EXIT; ENDIF
    READ(STRING(IZ2CL),*,IOSTAT=IOS) Z2; IF(IOS.NE.0)THEN; ERRORMSG="reading Z2 in column IZ2COL." ; EXIT; ENDIF
    !## only one layer per measurement
    Z1=(Z1+Z2)/2.0D0; Z2=Z1

    !## get filter fractions
    CALL PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KDW,TP,BT,KH,.TRUE.)
    CALL UTL_PCK_GETTLP(PRJNLAY,TLP,KH,TP,BT,Z1,Z2,0.0D0) 

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

   ENDIF

   IF(IOPTION.EQ.1)THEN
    READ(STRING(IP+1),*,IOSTAT=IOS) W;  IF(IOS.NE.0)THEN; ERRORMSG="reading weight." ; EXIT; ENDIF
   ELSEIF(IOPTION.EQ.2)THEN
    READ(STRING(ABS(IVCOL)),*,IOSTAT=IOS) W;  IF(IOS.NE.0)THEN; ERRORMSG="reading weight." ; EXIT; ENDIF
    !## convert weight to stdev (in obs and hob weigths are represented by stdev values)
    IF(IVCOL.LT.0)THEN; IF(W.LE.0.0D0)THEN; W=0.0D0; ELSE; W=SQRT(1.0D0/W); ENDIF; ENDIF
   ENDIF
   
   !## skip this one as weight is zero
   IF(W.LE.0.0D0)CYCLE

   !## only active cells
   DO ILAY=1,PRJNLAY
    IF(BND(ILAY)%X(ICOL,IROW).LE.0.0D0)TLP(ILAY)=0.0D0
   ENDDO
   
   !## get head
   IF(IOPTION.EQ.1)THEN
    IF(IEXT.EQ.0)THEN
     READ(STRING(IP),*,IOSTAT=IOS) H; IF(IOS.NE.0)THEN; ERRORMSG="reading Head." ; EXIT; ENDIF
    ELSE
     !## get id number - can be any column
     READ(STRING(IEXT),'(A)',IOSTAT=IOS) CID; IF(IOS.NE.0)THEN; ERRORMSG="reading ID." ; EXIT; ENDIF
    ENDIF
   ELSEIF(IOPTION.EQ.2)THEN
    IF(IEXT.EQ.IMCOL.AND.IEXT.GT.0)THEN
     !## get id number - can be any column
     READ(STRING(IEXT),'(A)',IOSTAT=IOS) CID; IF(IOS.NE.0)THEN; ERRORMSG="reading ID." ; EXIT; ENDIF
    ELSE
     READ(STRING(IMCOL),*,IOSTAT=IOS) H; IF(IOS.NE.0)THEN; ERRORMSG="reading Head." ; EXIT; ENDIF
    ENDIF
   ENDIF
   
   !## how many entries
   II=0; DO ILAY=1,SIZE(PBMAN%ILAY)
    IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
    IF(TLP(ILAY).GT.0.0D0)II=II+1
   ENDDO
   II=II*PRJNPER

   !## skip this one
   IF(II.EQ.0)CYCLE

   WRITE(OBSNAME,'(A)') 'IPF'//TRIM(ITOS(ISYS))//'_NO'//TRIM(ITOS(I))
   WRITE(JU,'(A)') TRIM(OBSNAME)//','//TRIM(ITOS(II))//','//TRIM(RTOS(X,'F',3))//','//TRIM(RTOS(Y,'F',3))
   WRITE(JU,'(A)') 'TIME,HEAD,STDEV,ILAY'

   CALL IDFGETEDGE(BND(1),IROW,ICOL,X1,Y1,X2,Y2)
   ROFF=((Y-Y1)/(Y2-Y1))-0.5D0
   COFF=((X-X1)/(X2-X1))-0.5D0
   
   !## get measurements for this observation for comparision
   DO IPER=1,PRJNPER

    !## write steady state dummy values
    IF(IEXT.GT.0.AND.SIM(IPER)%DELT.EQ.0.0D0)THEN
     DO ILAY=1,SIZE(PBMAN%ILAY)
      IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
      IF(TLP(ILAY).GT.0.0D0)THEN
       WRITE(JU,'(A)') '00000000000000,'//TRIM(RTOS(HNOFLOW,'G',7))//','//TRIM(RTOS(W,'F',3))//','//TRIM(ITOS(ILAY))
      ENDIF
     ENDDO
     CYCLE
    ENDIF
    
    !## get appropriate stress-period to store in runfile   
    IF(IOPTION.EQ.1)THEN
     KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
    ELSEIF(IOPTION.EQ.2)THEN
     KPER=PMANAGER_GETCURRENTIPER(IPER,TPST,ITIME,JTIME)
    ENDIF
    
    !## get value from txt-files
    IF(IEXT.GT.0)THEN
     IF(.NOT.UTL_PCK_READTXT(2,ITIME,JTIME,H,TRIM(CDIR)//'\'//TRIM(CID)//'.'//TRIM(EXT),0,'',2,NCOUNT,IEXT=0))THEN
      IOS=-1; EXIT
     ENDIF
     IF(NCOUNT.LE.0.0D0)H=HNOFLOW
    ENDIF
         
    !## get time-label (represented by start- or end of stress-period)
    IF(PBMAN%ISAVEENDDATE.EQ.1)ITIME=JTIME
    
    !## use factor/impulse
    H=H*FCT; H=H+IMP  
    DO ILAY=1,SIZE(PBMAN%ILAY)
     IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
     IF(TLP(ILAY).GT.0.0D0)THEN
      !## write in mes files
      WRITE(JU,'(A)') TRIM(ITOS_DBL(ITIME))//','//TRIM(RTOS(H,'G',7))//','//TRIM(RTOS(W,'F',3))//','//TRIM(ITOS(ILAY))
      !## write in hob(seawat) files      
      IF(PBMAN%IFORMAT.EQ.6)THEN
       WRITE(IU,'(A15,4I10,5F15.3,2I10)') TRIM(OBSNAME),ILAY,IROW,ICOL,IPER,SIM(IPER)%DELT,ROFF,COFF,H,W,1,1
       NP=NP+1
      ENDIF
     ENDIF
    ENDDO

   ENDDO
   
   !## add measurement
   DO ILAY=1,SIZE(PBMAN%ILAY)
    IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
    IF(TLP(ILAY).GT.0.0D0)THEN
     !## write in obs(mf6)
     IF(PBMAN%IFORMAT.EQ.3)THEN
      WRITE(IU,'(A)') TRIM(OBSNAME)//',HEAD,'//TRIM(ITOS(ILAY))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
      NP=NP+1
     ENDIF
    ENDIF
   ENDDO
  ENDDO
  DEALLOCATE(STRING)
  CLOSE(KU)
  
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading IPF file:'//CHAR(13)//TRIM(SFNAME)//CHAR(13)// &
        'Linenumber '//TRIM(ITOS(I))//': '//TRIM(ERRORMSG),'Error'); RETURN
  ENDIF     
   
 ENDDO
  
! !## store maximum number of well in simulation
! MP=MAX(MP,NP)
  
 IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END CONTINUOUS' 

 CLOSE(IU); CLOSE(JU); DEALLOCATE(TLP,TP,BT,KH)

 IF(PBMAN%IFORMAT.EQ.6)CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.HOB'//VTXT//'_',(/NP/))

 IF(PBMAN%IFORMAT.EQ.6)NP=NP/PRJNPER; 
 CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.MES'//VTXT//'_',(/NP/))

 IF(IOS.EQ.0)PMANAGER_SAVEMF2005_OBS=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_OBS
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MNW2(DIR,DIRMNAME,IBATCH,IACT,ITOPIC,ICB,CPCK,IPRT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ICB,ITOPIC,IPRT,IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: X,Y,Q,Z1,Z2,FCT,IMP,CNST,RW,RSKIN,KSKIN,NCOUNT,F
 CHARACTER(LEN=256) :: SFNAME,EXFNAME,ID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=30) :: LOSSTYPE
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: STRING
 INTEGER :: IU,KU,ILAY,IROW,ICOL,I,J,ISYS,NROWIPF,NCOLIPF,IEXT,IOS,N,KPER,IPER,LPER,NSYS,ICNST,IDIM,NDIM, &
   MNWPRINT,NNODES,ILOSSTYPE,QLIMIT,PPFLAG,PUMPLOC,PUMPCAP,ILOSS,IEQUAL,JLAY,NSYSMF6,ISYSMF6,IS1,IS2,JU, &
   NGWFNODES,ICON,MP
 INTEGER(KIND=8) :: ITIME,JTIME
 LOGICAL :: LEX
 CHARACTER(LEN=1) :: VTXT
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_MNW2=.TRUE.; RETURN; ENDIF

 PMANAGER_SAVEMF2005_MNW2=.FALSE.
 
 VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6'

 !## only export if not existing currently
 IF(PBMAN%IEXPORTMF2005.EQ.-1)THEN
  INQUIRE(FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,EXIST=LEX)
  IF(LEX)THEN; PMANAGER_SAVEMF2005_MNW2=.TRUE.; RETURN; ENDIF
 ENDIF
 
 !## in case MF6 is used, apply systems per package
 IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(TMNW,2)
 ELSE
  NSYSMF6=1
 ENDIF
 
 DO ISYSMF6=1,NSYSMF6
 
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...'

  IU=UTL_GETUNIT()
  IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
   IF(PBMAN%SSYSTEM.EQ.0)THEN
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ENDIF
  ELSE
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  IF(IU.EQ.0)RETURN

  IF(PBMAN%IFORMAT.EQ.3)THEN
   WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'  
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
 !  WRITE(IU,'(A)') ' AUXILIARY <auxiliary(naux)>'
 !  WRITE(IU,'(A)') ' AUXMULTNAME <auxmultname>'
!   WRITE(IU,'(A)') ' BOUNDNAMES'
 !  WRITE(IU,'(A)') ' PRINT_INPUT'
 !  WRITE(IU,'(A)') ' PRINT_FLOWS'
   IF(ASSOCIATED(PBMAN%ISAVE(TMNW)%ILAY))WRITE(IU,'(A)') ' SAVE_FLOWS'
![PRINT_HEAD]
![HEAD FILEOUT <headfile>]
![BUDGET FILEOUT <budgetfile>]
![BUDGETCSV FILEOUT <budgetcsvfile>]
![NO_WELL_STORAGE]
![FLOW_CORRECTION]
![FLOWING_WELLS]
![SHUTDOWN_THETA <shutdown_theta>]
![SHUTDOWN_KAPPA <shutdown_kappa>]
![TS6 FILEIN <ts6_filename>]
![OBS6 FILEIN <obs6_filename>]
![MOVER]
   WRITE(IU,'(A)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#General Dimensions'  
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   WRITE(IU,'(A)') ' NMAWWELLS NaN1#'
   WRITE(IU,'(A)') 'END DIMENSIONS'
  ENDIF
 
  !## no output information, use 2 for maximal output
  MNWPRINT=0 !2
 
  !## header
  LINE='NaN1#,'//TRIM(ITOS(ICB))//','//TRIM(ITOS(MNWPRINT))
  IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)   
 
  !## fill tlp for each modellayer
  IF(ALLOCATED(TLP))DEALLOCATE(TLP); IF(ALLOCATED(KH)) DEALLOCATE(KH)
  IF(ALLOCATED(TP)) DEALLOCATE(TP);  IF(ALLOCATED(BT)) DEALLOCATE(BT)
  ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))

  !## search for first mnw definition in time - can be one only !!!
  DO IPER=1,PRJNPER
   !## get appropriate input file for first stress-period 
   KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
   !## found appropriate stress-period
   IF(KPER.GT.0)EXIT
  ENDDO
  !## nothing found
  IF(IPER.GT.PRJNPER)KPER=0

  !## store maximum number of well in simulation
  ALLOCATE(NP_IPER(0:PRJNPER)); NP_IPER=0; LPER=0

  !## fill static-time independent information
  IOS=0; DO IPER=0,PRJNPER
  
   IF(IPER.GT.0)THEN

    !## get appropriate stress-period to store in runfile   
    KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
    !## output
    WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
    IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  

    !## always export wells per stress-period
    IF(PBMAN%DWEL.EQ.1)KPER=ABS(KPER)

   ENDIF
  
   !## reuse previous timestep
   IF(KPER.LE.0)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
     IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
     ELSE; WRITE(IU,'(I10)') -1; ENDIF
    ENDIF
    !## goto next timestep
    CYCLE
   ENDIF  
  
   JU=0
   !## create subfolders
   IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
    JU=IU
   ELSE
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6)))
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ELSE
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6')
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ENDIF
    JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IOS=0; IF(JU.EQ.0)THEN; IOS=-1; EXIT; ENDIF
   ENDIF
  
   IF(PBMAN%IFORMAT.NE.3)THEN
    IF(IPER.GT.0)THEN; LINE='NaN'//TRIM(ITOS(IPER+1))//'#'; WRITE(IU,'(A)') TRIM(LINE); ENDIF
   ENDIF
  
   !## get number of mnw-systems
   NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)

   IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
    !## export current system only
    IS1=MIN(NSYS,ISYSMF6); IS2=IS1   
   ELSE
    !## export all systems
    IS1=1; IS2=NSYS
   ENDIF

   DO ISYS=IS1,IS2

    ICNST =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ICNST
    CNST  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%CNST
    FCT   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FCT
    IMP   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%IMP
    ILAY  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ILAY
    SFNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%FNAME

    !## check to see whether equal to previous timestep
    IEQUAL=1
    IF(LPER.GT.0)THEN
     IEQUAL=1
     IF(ICNST.EQ. TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%ICNST.AND. &
       CNST .EQ. TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%CNST.AND.  &
!       FCT.EQ.   TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%FCT.AND.   &
!       IMP .EQ.  TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%IMP.AND.   &
        ILAY.EQ.  TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%ILAY.AND.  &
        SFNAME.EQ.TOPICS(ITOPIC)%STRESS(LPER)%FILES(1,ISYS)%FNAME)IEQUAL=-1
    ENDIF
    !## for MNW it is essential that the number of files are similar during simulation
    IF(LPER.GT.1.AND.IEQUAL.EQ.1)THEN
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'For the MNW package it is NOT allowed to specify different input files'//CHAR(13)// &
         'among different stress-periods','Error'); IOS=-1; RETURN
    ENDIF
   
    IF(IPER.GT.0)THEN
     WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
       ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)
    ENDIF
   
    CDIR=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1)   
 
    NDIM=1; IF(PBMAN%IFORMAT.EQ.3)NDIM=2
    
    DO IDIM=1,NDIM

     NP_IPER(IPER)=0
     
     KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,SFNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)THEN; IOS=-1; EXIT; ENDIF
     READ(KU,*,IOSTAT=IOS) NROWIPF; IF(IOS.NE.0)EXIT
     READ(KU,*,IOSTAT=IOS) NCOLIPF; IF(IOS.NE.0)EXIT
     DO I=1,NCOLIPF; READ(KU,*,IOSTAT=IOS); IF(IOS.NE.0)EXIT; ENDDO
     READ(KU,*,IOSTAT=IOS) IEXT,EXT; IF(IOS.NE.0)EXIT

     N=NCOLIPF; ALLOCATE(STRING(N)); STRING=''
       
     IF(ILAY.GT.0)ILOSS=4; IF(ILAY.EQ.0)ILOSS=6
    
     IF(IPER.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
      IF(IDIM.EQ.1)THEN
       WRITE(IU,'(/A/)') '#Package Data'  
       WRITE(IU,'(A)') 'BEGIN PACKAGEDATA'
       WRITE(IU,'(A)') '# wellno radius bottom strt condeqn ngwnodes name'
      ELSE
       WRITE(IU,'(/A/)') '#Connection Data'  
       WRITE(IU,'(A)') 'BEGIN CONNECTIONDATA'
       WRITE(IU,'(A)') '# wellno conn l r c stop sbot k rskin'
      ENDIF
     ENDIF
     
     DO I=1,NROWIPF
   
      !## start with current given layer number
      ILAY=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ILAY

      IF(.NOT.UTL_READCSVENTRY(KU,STRING))EXIT

      READ(STRING(1),*,IOSTAT=IOS) X; IF(IOS.NE.0)EXIT
      READ(STRING(2),*,IOSTAT=IOS) Y; IF(IOS.NE.0)EXIT
    
      !## 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(ILAY.LE.0)THEN
       READ(STRING(4),*,IOSTAT=IOS) Z1; IF(IOS.NE.0)EXIT
       READ(STRING(5),*,IOSTAT=IOS) Z2; IF(IOS.NE.0)EXIT
       !## see whether there is an MNW at all present
       CALL PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KDW,TP,BT,KH,.TRUE.)
       CALL UTL_PCK_GETTLP(PRJNLAY,TLP,KH,TP,BT,Z1,Z2,0.0D0)
      ELSE
       TLP(ILAY)=1.0D0
!     !# not present in current model
!     IF(BND(ILAY)%X(ICOL,IROW).LE.0.0D0)CYCLE
      ENDIF
    
      !## make sure mnw not constant head cell 
      DO JLAY=1,PRJNLAY; IF(BND(JLAY)%X(ICOL,IROW).LE.0.0D0)TLP(JLAY)=0.0D0; ENDDO
      !# not present in current model
      IF(SUM(TLP).EQ.0.0D0)CYCLE

      NP_IPER(IPER)=NP_IPER(IPER)+1
    
      !## write alphanumerical identification of well
      IF(IPER.EQ.0)THEN
     
       IF(ILAY.GT.0)NNODES= 1 !## single well screen layer given
       IF(ILAY.LE.0)NNODES=-1 !## single well screen layer determined
       
       IF(PBMAN%IFORMAT.NE.3)THEN
        LINE='WELLID_'//TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(ITOS(NNODES))
        !## identification
        WRITE(IU,'(A)') TRIM(LINE)
       ENDIF
       
       READ(STRING(ILOSS),*,IOSTAT=IOS) LOSSTYPE; IF(IOS.NE.0)EXIT
       !## losstype
       LOSSTYPE=UTL_CAP(LOSSTYPE,'U')
       SELECT CASE (TRIM(LOSSTYPE))
        CASE ('NONE');       ILOSSTYPE=0
        CASE ('THIEM');      ILOSSTYPE=1
        CASE ('SKIN');       ILOSSTYPE=2
!       CASE ('GENERAL');    ILOSSTYPE=3
!       CASE ('SPECIFYCWC'); ILOSSTYPE=4
        CASE DEFAULT
         CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Specified model ('//TRIM(LOSSTYPE)//') for well loss unknown'//CHAR(13)// &
           'Select one of the following:'//CHAR(13)//'NONE, THIEM, SKIN','Error'); IOS=-1; RETURN
!          'Select one of the following:'//CHAR(13)//'NONE, THIEM, SKIN, GENERAL, SPECIFYCWC','Error'); IOS=-1; EXIT
       END SELECT
       IF(ILOSSTYPE.EQ.0.AND.NNODES.LT.0)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Specified model ('//TRIM(LOSSTYPE)//') for well cannot be'//CHAR(13)// &
          'used in combination with ILAY=0','Error'); IOS=-1; RETURN
       ENDIF
      
       PUMPLOC=0 !## no location of pump intake or injection
       QLIMIT=0  !## pumpage not by constraints
       PPFLAG=0  !## head not adjusted for partial penetration of well - error in case ibound is zero
       !IF(NNODES.EQ. 1)PPFLAG=0  !## head not adjusted for partial penetration of well
       !IF(NNODES.EQ.-1)PPFLAG=1  !## head adjusted for partial penetration of well
       PUMPCAP=0 !## discharge not defined by head-capacity relation
       IF(PBMAN%IFORMAT.NE.3)THEN
        LINE=TRIM(LOSSTYPE)//','//TRIM(ITOS(PUMPLOC))//','//TRIM(ITOS(QLIMIT))//','//TRIM(ITOS(PPFLAG))//','//TRIM(ITOS(PUMPCAP))
        WRITE(IU,'(A)') TRIM(LINE)
       ENDIF
       
       SELECT CASE (ILOSSTYPE)
        !## thiem
        CASE(1)
         READ(STRING(ILOSS+1),*,IOSTAT=IOS) RW; IF(IOS.NE.0)EXIT
         IF(PBMAN%IFORMAT.NE.3)THEN
          LINE=TRIM(RTOS(RW,'F',2)); WRITE(IU,'(A)') TRIM(LINE)
         ENDIF
        !## skin
        CASE(2)
         READ(STRING(ILOSS+1),*,IOSTAT=IOS) RW;    IF(IOS.NE.0)EXIT
         READ(STRING(ILOSS+2),*,IOSTAT=IOS) RSKIN; IF(IOS.NE.0)EXIT
         READ(STRING(ILOSS+3),*,IOSTAT=IOS) KSKIN; IF(IOS.NE.0)EXIT
         IF(PBMAN%IFORMAT.NE.3)THEN
          LINE=TRIM(RTOS(RW,'F',2))//','//TRIM(RTOS(RSKIN,'F',2))//','//TRIM(RTOS(KSKIN,'F',2)); WRITE(IU,'(A)') TRIM(LINE)
         ENDIF
       END SELECT
       IF(PBMAN%IFORMAT.NE.3)THEN
        IF(NNODES.GT.0)THEN
         LINE=TRIM(ITOS(ILAY))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
         WRITE(IU,'(A)') TRIM(LINE)
        ELSE
         LINE=TRIM(RTOS(Z1,'F',2))//','//TRIM(RTOS(Z2,'F',2))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
         WRITE(IU,'(A)') TRIM(LINE)
        ENDIF
       ELSE
        IF(IDIM.EQ.1)THEN
         NGWFNODES=0; DO JLAY=1,PRJNLAY; IF(TLP(JLAY).NE.0.0D0)NGWFNODES=NGWFNODES+1; ENDDO
         LINE=TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(RTOS(RW,'F',2))//','//TRIM(RTOS(Z2,'F',2))//','//TRIM(RTOS(Z1,'F',2))//',THIEM,'//TRIM(ITOS(NGWFNODES))
         WRITE(IU,'(A)') TRIM(LINE)
        ELSE
         ICON=0; DO JLAY=1,PRJNLAY
          IF(TLP(JLAY).EQ.0.0D0)CYCLE
          ICON=ICON+1
          LINE=TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(ITOS(ICON))//','//TRIM(ITOS(JLAY))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))// &
             ','//TRIM(RTOS(TOP(JLAY)%X(ICOL,IROW),'F',2))//','//TRIM(RTOS(BOT(JLAY)%X(ICOL,IROW),'F',2))//',0.0,0.0'
         WRITE(IU,'(A)') TRIM(LINE)
         ENDDO
        ENDIF
       ENDIF       

      ELSE
    
       !## get discharge - always on position 3
       IF(IEXT.EQ.0)THEN
        READ(STRING(3),*,IOSTAT=IOS) Q; IF(IOS.NE.0)EXIT
       ELSE
        !## get id number - can be any column
        READ(STRING(IEXT),*,IOSTAT=IOS) ID; IF(IOS.NE.0)EXIT
        IF(.NOT.UTL_PCK_READTXT(2,ITIME,JTIME,Q,TRIM(CDIR)//'\'//TRIM(ID)//'.'//TRIM(EXT),0,'',2,NCOUNT))THEN
         IOS=-1; EXIT
        ENDIF
        IF(NCOUNT.LE.0.0D0)Q=0.0D0
       ENDIF
  
       !## use factor/impulse
       Q=Q*FCT; Q=Q+IMP  
 
       IF(PBMAN%IFORMAT.NE.3)THEN
        LINE='WELLID_'//TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(RTOS(Q,'G',7))
        WRITE(JU,'(A)') TRIM(LINE)
       ELSE
        LINE=TRIM(ITOS(NP_IPER(IPER)))//' STATUS ACTIVE'
        WRITE(JU,'(A)') TRIM(LINE)
        LINE=TRIM(ITOS(NP_IPER(IPER)))//' RATE '//TRIM(RTOS(Q,'G',7))
        WRITE(JU,'(A)') TRIM(LINE)
        !## reduction in qwel-fraction of filter-screen size
        F=(Z1-Z2)*PBMAN%QWEL
        LINE=TRIM(ITOS(NP_IPER(IPER)))//' RATE_SCALING '//TRIM(RTOS(Z2,'G',7))//' '//TRIM(RTOS(F,'G',7))
        WRITE(JU,'(A)') TRIM(LINE)
       ENDIF
       
      ENDIF
        
     ENDDO
    
     IF(IOS.NE.0)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error reading IPF file'//CHAR(13)//TRIM(SFNAME)//CHAR(13)// &
         'Linenumber '//TRIM(ITOS(I)),'Error'); RETURN
     ENDIF     

     IF(IPER.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
      IF(IDIM.EQ.1)THEN
       WRITE(IU,'(A)') 'END PACKAGEDATA'
      ELSE
       WRITE(IU,'(A)') 'END CONNECTIONDATA'
      ENDIF
     ENDIF
     
     DEALLOCATE(STRING); CLOSE(KU)

    ENDDO
    
   ENDDO
 
   IF(IOS.NE.0)EXIT
 
   IF(PBMAN%IFORMAT.EQ.3)THEN
!    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
!     LINE=TRIM(ITOS(NP)); WRITE(IU,'(A)') TRIM(LINE)
!    ENDIF
    IF(IPER.GT.0)THEN
     IF(NP_IPER(IPER).GT.0)THEN
      SFNAME=EXFNAME
      N=3
      IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)N=5
      IF(PBMAN%SSYSTEM.EQ.1.AND.PBMAN%IFORMAT.EQ.3)N=4
      DO I=1,N; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
      I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
      IF(PBMAN%IPESTP.EQ.1)SFNAME='.'//TRIM(SFNAME)
      WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
      WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
      WRITE(IU,'(A)') 'END PERIOD'
     ELSE
      !## write period-block to make sure new information is contained
      IF(PBMAN%IFORMAT.EQ.3)THEN
       WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
       WRITE(IU,'(A)') 'END PERIOD'
      ENDIF
     ENDIF
    ENDIF
    
   ENDIF
   
   !## store previous stress-period information for this timestep
   IF(IPER.GT.0)LPER=KPER

  ENDDO
 
  CLOSE(IU)

  !## store maximum number of well in simulation
  NP_IPER(0)=MAXVAL(NP_IPER(1:PRJNPER))
  
  IF(IOS.EQ.0)THEN
   !## mf6 does not accept zero boundaries
   IF(PBMAN%IFORMAT.EQ.3)THEN
    MP=MAX(1,NP_IPER(0))
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',(/MP/))
    ELSE
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/MP/))
    ENDIF
   ELSE
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',NP_IPER)
   ENDIF
   PMANAGER_SAVEMF2005_MNW2=.TRUE.
  ENDIF 

!  IF(IOS.EQ.0)THEN
!   CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//TRIM(VTXT)//'_',NP_IPER) 
!   PMANAGER_SAVEMF2005_MNW2=.TRUE.
!  ENDIF

 ENDDO

 DEALLOCATE(TLP,KH,TP,BT,NP_IPER)

 END FUNCTION PMANAGER_SAVEMF2005_MNW2
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,IACT,ICB,CPCK,IPRT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ICB,IPRT,IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: FCT,IMP,CNST
 CHARACTER(LEN=256) :: SFNAME,EXFNAME
 CHARACTER(LEN=30) :: FRM
 INTEGER :: IU,JU,ILAY,I,ISYS,KPER,IPER,NTOP,NSYS,ICNST,ICOL,IROW,JSYS,ISYSMF6,NSYSMF6,IS1,IS2
 INTEGER,DIMENSION(2) :: NP
 INTEGER(KIND=8) :: ITIME,JTIME
 TYPE(GRIDISGOBJ) :: GRIDISG
 CHARACTER(LEN=1) :: VTXT
 LOGICAL :: LEX
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_ISG=.TRUE.; RETURN; ENDIF
 
 PMANAGER_SAVEMF2005_ISG=.FALSE.
 
 VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6'

 !## only export if not existing currently
 IF(PBMAN%IEXPORTMF2005.EQ.-1)THEN
  INQUIRE(FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,EXIST=LEX)
  IF(LEX)THEN; PMANAGER_SAVEMF2005_ISG=.TRUE.; RETURN; ENDIF
 ENDIF

 !## in case MF6 is used, apply systems per package
 IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(TISG,2)
 ELSE
  NSYSMF6=1
 ENDIF
 
 DO ISYSMF6=1,NSYSMF6

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

  IU=UTL_GETUNIT()
  IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ELSE
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  IF(IU.EQ.0)RETURN

  IF(PBMAN%IFORMAT.EQ.3)THEN
   WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'  
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
!  WRITE(IU,'(A)') ' AUXILIARY <auxiliary(naux)>'
!  WRITE(IU,'(A)') ' AUXMULTNAME <auxmultname>'
!  WRITE(IU,'(A)') ' BOUNDNAMES'
!  WRITE(IU,'(A)') ' PRINT_INPUT'
!  WRITE(IU,'(A)') ' PRINT_FLOWS'
   IF(ASSOCIATED(PBMAN%ISAVE(TRIV)%ILAY))WRITE(IU,'(A)') ' SAVE_FLOWS'
!  WRITE(IU,'(A)') ' TS6 FILEIN <ts6_filename>'
!  WRITE(IU,'(A)') ' OBS6 FILEIN <obs6_filename>'
!  WRITE(IU,'(A)') ' MOVER'
   WRITE(IU,'(A)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#General Dimensions'  
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   WRITE(IU,'(A)') 'MAXBOUND NaN1#'
   WRITE(IU,'(A)') 'END DIMENSIONS'
  ENDIF
 
  IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
   IF(PBMAN%INFFCT.EQ.1)THEN
    LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB RSUBSYS ISUB NOPRINT'
   ELSE
    LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX RFCT AUX ISUB RFACT RFCT RSUBSYS ISUB NOPRINT'
   ENDIF
   WRITE(IU,'(A)') TRIM(LINE)
  ENDIF
 
  WRITE(FRM,'(A9,I2.2,A14)') '(3(I5,1X),',1,'(G15.7,1X),I5)'

  !## create subfolders
  CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)

  CALL PMANAGER_SAVEMF2005_ALLOCATEPCK(PRJNLAY,TISG)

  NP=0
 
  GRIDISG%XMIN=BND(1)%XMIN; GRIDISG%YMIN=BND(1)%YMIN
  GRIDISG%XMAX=BND(1)%XMAX; GRIDISG%YMAX=BND(1)%YMAX
  GRIDISG%IDIM=0
  GRIDISG%CS=BND(1)%DX !## cellsize
  GRIDISG%MINDEPTH=0.1
  GRIDISG%WDEPTH=0.0D0
  GRIDISG%ICDIST=1     !## compute influence of structures
  GRIDISG%ISIMGRO=0    !## no simgro
  GRIDISG%IEXPORT=1    !## modflow river files
  GRIDISG%POSTFIX=''
  GRIDISG%NODATA=-999.99D0
  GRIDISG%ISAVE=1
  GRIDISG%MAXWIDTH=1000.0D0
  GRIDISG%IAVERAGE=1

  IF(BND(1)%IEQ.EQ.1)THEN
   GRIDISG%NCOL=BND(1)%NCOL; GRIDISG%NROW=BND(1)%NROW
   ALLOCATE(GRIDISG%DELR(0:BND(1)%NCOL))
   DO ICOL=0,GRIDISG%NCOL; GRIDISG%DELR(ICOL)=BND(1)%SX(ICOL); ENDDO
   ALLOCATE(GRIDISG%DELC(0:BND(1)%NROW))
   DO IROW=0,GRIDISG%NROW; GRIDISG%DELC(IROW)=BND(1)%SY(IROW); ENDDO
  ELSE
   GRIDISG%NCOL=0; GRIDISG%NROW=0
  ENDIF

  DO IPER=1,PRJNPER
   
   !## reset only for isg to riv conversion
   NP(1)=0

   !## get appropriate stress-period to store in runfile   
   KPER=PMANAGER_GETCURRENTIPER(IPER,TISG,ITIME,JTIME)

   !## always export rivers per stress-period
   IF(PBMAN%DISG.EQ.1)KPER=ABS(KPER)
  
   !## output
   WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
   IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  

   !## reuse previous timestep
   IF(KPER.LE.0)THEN
    IF(IPER.EQ.1)THEN
     WRITE(IU,'(I10)') 0
    ELSE
     WRITE(IU,'(A)') '-1'
    ENDIF
    !## process next timestep
    CYCLE
   ENDIF
  
!   IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     

   !## create subfolders
   IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
    CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)
    EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
   ELSE
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6)))
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ELSE
     CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6')
     EXFNAME=TRIM(DIR)//'\'//CPCK//'6\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
    ENDIF
   ENDIF
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
  
   !## ISG not yet supports timescales less than 1 day
   GRIDISG%SDATE=SIM(IPER)%IYR*10000+SIM(IPER)%IMH*100+SIM(IPER)%IDY
   GRIDISG%SDATE=UTL_IDATETOJDATE(GRIDISG%SDATE)
   GRIDISG%EDATE=GRIDISG%SDATE+MAX(1,INT(SIM(IPER)%DELT))
   !## transient (2) or steady-state (1)
   GRIDISG%ISTEADY=2; IF(SIM(IPER)%DELT.EQ.0.0D0)GRIDISG%ISTEADY=1

   !## output folder
   GRIDISG%ROOT=EXFNAME(1:INDEX(EXFNAME,'\',.TRUE.)-1)  

   !## allocate memory for packages
   NTOP=SIZE(TOPICS(TISG)%STRESS(KPER)%FILES,1); NSYS=SIZE(TOPICS(TISG)%STRESS(KPER)%FILES,2)
  
   IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
    !## export current system only
    IS1=ISYSMF6; IS2=IS1
   ELSE
    !## export all systems
    IS1=1; IS2=NSYS
   ENDIF

   !## number of systems
   DO ISYS=IS1,IS2

    ICNST =TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%ICNST
    CNST  =TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%CNST
    FCT   =TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%FCT
    IMP   =TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%IMP
    ILAY  =TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%ILAY
    SFNAME=TOPICS(TISG)%STRESS(KPER)%FILES(1,ISYS)%FNAME

    !## save header only after last export
    GRIDISG%IEXPORTHDR=0; IF(ISYS.EQ.IS2)GRIDISG%IEXPORTHDR=1
    
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     JSYS=ISYS
    ELSE
     JSYS=1
    ENDIF
   
    WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(TISG)%TNAME(1:5)//',', &
       ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)

    IF(ISGREAD((/SFNAME/),IBATCH))THEN
     !## translate again to idate as it will be convered to jdate in next subroutine
     GRIDISG%SDATE=UTL_JDATETOIDATE(GRIDISG%SDATE)
     GRIDISG%EDATE=UTL_JDATETOIDATE(GRIDISG%EDATE)-1  !<- edate is equal to sdate if one day is meant
     IF(.NOT.ISG2GRID(GRIDISG%POSTFIX,BND(1)%NROW,BND(1)%NCOL,PRJNLAY,ILAY,TOP,BOT,KHV,BND,VCW,IBATCH,NP,JU, &
                      GRIDISG,SFT,TOPICS(TSFT)%IACT_MODEL,JSYS,FCT,IMP))EXIT 
     CALL ISGDEAL(1); CALL ISGCLOSEFILES()
    ELSE
     !## stop processing
     CLOSE(IU); CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK(); RETURN
    ENDIF

   ENDDO
  
   !## only for river package usage of external filename
   IF(PBMAN%IFORMAT.GE.2)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
     LINE=TRIM(ITOS(NP(1))); WRITE(IU,'(A)') TRIM(LINE)
    ENDIF
    NP(2)=MAXVAL(NP)
    IF(NP(1).GT.0)THEN
     SFNAME=EXFNAME
     N=3
     IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)N=5
     IF(PBMAN%SSYSTEM.EQ.1.AND.PBMAN%IFORMAT.EQ.3)N=4
     DO I=1,N; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
     I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
     IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%IPESTP.EQ.1)SFNAME='.'//TRIM(SFNAME)
     IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     
     WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
     IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD'
    ENDIF
    IF(IU.NE.JU)CLOSE(JU)
   ELSE
    IF(PBMAN%IFORMAT.EQ.3)THEN
     WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     
     WRITE(IU,'(A)') 'END PERIOD'
    ENDIF
   ENDIF
  
  ENDDO
 
  CLOSE(IU); CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK()
  IF(ASSOCIATED(GRIDISG%DELR))DEALLOCATE(GRIDISG%DELR)
  IF(ASSOCIATED(GRIDISG%DELC))DEALLOCATE(GRIDISG%DELC)

  !## no error occured
  IF(IPER.GT.NPER)THEN
   !## mf6 does not accept zero boundaries
   IF(PBMAN%IFORMAT.EQ.3)THEN
    IF(PBMAN%SSYSTEM.EQ.0)THEN
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',(/NP(2)/))
    ELSE
     CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP(2)/))
    ENDIF
   ELSE
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP(2)/))
   ENDIF
   PMANAGER_SAVEMF2005_ISG=.TRUE.
  ENDIF

 ENDDO
 
 END FUNCTION PMANAGER_SAVEMF2005_ISG
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SFR(DIR,DIRMNAME,IBATCH,IACT,ICB,CPCK,IPRT)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: CONST=86400.0D0 !## conversion to m3/day
 REAL(KIND=DP_KIND),PARAMETER :: DLEAK=0.001D0
 INTEGER,INTENT(IN) :: IBATCH,ICB,IPRT,IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: FCT,IMP,CNST
 CHARACTER(LEN=256) :: SFNAME,EXFNAME
 CHARACTER(LEN=30) :: FRM
 INTEGER :: IU,JU,ILAY,I,ISYS,KPER,IPER,NTOP,NSYS,ICNST,ICOL,IROW,JSYS
 INTEGER,DIMENSION(2) :: NP
 INTEGER(KIND=8) :: ITIME,JTIME
 TYPE(GRIDISGOBJ) :: GRIDISG
 CHARACTER(LEN=1) :: VTXT
 LOGICAL :: LEX
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_SFR=.TRUE.; RETURN; ENDIF
 
 PMANAGER_SAVEMF2005_SFR=.FALSE.
 
 VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6'

 !## only export if not existing currently
 IF(PBMAN%IEXPORTMF2005.EQ.-1)THEN
  INQUIRE(FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,EXIST=LEX)
  IF(LEX)THEN; PMANAGER_SAVEMF2005_SFR=.TRUE.; RETURN; ENDIF
 ENDIF

 !## check number of systems
 NSYS=PMANAGER_GETNSYS(TSFR,2)
 IF(NSYS.NE.1)THEN
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You cannot use more than 1 SFR entry in the PRJ-file','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'You cannot use more than 1 SFR entry in the PRJ-file'
  RETURN
 ENDIF
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...'

 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
 IF(IU.EQ.0)RETURN

 IF(PBMAN%IFORMAT.EQ.3)THEN
  WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(IU,'(/A/)') '#General Options'  
  WRITE(IU,'(A)') 'BEGIN OPTIONS'
!  WRITE(IU,'(A)') ' AUXILIARY <auxiliary(naux)>'
!  WRITE(IU,'(A)') ' AUXMULTNAME <auxmultname>'
!  WRITE(IU,'(A)') ' BOUNDNAMES'
!  WRITE(IU,'(A)') ' PRINT_INPUT'
!  WRITE(IU,'(A)') ' PRINT_FLOWS'
  IF(ASSOCIATED(PBMAN%ISAVE(TRIV)%ILAY))WRITE(IU,'(A)') ' SAVE_FLOWS'
!  WRITE(IU,'(A)') ' TS6 FILEIN <ts6_filename>'
!  WRITE(IU,'(A)') ' OBS6 FILEIN <obs6_filename>'
!  WRITE(IU,'(A)') ' MOVER'
  WRITE(IU,'(A)') 'END OPTIONS'
  WRITE(IU,'(/A/)') '#General Dimensions'  
  WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
  WRITE(IU,'(A)') 'MAXBOUND NaN1#'
  WRITE(IU,'(A)') 'END DIMENSIONS'
 ENDIF
 
 IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
  LINE='NaN2#,NaN1#,0,0,'//TRIM(RTOS(CONST,'G',7))//','//TRIM(RTOS(DLEAK,'E',4))//','// &
         TRIM(ITOS(ICB))//','//TRIM(ITOS(ISFRCB2))//' NOPRINT'
  WRITE(IU,'(A)') TRIM(LINE)
 ENDIF
 
 WRITE(FRM,'(A9,I2.2,A14)') '(3(I5,1X),',1,'(G15.7,1X),I5)'

 !## create subfolders
 CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)

 CALL PMANAGER_SAVEMF2005_ALLOCATEPCK(PRJNLAY,TSFR)

 NP=0
 
 GRIDISG%XMIN=BND(1)%XMIN; GRIDISG%YMIN=BND(1)%YMIN
 GRIDISG%XMAX=BND(1)%XMAX; GRIDISG%YMAX=BND(1)%YMAX
 GRIDISG%IDIM=0
 GRIDISG%CS=BND(1)%DX !## cellsize
 GRIDISG%MINDEPTH=0.1
 GRIDISG%WDEPTH=0.0D0
 GRIDISG%ICDIST=1     !## compute influence of structures
 GRIDISG%ISIMGRO=0    !## no simgro
 GRIDISG%IEXPORT=1    !## modflow river files

 IF(BND(1)%IEQ.EQ.1)THEN
  GRIDISG%NCOL=BND(1)%NCOL; GRIDISG%NROW=BND(1)%NROW
  ALLOCATE(GRIDISG%DELR(0:BND(1)%NCOL))
  DO ICOL=0,GRIDISG%NCOL; GRIDISG%DELR(ICOL)=BND(1)%SX(ICOL); ENDDO
  ALLOCATE(GRIDISG%DELC(0:BND(1)%NROW))
  DO IROW=0,GRIDISG%NROW; GRIDISG%DELC(IROW)=BND(1)%SY(IROW); ENDDO
 ELSE
  GRIDISG%NCOL=0; GRIDISG%NROW=0
 ENDIF
 GRIDISG%POSTFIX=''
 GRIDISG%NODATA=-999.99D0
 GRIDISG%ISAVE=1
 GRIDISG%MAXWIDTH=1000.0D0
 GRIDISG%IAVERAGE=1

 DO IPER=1,PRJNPER

  !## get appropriate stress-period to store in runfile   
  KPER=PMANAGER_GETCURRENTIPER(IPER,TSFR,ITIME,JTIME)

  !## always export streamflow routing per stress-period
  IF(PBMAN%DSFR.EQ.1)KPER=ABS(KPER)
  
  !## output
  WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
  IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  

  !## reuse previous timestep
  IF(KPER.LE.0)THEN
   IF(IPER.EQ.1)THEN
    WRITE(IU,'(I10)') 0
   ELSE
    !## do not print input data
    WRITE(IU,'(A)') '-1,'//TRIM(ITOS(IRDFLG))//',0,0'
   ENDIF
   !## process next timestep
   CYCLE
  ENDIF
  
!  IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     

  JU=IU
  
  !## ISG not yet supports timescales less than 1 day
  GRIDISG%SDATE=SIM(IPER)%IYR*10000+SIM(IPER)%IMH*100+SIM(IPER)%IDY
  GRIDISG%SDATE=UTL_IDATETOJDATE(GRIDISG%SDATE)
  GRIDISG%EDATE=GRIDISG%SDATE+MAX(1,INT(SIM(IPER)%DELT))
  !## transient (2) or steady-state (1)
  GRIDISG%ISTEADY=2; IF(SIM(IPER)%DELT.EQ.0.0D0)GRIDISG%ISTEADY=1

  EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'.ISG'
  GRIDISG%ROOT=EXFNAME(1:INDEX(EXFNAME,'\',.TRUE.)-1)  

  !## allocate memory for packages
  NTOP=SIZE(TOPICS(TSFR)%STRESS(KPER)%FILES,1); NSYS=SIZE(TOPICS(TSFR)%STRESS(KPER)%FILES,2)
  
  !## number of systems
  ISYS=1

  ICNST =TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%ICNST
  CNST  =TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%CNST
  FCT   =TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%FCT
  IMP   =TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%IMP
  ILAY  =TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%ILAY
  SFNAME=TOPICS(TSFR)%STRESS(KPER)%FILES(1,ISYS)%FNAME

  WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(TSFR)%TNAME(1:5)//',', &
     ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)

  !## read the isg-file - once
  IF(IPER.EQ.1)THEN
   IF(.NOT.ISGREAD((/SFNAME/),IBATCH))THEN
    !## stop processing
    CLOSE(IU); CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK(); RETURN
   ENDIF
  ENDIF
  !## translate again to idate as it will be convered to jdate in next subroutine
  GRIDISG%SDATE=UTL_JDATETOIDATE(GRIDISG%SDATE)
  GRIDISG%EDATE=UTL_JDATETOIDATE(GRIDISG%EDATE)-1  !<- edate is equal to sdate if one day is meant
  IF(.NOT.ISG2SFR(BND(1)%NROW,BND(1)%NCOL,PRJNLAY,ILAY,IPER,PRJNPER,NP,JU,GRIDISG,EXFNAME,TOP,BOT,FCT,IMP))EXIT 

 ENDDO
 
 CALL ISGDEAL(1); CALL ISGCLOSEFILES()
 CLOSE(IU); CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK()
 IF(ASSOCIATED(GRIDISG%DELR))DEALLOCATE(GRIDISG%DELR)
 IF(ASSOCIATED(GRIDISG%DELC))DEALLOCATE(GRIDISG%DELC)

 !## no error occured
 IF(IPER.GT.NPER)THEN
  CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',NP)
  PMANAGER_SAVEMF2005_SFR=.TRUE.
 ENDIF
 
 END FUNCTION PMANAGER_SAVEMF2005_SFR
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,IACT,ITOPIC,ICB,CPCKIN,JTOP,IPRT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: IFHBSS=0,NFHBX1=0,NFHBX2=0
 INTEGER,INTENT(IN) :: IBATCH,ITOPIC,ICB,IPRT
 INTEGER,INTENT(IN),DIMENSION(:) :: JTOP
 INTEGER,INTENT(IN) :: IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME,CPCKIN
 REAL(KIND=DP_KIND) :: Z1,Z2,FCT,IMP,CNST,OLFCOND,FHBDATE,F
 CHARACTER(LEN=256) :: SFNAME,EXFNAME
 CHARACTER(LEN=3) :: CPCK
 CHARACTER(LEN=40) :: FRM
 INTEGER :: IU,JU,ILAY,IROW,ICOL,I,J,KTOP,KPER,IPER,NTOP,SCL_D,SCL_U,ICNST,NSYS,ISYS,JSYS,MP,N,IIPER,KKPER, &
    NBDTIM,NHED,NFLW,IFBND,NRCHOP,NEVTOP,NUZTOP,INRECH,INSURF,INEVTR,INEXDP,LPER,NUZF1,NUZF2,NUZF3,NUZF4,   &
    ISYSMF6,NSYSMF6,JLAY,IS1,IS2,NINACTIVE,LANDFLAG,IVERTCON,IINV !,INRLYR
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT,XTMP
 INTEGER(KIND=8) :: ITIME,JTIME
 REAL(KIND=DP_KIND),PARAMETER :: MINKHT=0.0D0
 INTEGER :: JD0,JD1,ISEC0,ISEC1,NUZGAG,IRUNFLG,IEQUAL,ICHECK
 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: JEQUAL,ITMP
 REAL(KIND=DP_KIND) :: DDAY,DSEC,VKS,WP,CD,BH,FC,QFHB,CONC
 CHARACTER(LEN=1) :: VTXT
 CHARACTER(LEN=20) :: COMMENT
 LOGICAL :: LCHKCHD,LEX
 TYPE(IDFOBJ) :: FLXDRL,FLXDRR,FLXPLN,FLXNOPP,FLXSOPP
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_PCK=.TRUE.; RETURN; ENDIF
 
 PMANAGER_SAVEMF2005_PCK=.FALSE.
 
 CPCK=CPCKIN
 
 VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6'

 !## only export if not existing currently
 IF(PBMAN%IEXPORTMF2005.EQ.-1)THEN
  INQUIRE(FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT,EXIST=LEX)
  IF(LEX)THEN; PMANAGER_SAVEMF2005_PCK=.TRUE.; RETURN; ENDIF
 ENDIF

 IF(PBMAN%FLEXD.EQ.1)THEN
  CALL IDFNULLIFY(FLXDRL);      CALL IDFNULLIFY(FLXDRR);     CALL IDFNULLIFY(FLXPLN)
  CALL IDFCOPY(PRJIDF,FLXDRL);  CALL IDFCOPY(PRJIDF,FLXDRR); CALL IDFCOPY(PRJIDF,FLXPLN) 
  CALL IDFNULLIFY(FLXNOPP);     CALL IDFNULLIFY(FLXSOPP)
  CALL IDFCOPY(PRJIDF,FLXNOPP); CALL IDFCOPY(PRJIDF,FLXSOPP)
 
  !## read nopp
  SCL_U=5; SCL_D=0; IINV=0; FCT=TOPICS(TCAP)%STRESS(1)%FILES(10,1)%FCT; IMP=TOPICS(TCAP)%STRESS(1)%FILES(10,1)%IMP
  ICNST=TOPICS(TCAP)%STRESS(1)%FILES(10,1)%ICNST
  IF(ICNST.EQ.1)THEN
   FLXNOPP%X=TOPICS(TCAP)%STRESS(1)%FILES(10,1)%CNST
  ELSE
   IF(.NOT.IDFREADSCALE(TOPICS(TCAP)%STRESS(1)%FILES(10,1)%FNAME,FLXNOPP,SCL_U,SCL_D,1.0D0,0))RETURN
  ENDIF
  CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,FLXNOPP,FCT,IMP,SCL_U)
  !## read sopp
  SCL_U=5; SCL_D=0; IINV=0; FCT=TOPICS(TCAP)%STRESS(1)%FILES(11,1)%FCT; IMP=TOPICS(TCAP)%STRESS(1)%FILES(11,1)%IMP
  ICNST=TOPICS(TCAP)%STRESS(1)%FILES(11,1)%ICNST
  IF(ICNST.EQ.1)THEN
   FLXSOPP%X=TOPICS(TCAP)%STRESS(1)%FILES(11,1)%CNST
  ELSE
   IF(.NOT.IDFREADSCALE(TOPICS(TCAP)%STRESS(1)%FILES(11,1)%FNAME,FLXSOPP,SCL_U,SCL_D,1.0D0,0))RETURN
  ENDIF
  CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,FLXSOPP,FCT,IMP,SCL_U)

  !## read plot number
  SCL_U=7; SCL_D=0; IINV=0; FCT=TOPICS(TCAP)%STRESS(1)%FILES(23,1)%FCT; IMP=TOPICS(TCAP)%STRESS(1)%FILES(23,1)%IMP
  ICNST=TOPICS(TCAP)%STRESS(1)%FILES(23,1)%ICNST
  IF(ICNST.EQ.1)THEN
   FLXPLN%X=TOPICS(TCAP)%STRESS(1)%FILES(23,1)%CNST
  ELSE
   IF(.NOT.IDFREADSCALE(TOPICS(TCAP)%STRESS(1)%FILES(23,1)%FNAME,FLXPLN,SCL_U,SCL_D,1.0D0,0))RETURN
  ENDIF
  CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,FLXPLN,FCT,IMP,SCL_U)

  !## read metaswap level-controlled drainage IPF file (if needed)
  ALLOCATE(ITMP(PRJIDF%NCOL,PRJIDF%NROW))
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(FLXPLN%X(ICOL,IROW).EQ.FLXPLN%NODATA)THEN
    ITMP(ICOL,IROW)=0
   ELSE
    ITMP(ICOL,IROW)=INT(FLXPLN%X(ICOL,IROW))
   ENDIF
  ENDDO; ENDDO
  IF(.NOT.PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD(TOPICS(TCAP)%STRESS(1)%FILES(24,1)%FNAME,IBATCH,ITMP,0))RETURN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   FLXPLN%X(ICOL,IROW)=REAL(ITMP(ICOL,IROW),8)
  ENDDO; ENDDO
  DEALLOCATE(ITMP)
  
  !# read drainage files
  SCL_U=2; SCL_D=1; IINV=0; FCT=TOPICS(TCAP)%STRESS(1)%FILES(25,1)%FCT; IMP=TOPICS(TCAP)%STRESS(1)%FILES(25,1)%IMP
  ICNST=TOPICS(TCAP)%STRESS(1)%FILES(25,1)%ICNST
  IF(ICNST.EQ.1)THEN
   FLXDRL%X=TOPICS(TCAP)%STRESS(1)%FILES(25,1)%CNST
  ELSE
   IF(.NOT.IDFREADSCALE(TOPICS(TCAP)%STRESS(1)%FILES(25,1)%FNAME,FLXDRL,SCL_U,SCL_D,1.0D0,0))RETURN
  ENDIF
  CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,FLXDRL,FCT,IMP,SCL_U)

  SCL_U=6; SCL_D=1; IINV=0; FCT=TOPICS(TCAP)%STRESS(1)%FILES(26,1)%FCT; IMP=TOPICS(TCAP)%STRESS(1)%FILES(26,1)%IMP
  ICNST=TOPICS(TCAP)%STRESS(1)%FILES(26,1)%ICNST
  IF(ICNST.EQ.1)THEN
   FLXDRR%X=TOPICS(TCAP)%STRESS(1)%FILES(26,1)%CNST
  ELSE
   IF(.NOT.IDFREADSCALE(TOPICS(TCAP)%STRESS(1)%FILES(26,1)%FNAME,FLXDRR,SCL_U,SCL_D,1.0D0,0))RETURN
  ENDIF
  CALL PMANAGER_SAVEMF2005_FCTIMP(IINV,ICNST,FLXDRR,FCT,IMP,SCL_U)

  !## clean drainage based upon plot number
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL

   !## no steering location present for this plotnumber
   IF(FLXPLN%X(ICOL,IROW).NE.FLXPLN%NODATA)THEN
    IF(FLXPLN%X(ICOL,IROW).GT.SIZE(IPFFLX))FLXPLN%X(ICOL,IROW)=FLXPLN%NODATA
   ENDIF  
   IF(FLXPLN%X(ICOL,IROW).EQ.FLXPLN%NODATA.OR.FLXPLN%X(ICOL,IROW).EQ.0.0D0)THEN
    FLXDRL%X(ICOL,IROW)=FLXDRL%NODATA; FLXDRR%X(ICOL,IROW)=FLXDRR%NODATA
   ENDIF
   IF(FLXDRL%X(ICOL,IROW).EQ.FLXDRL%NODATA)FLXDRR%X(ICOL,IROW)=FLXDRR%NODATA
   IF(FLXDRR%X(ICOL,IROW).EQ.FLXDRR%NODATA)FLXDRL%X(ICOL,IROW)=FLXDRL%NODATA
  ENDDO; ENDDO
  IF(ALLOCATED(IPFFLX))DEALLOCATE(IPFFLX)
  
 ENDIF 
  
 !## in case MF6 is used, apply systems per package
 IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(ITOPIC,2)
 ELSE
  NSYSMF6=1
 ENDIF
 
 NINACTIVE=0
 
 DO ISYSMF6=1,NSYSMF6
 
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...')
  IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//VTXT//'...'

  IU=UTL_GETUNIT()
  IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ELSE
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  IF(IU.EQ.0)RETURN

  IF(PBMAN%IFORMAT.EQ.3)THEN
   WRITE(IU,'(A)') '# '//CPCK//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'  
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
 !  WRITE(IU,'(A)') ' AUXMULTNAME <auxmultname>'
   !## use numerical decline of drainage in case of unconfinedness
   IF(ITOPIC.EQ.TDRN.AND.PBMAN%DDRN.NE.0.0)THEN
    WRITE(IU,'(A)') ' AUXILIARY DDRN'
    WRITE(IU,'(A)') ' AUXDEPTHNAME DDRN'
   ENDIF
!   IF(ITOPIC.EQ.TRCH)THEN
!    WRITE(IU,'(A)') ' FIXED_CELL' ! (EVT/RCH NIET VERPLAATSEN NAAR ACTIVE CEL)
!   ENDIF
 !  WRITE(IU,'(A)') ' BOUNDNAMES'
 !  WRITE(IU,'(A)') ' PRINT_INPUT'
 !  WRITE(IU,'(A)') ' PRINT_FLOWS'
  
   IF(ASSOCIATED(PBMAN%ISAVE(ITOPIC)%ILAY))WRITE(IU,'(1X,A)') 'SAVE_FLOWS'
  
 !  WRITE(IU,'(A)') ' TS6 FILEIN <ts6_filename>'
 !  WRITE(IU,'(A)') ' OBS6 FILEIN <obs6_filename>'
 !  WRITE(IU,'(A)') ' MOVER'
 !  WRITE(IU,'(A)')    SURF_RATE_SPECIFIED (EVT)
   IF(ITOPIC.EQ.TUZF)THEN
    WRITE(IU,'(A)') ' UNSAT_ETWC'  !## simulate ET from unsaturated zone
    WRITE(IU,'(A)') ' SIMULATE_ET' !## simluate ET from groundwater
    WRITE(IU,'(A)') ' LINEAR_GWET' !## apply linear ET similar to MF2005 
   ENDIF
   WRITE(IU,'(A)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#General Dimensions'  
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   IF(ITOPIC.EQ.TUZF)THEN
    WRITE(IU,'(A)') 'NUZFCELLS NaN1#'
    WRITE(IU,'(A)') 'NTRAILWAVES 7'
    WRITE(IU,'(A)') 'NWAVESETS 40'
   ELSE
    WRITE(IU,'(A)') 'MAXBOUND NaN1#'
   ENDIF
   WRITE(IU,'(A)') 'END DIMENSIONS'

   
  ENDIF
 
  !## write header of file
  SELECT CASE (ITOPIC)
   !## uzf
 !NUZTOP=1 !## recharge specified to top cell
   CASE (TUZF); NUZGAG=0; IRUNFLG=0; NUZTOP=1  !PBMAN%NLOGLOC
    IF(PBMAN%IFORMAT.NE.3)THEN
     !## define initial water content
     IF(SIM(1)%DELT.GT.0.0D0)WRITE(IU,'(A)') 'SPECIFYTHTI'
     LINE='NaN1#,2,'//TRIM(ITOS(IRUNFLG))//',1,'//TRIM(ITOS(-IUZFCB1))//',0,20,50,'//TRIM(ITOS(NUZGAG))//',0.5'
     IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
    ENDIF  
 !IUZFOPT=2 !## permeabiliy specified in lpf
 !irunflg=0 !## water discharge from top removed form the model (usage of SFR/LAK needed)
 !ietflg=1 !## et simulated
 !iuzfcb1=59 !## writing groundwater recharge (see nam-file)
 !iuzfcb2=0 !## alternative output format
 !NTRAIL2=10  !## trailing waves
 !nsets2=20  !## number of wave sets
 !nuzgag=1 !## number of cells to gage
 !surfdep=0.5 !## average undulation depth (is stabieler om iets meer te pakken)
 !WRITE(iu,'(9I3,f5.1)') NUZTOP,IUZFOPT,irunflg,ietflg,iuzfcb1,iuzfcb2,NTRAIL2,nsets2,nuzgag,surfdep

   !## drn
   CASE (TDRN)
    IF(PBMAN%ICONCHK.EQ.0)THEN
     IF(PBMAN%IFORMAT.EQ.6)THEN
      LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT AUX ISUB'
     ELSE
      LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT AUX ISUB DSUBSYS ISUB'
     ENDIF
    ELSE
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT AUX ISUB DSUBSYS ISUB ICONCHK'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)

 !## AUX IC ICHONCHK IC
   !## riv
   CASE (TRIV)
    IF(PBMAN%INFFCT.EQ.1)THEN
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT'
    ELSE
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT AUX RFCT'
    ENDIF
    IF(SIZE(JTOP).EQ.5)THEN
     IF(WQ%VDF%MTDNCONC.EQ.0)LINE=TRIM(LINE)//' AUX RIVDEN'
     IF(WQ%VDF%MTDNCONC.EQ.1)LINE=TRIM(LINE)//' RIVSSMDENS AUX RIVDEN'
    ENDIF
    IF(PBMAN%INFFCT.EQ.1)THEN
     IF(PBMAN%IFORMAT.EQ.6)THEN
      LINE=TRIM(LINE)//' AUX ISUB'
     ELSE
      LINE=TRIM(LINE)//' AUX ISUB RSUBSYS ISUB'
     ENDIF
    ELSE
     LINE=TRIM(LINE)//' AUX ISUB RFACT RFCT RSUBSYS ISUB'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
 !## IFVDL SFT RCNC
   !## evt
   CASE (TEVT); NEVTOP=1; LINE='NaN1#,'//TRIM(ITOS(ICB))
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
 !## NEVTOP moet twee worden voor optie laag = -1
   !## ghb
   CASE (TGHB)
    LINE='NaN1#,'//TRIM(ITOS(ICB))
    IF(SIZE(JTOP).EQ.3)THEN
     IF(WQ%VDF%MTDNCONC.EQ.0)LINE=TRIM(LINE)//' NOPRINT AUX GHBDENS'
     IF(WQ%VDF%MTDNCONC.EQ.1)LINE=TRIM(LINE)//' NOPRINT GHBSSMDENS AUX GHBDEN'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.6)THEN
     LINE=TRIM(LINE)//' AUX ISUB'
    ELSE
     LINE=TRIM(LINE)//' AUX ISUB GSUBSYS ISUB'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
   !## rch
   CASE (TRCH); NRCHOP=1; LINE='NaN1#,'//TRIM(ITOS(ICB))
   IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
 !## NaN1 moet 3 worden voor optie laag = -1
   !## olf
   CASE (TOLF)
    CPCK='OLF'; IF(TOPICS(TDRN)%IACT_MODEL.EQ.0)CPCK='DRN';
    IF(PBMAN%ICONCHK.EQ.0)THEN
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' NOPRINT AUX ISUB DSUBSYS ISUB'
    ELSE
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB DSUBSYS ISUB ICONCHK'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
   !## chd
   CASE (TCHD)
    LINE='NaN1#'
!    IF(SIZE(JTOP).EQ.2)LINE=TRIM(LINE)//' CHDSSMDENS'
    LINE=TRIM(LINE)//' NOPRINT NEGBND'
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
   !## fhb package
   CASE(TFHB)
    !## check number of boundary type conditions - for fhb package
    NHED=0; NFLW=0
    DO ILAY=1,PRJNLAY
     DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
      IF(BND(ILAY)%X(ICOL,IROW).EQ.-2.0)NHED=NHED+1
      IF(BND(ILAY)%X(ICOL,IROW).EQ. 2.0)NFLW=NFLW+1
     ENDDO; ENDDO
    ENDDO

    NBDTIM=PRJNPER 

    !## look for number of stress-periods for boundary package
    ALLOCATE(FHBNBDTIM(NBDTIM)); FHBNBDTIM=0.0D0

    !## get first stress-period
    NBDTIM=0; DO I=1,PRJNPER; IF(SIM(I)%DELT.NE.0.0D0)EXIT; ENDDO
    !## add steady-state
    IF(I.NE.1)NBDTIM=1

    !## transient periods still available
    IF(I.LE.PRJNPER)THEN
     JD0  =JD(SIM(I)%IYR,SIM(I)%IMH,SIM(I)%IDY)
     ISEC0=   SIM(I)%IHR*3600+SIM(I)%IMT*60+SIM(I)%ISC
     ISEC0=   86400-ISEC0
     DO IPER=1,PRJNPER
      !## get appropriate stress-period to store in runfile   
      KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
      IF(KPER.LE.0)CYCLE

      J=KPER
      !## not transient definition
      IF(TOPICS(ITOPIC)%STRESS(J)%IYR+TOPICS(ITOPIC)%STRESS(J)%IMH+TOPICS(ITOPIC)%STRESS(J)%IDY+ &
         TOPICS(ITOPIC)%STRESS(J)%IHR+TOPICS(ITOPIC)%STRESS(J)%IMT+TOPICS(ITOPIC)%STRESS(J)%ISC.LE.0)CYCLE
      !## get date for current period
      JD1   =JD(TOPICS(ITOPIC)%STRESS(J)%IYR,TOPICS(ITOPIC)%STRESS(J)%IMH,TOPICS(ITOPIC)%STRESS(J)%IDY)
      ISEC1 =TOPICS(ITOPIC)%STRESS(J)%IHR*3600+TOPICS(ITOPIC)%STRESS(J)%IMT*60+TOPICS(ITOPIC)%STRESS(J)%ISC
      DDAY  =JD1-JD0
      IF(DDAY.EQ.0.0D0)THEN
       DSEC=ISEC1
      ELSE
       DSEC=ISEC0+ISEC1
      ENDIF
      NBDTIM=NBDTIM+1
      FHBNBDTIM(NBDTIM)=DDAY+REAL(DSEC,8)/86400.0D0+SIM(IPER)%DELT
     ENDDO
    ENDIF
    !## make sure there are no negative dates
    DO I=1,NBDTIM; FHBNBDTIM(I)=MAX(FHBNBDTIM(I),0.0D0); ENDDO
    !## if first timestep is a steady-state set fhbnbdtim(2)=1.0d0, if not modflow can not cope with that
!    !## is start of transient period
!    IF(SIM(1)%DELT.EQ.0.0D0.AND.SIZE(FHBNBDTIM).GE.2)FHBNBDTIM(2)=1.0D0
    
    LINE=TRIM(ITOS(NBDTIM))//','//TRIM(ITOS(NFLW))  //','//TRIM(ITOS(NHED))//','//TRIM(ITOS(IFHBSS))//','// &
         TRIM(ITOS(IFHBCB))//','//TRIM(ITOS(NFHBX1))//','//TRIM(ITOS(NFHBX2))
    WRITE(IU,'(A)') TRIM(LINE)
    LINE=TRIM(ITOS(IFHBUN))//',1.0,0'
    WRITE(IU,'(A)') TRIM(LINE)
    WRITE(IU,*) (FHBNBDTIM(I),I=1,NBDTIM)
    !## allocate for fhb package
    IF(NHED.GT.0)ALLOCATE(FHBHED(NHED,NBDTIM))
    IF(NFLW.GT.0)ALLOCATE(FHBFLW(NFLW,NBDTIM))
  END SELECT
 
  !## fill tlp for each modellayer
  ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))
 
  !## see whether information is equal to previous timestep - only for rch and evt
  LPER=0

  ALLOCATE(NP_IPER(0:PRJNPER)); NP_IPER=0

  !## maximum number of input per simulation
  MP=0; NBDTIM=0
  DO IPER=1,PRJNPER

   !## number of input per stressperiod
   NP_IPER(IPER)=0
  
   !## get appropriate stress-period to store in runfile   
   KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)

   !## output
   WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
   IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  

   !## reuse previous timestep
   IF(KPER.LE.0)THEN
    SELECT CASE (ITOPIC)
     !## uzf
     CASE (TUZF)
      IF(IPER.EQ.1)THEN
       CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to start the first stress-period with'//CHAR(13)// &
        'a definition for the UZF package','Error'); RETURN
      ELSE
       IF(PBMAN%IFORMAT.NE.3)THEN
        DO I=1,4; WRITE(IU,'(A)') '-1';  ENDDO
       ENDIF
      ENDIF
     !## evt 
     CASE (TEVT) 
      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       IF(IPER.EQ.1)THEN
        WRITE(IU,'(A)') '0,0,0'
        DO I=1,3; WRITE(IU,'(A)') 'CONSTANT 0.000000E+00'; ENDDO
       ELSE; WRITE(IU,'(A)') '-1,-1,-1';  ENDIF
      ENDIF
     !## rch
     CASE (TRCH) 
      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       IF(IPER.EQ.1)THEN
!        IF(NRCHOP.EQ.2)THEN
!         WRITE(IU,'(2I10)') 0,0; WRITE(IU,'(A)') 'CONSTANT 0.000000E+00'; WRITE(IU,'(A)') 'CONSTANT 1'
!        ELSE
        WRITE(IU,'(I10)') 0; WRITE(IU,'(A)') 'CONSTANT 0.000000E+00'
!        ENDIF       
       ELSE
!        IF(NRCHOP.EQ.2)THEN
!         WRITE(IU,'(2I10)') -1,-1
!        ELSE
        WRITE(IU,'(I10)') -1
!        ENDIF
       ENDIF
      ENDIF
     !##  wel,drn,riv,ghb,chd,olf
     CASE (TDRN,TRIV,TGHB,TCHD,TOLF,TISG)
      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
       ELSE; WRITE(IU,'(I10)') -1; ENDIF
      ENDIF
     !## fhb- skip
     CASE (TFHB)
     CASE DEFAULT
      WRITE(*,'(/A)') 'CANNOT COME HERE: ERROR PMANAGER_SAVEMF2005_PCK - WRITING HEADER'
      WRITE(*,'(A,I10)') 'ITOPIC=',ITOPIC
      WRITE(*,'(A)') TRIM(TOPICS(ITOPIC)%TNAME)
      PAUSE; STOP
    END SELECT  
    !## goto next timestep
    CYCLE
   ENDIF

   !## allocate memory for packages
   NTOP=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)
   SELECT CASE (ITOPIC)
    CASE (TRIV,TDRN,TGHB,TCHD,TFHB)
     IF(NTOP.NE.SIZE(JTOP))THEN
      IF(PBMAN%IFORMAT.NE.6)THEN
       IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'The number of entries '//TRIM(ITOS(NTOP))//' is not equal to the number of entries allowed ('//TRIM(ITOS(SIZE(JTOP)))//').'//CHAR(13)// &
        'You might remove these additional entries from the current package '//TRIM(TOPICS(ITOPIC)%TNAME),'Information')
       IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'The number of entries '//TRIM(ITOS(NTOP))//' is not equal to the number of entries allowed ('//TRIM(ITOS(SIZE(JTOP)))//'). '// &
          'You might remove these additional entries from the current package '//TRIM(TOPICS(ITOPIC)%TNAME)
       RETURN
      ELSE
       NTOP=SIZE(JTOP)
      ENDIF
     ENDIF
   END SELECT
   
   !## used for writing and including the tlp-vector
   IF(ALLOCATED(XTMP))DEALLOCATE(XTMP); ALLOCATE(XTMP(NTOP)); XTMP=0.0D0
  
   SELECT CASE (ITOPIC)
    CASE (TEVT,TRCH)
     !## no restrictions for MF6
     IF(NSYS.GT.1.AND.PBMAN%IFORMAT.NE.3)THEN
      IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'You cannot apply more than a single layer to the package '// &
        TRIM(TOPICS(ITOPIC)%TNAME)//'.','Information')
      IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'You cannot apply more than a single layer to the package '//TRIM(TOPICS(ITOPIC)%TNAME)//'.'
      RETURN
     ENDIF
   END SELECT
  
   SELECT CASE (ITOPIC)
    CASE (TOLF,TCHD); N=NTOP+1
    CASE (TRIV)
     N=NTOP; IF(PBMAN%INFFCT.EQ.1)N=N-1
    CASE DEFAULT; N=NTOP
   END SELECT
  
   IF(ITOPIC.EQ.TDRN.AND.PBMAN%IFORMAT.EQ.3.AND.PBMAN%DDRN.NE.0.0)THEN
    WRITE(FRM,'(A10,I2.2,A14)') '(3(I5,1X),',N+1,'(G15.7,1X),I5)'
   ELSE
    WRITE(FRM,'(A10,I2.2,A14)') '(3(I5,1X),',N,'(G15.7,1X),I5)'
   ENDIF
   
   IF(.NOT.ALLOCATED(PCK))THEN
    CALL PMANAGER_SAVEMF2005_ALLOCATEPCK(NTOP,ITOPIC)
   ENDIF
   
   NHED=0; NFLW=0; NBDTIM=NBDTIM+1

   IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)THEN
    !## export current system only
    IS1=MIN(NSYS,ISYSMF6); IS2=IS1
   ELSE
    !## export all systems
    IS1=1; IS2=NSYS
   ENDIF

   !## see whether duplicate of definitions happened with current systems, not for wel/isg
   SELECT CASE (ITOPIC)
    !## drn,riv,ghb,chd,olf
    CASE (TDRN,TRIV,TGHB,TCHD,TOLF) 

     ALLOCATE(JEQUAL(NSYS,NTOP))

     !## search previous entries
     DO IIPER=1,IPER-1

      JEQUAL=0

      !## get appropriate stress-period to store in runfile   
      KKPER=PMANAGER_GETCURRENTIPER(IIPER,ITOPIC,ITIME,JTIME)
      IF(KKPER.LE.0)CYCLE
     
      DO ISYS=IS1,IS2 
       !## number of subtopics
       DO KTOP=1,NTOP
        ICNST =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ICNST 
        CNST  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%CNST  
        FCT   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FCT   
        IMP   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%IMP   
        ILAY  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ILAY  
        SFNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FNAME 
       
        !## only whenever number of systems are equal
        IF(NSYS.EQ.SIZE(TOPICS(ITOPIC)%STRESS(KKPER)%FILES,2))THEN
         IF(ICNST.EQ. TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%ICNST.AND. &
            CNST .EQ. TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%CNST.AND.  &
            FCT.EQ.   TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%FCT.AND.   &
            IMP .EQ.  TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%IMP.AND.   &
            ILAY.EQ.  TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%ILAY.AND.  &
            SFNAME.EQ.TOPICS(ITOPIC)%STRESS(KKPER)%FILES(KTOP,ISYS)%FNAME)THEN
          JEQUAL(ISYS,KTOP)=IIPER
         ENDIF
        ENDIF
       ENDDO
      ENDDO
     
      !## there is a previous definition of this package exported allready and can be reused
      IF(MINVAL(JEQUAL).EQ.MAXVAL(JEQUAL).AND.MINVAL(JEQUAL).NE.0)THEN
       IF(NP_IPER(IIPER).GT.0)THEN
        !## create subfolders
        IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
         EXFNAME=TRIM(DIR)//'\'//CPCK//'7'//'\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
        ELSE
         IF(PBMAN%SSYSTEM.EQ.0)THEN
          EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
         ELSE
          EXFNAME=TRIM(DIR)//'\'//CPCK//'6'//'\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
         ENDIF
        ENDIF
        SFNAME=EXFNAME; DO I=1,3; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
        I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
        IF(PBMAN%IFORMAT.NE.3)THEN
         LINE=TRIM(ITOS(NP_IPER(IIPER))); WRITE(IU,'(A)') TRIM(LINE)
         WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
        ENDIF
        NP_IPER(IPER)=NP_IPER(IIPER)       
       ENDIF
       EXIT
      ENDIF

     ENDDO
     IF(ALLOCATED(JEQUAL))DEALLOCATE(JEQUAL)

   END SELECT
  
   !## next timestep
   IF(NP_IPER(IPER).GT.0)CYCLE
  
   !## open external file (not for rch/evt)
   IF(PBMAN%IFORMAT.GE.2)THEN
    JU=0
    SELECT CASE (ITOPIC)
     CASE (TDRN,TRIV,TGHB,TOLF,TCHD,TISG)
      !## create subfolders
      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)
       EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
      ELSE
       IF(PBMAN%SSYSTEM.EQ.0)THEN
        CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6)))
        EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
       ELSE
        CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6')
        EXFNAME=TRIM(DIR)//'\'//CPCK//'6\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
       ENDIF
      ENDIF
      JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
     !## rch/evt for mf6
     CASE (TEVT,TRCH)
      IF(PBMAN%IFORMAT.EQ.3)THEN
       !## create subfolders
       IF(PBMAN%SSYSTEM.EQ.0)THEN
        CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6)))
        EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
       ELSE
        CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'6')
        EXFNAME=TRIM(DIR)//'\'//CPCK//'6\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
       ENDIF
       JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
      ENDIF
    END SELECT
!    IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     
   ELSE
    JU=IU
   ENDIF

   !## number of systems
   DO ISYS=IS1,IS2

    !## number of subtopics
    DO KTOP=1,NTOP

     ICNST =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ICNST 
     CNST  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%CNST  
     FCT   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FCT   
     IMP   =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%IMP   
     ILAY  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ILAY  
     SFNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FNAME 

     !## quit with this system as it is outside the current set of nlay
     IF(ILAY.GT.PRJNLAY)EXIT
     
     !## ilay equal zero not possible for rch and evt
     IF(ITOPIC.EQ.TEVT.OR.(ITOPIC.EQ.TRCH.AND.NTOP.EQ.1))THEN
      IF(ILAY.EQ.0)THEN
       IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'You cannot apply a layer code of zero for RCH or EVT','Error')
       IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'You cannot apply a layer code of zero for RCH or EVT'
       RETURN
      ENDIF
     ENDIF

     !## check to see whether equal to previous timestep
     IEQUAL=1
     SELECT CASE (ITOPIC)
      !## uzf,evt,rch
      CASE (TUZF,TEVT,TRCH)
       IF(LPER.GT.0)THEN
        !## only whenever number of systems are equal
        IF(NSYS.EQ.SIZE(TOPICS(ITOPIC)%STRESS(LPER)%FILES,2))THEN
         IF(ICNST.EQ. TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%ICNST.AND. &
            CNST .EQ. TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%CNST.AND.  &
            FCT.EQ.   TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%FCT.AND.   &
            IMP .EQ.  TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%IMP.AND.   &
            ILAY.EQ.  TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%ILAY.AND.  &
            SFNAME.EQ.TOPICS(ITOPIC)%STRESS(LPER)%FILES(KTOP,ISYS)%FNAME)IEQUAL=-1
        ENDIF
       ENDIF
     END SELECT
    
     WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
        ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)
    
     SELECT CASE (ITOPIC)
      !## uzf
      CASE (TUZF)
       SELECT CASE (KTOP)
        CASE (1);   SCL_D=0; SCL_U=7 !## boundary
        CASE (2);   SCL_D=0; SCL_U=7 !## brook-corey
        CASE (3:4); SCL_D=0; SCL_U=2 !## thts/thhi
        CASE (5);   SCL_D=0; SCL_U=2; NUZF1=IEQUAL !## inf.
        CASE (6);   SCL_D=0; SCL_U=2; NUZF2=IEQUAL !## eva
        CASE (7);   SCL_D=0; SCL_U=2; NUZF3=IEQUAL !## exd
        CASE (8);   SCL_D=0; SCL_U=2; NUZF4=IEQUAL !## ewc
       END SELECT
       !## skip uzf package info for coming stress-periods
       IF(KTOP.LE.4.AND.IPER.GT.1)CYCLE
      !## evt
      CASE (TEVT) 
       SCL_D=1
       !## check to see whether equal to previous timestep
       SELECT CASE (KTOP)
        CASE (1); INEVTR=IEQUAL; SCL_U=16 !## artithmetic mean (rch/evt) discarding nodata
        CASE (2); INSURF=IEQUAL; SCL_U=2
        CASE (3); INEXDP=IEQUAL; SCL_U=2
       END SELECT
      !## rch
      CASE (TRCH)
       INRECH=0 !; INRLYR=0
       SELECT CASE (KTOP)
        CASE (1); SCL_D=1; SCL_U=16; INRECH=IEQUAL   !## arithmetic mean (rch/evt) discarding nodata
!        CASE (2); SCL_D=0; SCL_U=7;  INRLYR=IEQUAL   !## no interpolation in downscaling and take majority in upscaling
        CASE DEFAULT; SCL_D=1; SCL_U=2
       END SELECT
!       !## equal from previous timestep
!       INRECH=IEQUAL
      !## drn,riv,ghb
      CASE (TDRN,TRIV,TGHB) 
       IF(KTOP.EQ.1)THEN; SCL_D=0; SCL_U=5; ENDIF
       IF(KTOP.NE.1)THEN; SCL_D=0; SCL_U=2; ENDIF
      !## chd,olf
      CASE (TCHD,TOLF) 
       SCL_D=1; SCL_U=2
      !## fhb
      CASE (TFHB)
       SCL_D=1
       IF(NTOP.EQ.2)THEN
        IF(KTOP.EQ.1)SCL_U=5 !## q - sum (divide if cell is smaller)
        IF(KTOP.EQ.2)SCL_U=2 !## h - average
       ELSEIF(NTOP.EQ.3)THEN
        IF(KTOP.LE.2)SCL_U=5 !## q - sum (divide if cell is smaller)
        IF(KTOP.EQ.3)SCL_U=2 !## h - average
       ENDIF
      CASE DEFAULT 
       WRITE(*,'(/A)') 'CANNOT COME HERE: ERROR PMANAGER_SAVEMF2005_PCK - SETTING SCALING FACTORS'
       WRITE(*,'(A,I10)') 'ITOPIC=',ITOPIC
       WRITE(*,'(A)') TRIM(TOPICS(ITOPIC)%TNAME)
       PAUSE; STOP
     END SELECT

     PCK(KTOP)%ILAY=ILAY
   
     !## skip this one - no to be read
     IF(IEQUAL.EQ.-1)CYCLE

     !## constant value
     IF(ICNST.EQ.1)THEN
      PCK(KTOP)%X=CNST
     !## read/clip/scale idf file
     ELSEIF(TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ICNST.EQ.2)THEN
      PCK(KTOP)%FNAME=SFNAME
      IF(.NOT.IDFREADSCALE(PCK(KTOP)%FNAME,PCK(KTOP),SCL_U,SCL_D,1.0D0,0))RETURN
     ENDIF

     !## no checking for inactive cells
     ICHECK=1
     !## rch/evt mm/day -> m/day
     SELECT CASE (ITOPIC)
      !## uzf
      CASE (TUZF)
       IF(KTOP.EQ.5.OR.KTOP.EQ.6)FCT=FCT*0.001D0
       IF(ILAY.LE.0)NUZTOP=3
       !## not checking for inactive cells
       ICHECK=0
      !## evt
      CASE (TEVT)
       IF(KTOP.EQ.1)THEN
        FCT=FCT*0.001D0
        IMP=IMP*0.001D0
       ENDIF
       IF(ILAY.LT.0)NEVTOP=3
       !## checking for inactive cells
       ICHECK=1; IF(ILAY.GT.0)ICHECK=0
      !## rch
      CASE (TRCH)
       IF(KTOP.EQ.1)THEN
        FCT=FCT*0.001D0
        IMP=IMP*0.001D0
       ENDIF
!       IF(ILAY.EQ.0)NRCHOP=2 !## assigned to predefined cell
       IF(ILAY.LT.0)NRCHOP=3 !## assigned to first active cell
       !## checking for inactive cells for nrchop=1 and nrchop=2
       ICHECK=1; IF(ILAY.GE.0)ICHECK=0
     END SELECT
    
     CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,PCK(KTOP),FCT,IMP,SCL_D)
     CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,PCK(KTOP),ICHECK,ITOPIC) 

    ENDDO

    SELECT CASE (ITOPIC)
     !## uzf
     CASE (TUZF)
       IF(IPER.EQ.1)THEN

        !## make sure value for uzbnd is zero for constant head and inactive cells - only if NUZTOP.eq.1
        IF(NUZTOP.EQ.1)THEN
         DO IROW=1,PCK(1)%NROW; DO ICOL=1,PCK(1)%NCOL
          IF(BND(1)%X(ICOL,IROW).LE.0)PCK(1)%X(ICOL,IROW)=0.0D0
         ENDDO; ENDDO
        !## make sure entered uzbnd with top layer is equal to the top elevation - otherwise solve the conflict
        ELSEIF(NUZTOP.EQ.3)THEN
         DO IROW=1,PCK(1)%NROW; DO ICOL=1,PCK(1)%NCOL
          !## assigned layer
          I=PCK(1)%X(ICOL,IROW)
          !## skip this one as it is an inactive cell
          IF(I.LE.0)CYCLE
          !## search first active layer
          DO ILAY=1,PRJNLAY; IF(BND(ILAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO
          !## overrule for the first active layer
          IF(ILAY.LE.PRJNLAY)THEN
           IF(PCK(1)%X(ICOL,IROW).LT.0)PCK(1)%X(ICOL,IROW)=SIGN(ILAY,I)
           IF(ILAY.EQ.1)PCK(1)%X(ICOL,IROW)=1.0D0
          ENDIF
         ENDDO; ENDDO       
        ENDIF
        IF(PBMAN%IFORMAT.NE.3)THEN
         !## areal extent of uz flow
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_UZBND_T'//TRIM(ITOS(IPER))//'.ARR',PCK(1),IU,    0,1))RETURN
         !## brooks-corey epsilon
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_EPS_T'//TRIM(ITOS(IPER))//  '.ARR',PCK(2),IU,IFBND,0))RETURN
         !## thts saturated water content
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_THTS_T'//TRIM(ITOS(IPER))// '.ARR',PCK(3),IU,IFBND,0))RETURN
         !## skip initial water content if steady-state
         IF(SIM(IPER)%DELT.GT.0.0D0)THEN
          IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_THTI_T'//TRIM(ITOS(IPER))// '.ARR',PCK(4),IU,IFBND,0))RETURN
         ENDIF
        ELSE
         LANDFLAG=1; IVERTCON=0  !!! IVERTCON  KUN JE DUS UZF DELEN AAN ELKAAR KOPPELEN ....
         WRITE(IU,'(/A)') 'BEGIN PACKAGEDATA'
         NP_IPER(0)=0; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
          IF(PCK(1)%X(ICOL,IROW).GT.0)THEN !KHV(1)%X(ICOL,IROW)
           VKS=(KDW(1)%X(ICOL,IROW)/KVA(1)%X(ICOL,IROW))/(TOP(1)%X(ICOL,IROW)-BOT(1)%X(ICOL,IROW))
           NP_IPER(0)=NP_IPER(0)+1                                                      !## thtr             !## THTS             !## THTI           !## EPS
           WRITE(IU,'(6I5,6F15.7)') NP_IPER(0),1,IROW,ICOL,LANDFLAG,IVERTCON,0.5,VKS,PCK(8)%X(ICOL,IROW),PCK(3)%X(ICOL,IROW),PCK(4)%X(ICOL,IROW),PCK(2)%X(ICOL,IROW)           
          ENDIF
         ENDDO; ENDDO
         WRITE(IU,'(A)') 'END PACKAGEDATA'
         CALL PMANAGER_SAVEEXAMINE(PCK(1),'UZBND_L',1); CALL PMANAGER_SAVEEXAMINE(PCK(2),'EPS_L',1)
         CALL PMANAGER_SAVEEXAMINE(PCK(3),'THTS_L',1);  CALL PMANAGER_SAVEEXAMINE(PCK(4),'THTI_L',1)
         CALL PMANAGER_SAVEEXAMINE(PCK(8),'THTR_L',1)
        ENDIF
        
 !       !## log uzf locations       
 !       DO I=1,PBMAN%NLOGLOC
 !        WRITE(IU,'(4(I10,1X))') PBMAN%ILOC(I,1),PBMAN%ILOC(I,2),99+I,1
 !       ENDDO

       ENDIF
       IF(PBMAN%IFORMAT.EQ.3)THEN
        WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
        NP_IPER(IPER)=0; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
         IF(PCK(1)%X(ICOL,IROW).GT.0)THEN 
          NP_IPER(IPER)=NP_IPER(IPER)+1           !## finf            !## pet              !## exdp            !## extwc     !## ha,root,rootact
          WRITE(IU,'(I5,7F15.7)') NP_IPER(IPER),PCK(5)%X(ICOL,IROW),PCK(6)%X(ICOL,IROW),PCK(7)%X(ICOL,IROW),PCK(8)%X(ICOL,IROW),0.0,0.0,0.0
         ENDIF
        ENDDO; ENDDO
        CALL PMANAGER_SAVEEXAMINE(PCK(5),'FINF_S',IPER); CALL PMANAGER_SAVEEXAMINE(PCK(6),'PER_S',IPER)
        CALL PMANAGER_SAVEEXAMINE(PCK(7),'EXDP_S',IPER); CALL PMANAGER_SAVEEXAMINE(PCK(8),'EXTWC_S',IPER)
        WRITE(IU,'(A)') 'END PERIOD'
       ELSE
        LINE=TRIM(ITOS(NUZF1)); WRITE(IU,'(A)') TRIM(LINE)
        IF(NUZF1.EQ.1)THEN
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_FINF_T'//TRIM(ITOS(IPER))// '.ARR',PCK(5),IU,IFBND,0))RETURN
        ENDIF
        LINE=TRIM(ITOS(NUZF2)); WRITE(IU,'(A)') TRIM(LINE)
        IF(NUZF2.EQ.1)THEN
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_PET_T'//TRIM(ITOS(IPER))//  '.ARR',PCK(6),IU,IFBND,0))RETURN
        ENDIF
        LINE=TRIM(ITOS(NUZF3)); WRITE(IU,'(A)') TRIM(LINE)
        IF(NUZF3.EQ.1)THEN
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_EXDP_T'//TRIM(ITOS(IPER))// '.ARR',PCK(7),IU,IFBND,0))RETURN
        ENDIF
        LINE=TRIM(ITOS(NUZF4)); WRITE(IU,'(A)') TRIM(LINE)
        IF(NUZF4.EQ.1)THEN
         !## make sure this is always larger than residual water content
         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_EXTWC_T'//TRIM(ITOS(IPER))//'.ARR',PCK(8),IU,IFBND,0))RETURN
        ENDIF
       ENDIF

      !## rch
     CASE (TRCH)

      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       LINE=TRIM(ITOS(INRECH))
       !IF(NRCHOP.EQ.2)LINE=TRIM(LINE)//' '//TRIM(ITOS(ABS(INRLYR))); 
       WRITE(IU,'(A)') TRIM(LINE)
       !## do not check with ibound
       IFBND=0; IF(ILAY.GT.0)IFBND=1
       IF(INRECH.EQ.1)THEN
        IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR',PCK(1),IU,IFBND,0))RETURN
       ENDIF
!       IF(NRCHOP.EQ.2)THEN
!        IF(ABS(INRLYR).EQ.1)THEN
!         IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_LAYER_T'//TRIM(ITOS(IPER))//'.ARR',PCK(2),IU,IFBND,1))RETURN
!        ENDIF
!       ENDIF
      !## modflow6
      ELSEIF(PBMAN%IFORMAT.EQ.3)THEN
       IF(INRECH.EQ.1)THEN
        DO IROW=1,PCK(1)%NROW; DO ICOL=1,PCK(1)%NCOL
!         IF(ABS(INRLYR).EQ.1)THEN
!          ILAY=PCK(2)%X(ICOL,IROW); TLP(ILAY)=1.0D0
!         ELSE
         !## find uppermost layer (aquifer k>1)
         TLP=0.0D0
         IF(PCK(1)%ILAY.EQ.-1)THEN
          DO ILAY=1,SIZE(PBMAN%ILAY); IF(PBMAN%ILAY(ILAY).EQ.1.AND.BND(ILAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO
          !## assign to uppermost active layer
          IF(ILAY.LE.PRJNLAY)TLP(ILAY)=1.0D0
         ELSE
          !## assign to predefined layer
          TLP(PCK(1)%ILAY)=1.0D0
         ENDIF

         JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
          IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; JLAY=JLAY+1
          !## skip inactive cells
          IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
          !## not put into this model layer
          IF(TLP(ILAY).LE.0.0D0)CYCLE
          IF(PCK(1)%X(ICOL,IROW).NE.0.0D0)THEN
           WRITE(JU,'(3I10,G15.7,I10)') JLAY,IROW,ICOL,PCK(1)%X(ICOL,IROW),ISYS
           CALL PMANAGER_SAVEEXAMINE(PCK(1),'RCH_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)
           NP_IPER(IPER)=NP_IPER(IPER)+1
          ENDIF
         ENDDO
        ENDDO; ENDDO
       ENDIF
      ENDIF
     
     !## evt
     CASE (TEVT)

      IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
       LINE=TRIM(ITOS(INSURF))//','//TRIM(ITOS(INEVTR))//','//TRIM(ITOS(INEXDP)); WRITE(IU,'(A)') TRIM(LINE); IFBND=0; IF(ILAY.GT.0)IFBND=1
       IF(INSURF.EQ.1)THEN
        IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_SURF_T'//TRIM(ITOS(IPER))//'.ARR',PCK(2),IU,IFBND,0))RETURN
       ENDIF
       IF(INEVTR.EQ.1)THEN
        IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_EVTR_T'//TRIM(ITOS(IPER))//'.ARR',PCK(1),IU,IFBND,0))RETURN
       ENDIF
       IF(INEXDP.EQ.1)THEN
        IF(.NOT.PMANAGER_SAVEMF2005_PCK_U2DREL(TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_EXDP_T'//TRIM(ITOS(IPER))//'.ARR',PCK(3),IU,IFBND,0))RETURN
       ENDIF
      ELSEIF(PBMAN%IFORMAT.EQ.3)THEN
       IF(INEVTR.EQ.1.OR.INSURF.EQ.1.OR.INEXDP.EQ.1)THEN
        DO IROW=1,PCK(1)%NROW; DO ICOL=1,PCK(1)%NCOL
         !## find uppermost layer
         TLP=0.0D0
         IF(PCK(1)%ILAY.EQ.-1)THEN
          DO ILAY=1,SIZE(PBMAN%ILAY); IF(PBMAN%ILAY(ILAY).EQ.1.AND.BND(ILAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO
          !## assign to uppermost active layer
          IF(ILAY.LE.PRJNLAY)TLP(ILAY)=1.0D0
         ELSE
          !## assign to predefined layer
          TLP(PCK(1)%ILAY)=1.0D0
         ENDIF

         JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
          IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; JLAY=JLAY+1
          !## skip inactive cells
          IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
          !## not put into this model layer
          IF(TLP(ILAY).LE.0.0D0)CYCLE
          IF(PCK(1)%X(ICOL,IROW).NE.0.0D0)THEN
           WRITE(JU,'(3I10,3G15.7,I10)') JLAY,IROW,ICOL,PCK(2)%X(ICOL,IROW),PCK(1)%X(ICOL,IROW),PCK(3)%X(ICOL,IROW),ISYS
           CALL PMANAGER_SAVEEXAMINE(PCK(1),'EVTR_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
           CALL PMANAGER_SAVEEXAMINE(PCK(2),'ESRF_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
           CALL PMANAGER_SAVEEXAMINE(PCK(3),'EXDP_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
           NP_IPER(IPER)=NP_IPER(IPER)+1
          ENDIF
         ENDDO
        ENDDO; ENDDO
       ENDIF
      ENDIF
     
     CASE DEFAULT
      
      DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL

       !## skip inactive/constant head cells
       IF(PCK(1)%ILAY.GT.0.AND.(ITOPIC.NE.TCHD.AND.ITOPIC.NE.TFHB))THEN
        IF(BND(PCK(1)%ILAY)%X(ICOL,IROW).LE.0.0D0)CYCLE 
       ENDIF
      
       IF(ITOPIC.EQ.TFHB)THEN
        !## check whether one of the two is not equal to nodata
        IF(BND(PCK(1)%ILAY)%X(ICOL,IROW).EQ.2.0D0)THEN
         QFHB=PMANAGER_SAVE2005_FHBGETQ(BND(PCK(1)%ILAY)%X,PCK,JTOP,NTOP,ICOL,IROW)
         !## flow
         IF(QFHB.EQ.HNOFLOW)THEN
          WRITE(*,'(/1X,A,3I10,A)') '>>> FOUND NODATA FOR FLOW VALUES FOR FHB PACKAGE FOR (',PCK(1)%ILAY,IROW,ICOL,') <<<'
          RETURN
         ENDIF
        !## head
        ELSEIF(BND(PCK(1)%ILAY)%X(ICOL,IROW).EQ.-2.0)THEN
         IF(PCK(JTOP(NTOP))%X(ICOL,IROW).EQ.HNOFLOW)THEN
          WRITE(*,'(/1X,A,3I10,A)') '>>> FOUND NODATA FOR HEAD VALUES FOR FHB PACKAGE FOR (',PCK(1)%ILAY,IROW,ICOL,') <<<'
          RETURN
         ENDIF
        ELSE
         CYCLE
        ENDIF       
       ELSE
        !## check nodata in dataset
        DO I=1,NTOP; IF(PCK(JTOP(I))%X(ICOL,IROW).EQ.HNOFLOW)EXIT; ENDDO
        !## found any nodata in dataset - skip data point
        IF(I.LE.NTOP)CYCLE
       ENDIF
       
       IF(ITOPIC.EQ.TRIV)THEN
        !## check bottom river if that is higher than river stage
        PCK(3)%X(ICOL,IROW)=MIN(PCK(2)%X(ICOL,IROW),PCK(3)%X(ICOL,IROW))
       ENDIF
       SELECT CASE (ITOPIC)
        CASE (TRIV,TDRN,TGHB)
         PCK(JTOP(2))%X(ICOL,IROW)=MAX(0.0D0,PCK(JTOP(2))%X(ICOL,IROW))
       END SELECT
       
       !## initially not assigned to any model layer
       TLP=0.0D0 

       !## assign to several layer based upon top/bot
       IF(PCK(1)%ILAY.EQ.0)THEN

        !## get filter fractions
        CALL PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KDW,TP,BT,KH,.FALSE.)
        SELECT CASE (ITOPIC)
         CASE (TDRN) !## drn - drainagelevel
          Z1=PCK(2)%X(ICOL,IROW); Z2=Z1
         CASE (TRIV) !## riv - waterlevel and bottom
          !## assign layers in between waterlevel and bottom elevation
          IF(PBMAN%IDEFLAYER.EQ.0)THEN
           Z1=PCK(2)%X(ICOL,IROW); Z2=PCK(3)%X(ICOL,IROW)
          ELSE
           !## assign layers in between top modellayer 1 and bottom elevation
           Z1=TOP(1)%X(ICOL,IROW); Z2=PCK(3)%X(ICOL,IROW)
          ENDIF
         CASE (TOLF) !## olf drainagelevel
          Z1=PCK(1)%X(ICOL,IROW); Z2=Z1
         CASE (TGHB) !## ghb drainagelevel
          Z1=PCK(2)%X(ICOL,IROW); Z2=Z1
         CASE DEFAULT
          WRITE(*,'(/A)') 'CANNOT COME HERE: ERROR PMANAGER_SAVEMF2005_PCK - AUTOM. LAYER ASSIGNMENT'
          WRITE(*,'(A,I10)') 'ITOPIC=',ITOPIC
          WRITE(*,'(A)') TRIM(TOPICS(ITOPIC)%TNAME)
          PAUSE; STOP
        END SELECT
 
        !## get fraction per model layer
        CALL UTL_PCK_GETTLP(PRJNLAY,TLP,KH,TP,BT,Z1,Z2,MINKHT) 

       !## find uppermost active layer
       ELSEIF(PCK(1)%ILAY.EQ.-1)THEN

        DO ILAY=1,PRJNLAY; IF(BND(ILAY)%X(ICOL,IROW).NE.0)EXIT; ENDDO 
        !## assign to uppermost active layer
        IF(ILAY.LE.PRJNLAY)THEN; IF(BND(ILAY)%X(ICOL,IROW).GT.0)TLP(ILAY)=1.0D0; ENDIF

       ELSE

        !## chd package
        IF(ITOPIC.EQ.TCHD)THEN
         IF(BND(PCK(1)%ILAY)%X(ICOL,IROW).LT.0)TLP(PCK(1)%ILAY)=1.0D0
        !## fhb package
        ELSEIF(ITOPIC.EQ.TFHB)THEN
         IF(ABS(BND(PCK(1)%ILAY)%X(ICOL,IROW)).EQ.2.0D0)TLP(PCK(1)%ILAY)=1.0D0
        !## assign to predefined layer - if not constant or inactive
        ELSE
         IF(BND(PCK(1)%ILAY)%X(ICOL,IROW).GT.0)TLP(PCK(1)%ILAY)=1.0D0
        ENDIF
       
       ENDIF
      
       !## only active cells
       DO ILAY=1,SIZE(PBMAN%ILAY)
        IF(TLP(ILAY).EQ.0.0D0)CYCLE
        IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)THEN
         NINACTIVE=NINACTIVE+1
         !## normalize tlp() again
         TLP(ILAY)=0.0D0; IF(SUM(TLP).GT.0.0D0)TLP=(1.0D0/SUM(TLP))*TLP
        ENDIF
       ENDDO

       JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
        IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; JLAY=JLAY+1

        !## not put into model layer
        IF(TLP(ILAY).LE.0.0D0)CYCLE
!        !## skip inactive cells - this can happen whenever ilay=0 and stage is above top_l1 or ilay>0 and layer is inactive
!        IF(BND(ILAY)%X(ICOL,IROW).EQ.0)CYCLE

        !## write specific packages
        SELECT CASE (ITOPIC)
         !## chd 
         CASE (TCHD)
          IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
           !## check whether constant head is in appropriate cell - if not - skip it.
           LCHKCHD=.TRUE.
           !## head is in within current layer pck(jtop(1))%x(1,1:50)
           IF(PBMAN%ICHKCHD.EQ.1)LCHKCHD=PCK(JTOP(1))%X(ICOL,IROW).GT.BOT(ILAY)%X(ICOL,IROW)
           IF(LCHKCHD)THEN
            IF(PBMAN%SSYSTEM.EQ.0)THEN
             WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),PCK(JTOP(1))%X(ICOL,IROW),ISYS
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'CHD_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
            ELSE 
             WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),PCK(JTOP(1))%X(ICOL,IROW),1
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'CHD_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
            ENDIF
            NP_IPER(IPER)=NP_IPER(IPER)+1
           ENDIF
          ENDIF
         !## olf
         CASE (TOLF)
          OLFCOND=(IDFGETAREA(PCK(JTOP(1)),ICOL,IROW)/COLF)   !## drainage conductance
          IF(PBMAN%SSYSTEM.EQ.0)THEN
           WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),OLFCOND,ISYS
           CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'OLFL_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
           CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'OLFC_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=OLFCOND)           
          ELSE
           WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),OLFCOND,1
           CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'OLFL_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL)           
           CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'OLFC_L'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=OLFCOND)           
          ENDIF
          NP_IPER(IPER)=NP_IPER(IPER)+1
         
         !## fhb
         CASE (TFHB)
          IF(BND(ILAY)%X(ICOL,IROW).EQ. 2.0D0)THEN; NFLW=NFLW+1; FHBFLW(NFLW,NBDTIM)=QFHB; ENDIF 
          IF(BND(ILAY)%X(ICOL,IROW).EQ.-2.0D0)THEN; NHED=NHED+1; FHBHED(NHED,NBDTIM)=PCK(JTOP(NTOP))%X(ICOL,IROW); ENDIF

         !## drn
         CASE (TDRN)
          DO I=1,NTOP; XTMP(I)=PCK(I)%X(ICOL,IROW); ENDDO
          XTMP(1)=XTMP(1)*TLP(ILAY)
          
          !## correct if present by level-controlled drainage, only for the first DRN system
          IF(PBMAN%FLEXD.EQ.1)THEN
           COMMENT=''
           IF(ISYS.EQ.1)THEN
            IF(FLXDRL%X(ICOL,IROW).NE.FLXDRL%NODATA)THEN
             XTMP(1)=0.0D0; COMMENT=' >>> removed by flexd <<<'
            ENDIF
           ENDIF
          ENDIF

          !## in current model (layers)
          JSYS=1; IF(PBMAN%SSYSTEM.EQ.0)JSYS=ISYS
          CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'DRNLEVEL_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=XTMP(JTOP(1)))
          CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'DRNCOND_'//TRIM(ITOS(JLAY)) ,-IPER,IR=IROW,IC=ICOL,X=XTMP(JTOP(2)))

          IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%DDRN.NE.0.0D0)THEN
           !## include depth level for numerical improvement drn-package, no drainage at ELEV and maximal drainage at ELEV+DDRN
           WRITE(JU,FRM) JLAY,IROW,ICOL,(XTMP(JTOP(I)),I=1,NTOP),PBMAN%DDRN,JSYS
           CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'DRNDDRN_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=PBMAN%DDRN)
           
!auxdepthname—name of a variable listed in AUXILIARY that defines the depth at which drainage
!discharge will be scaled. If a positive value is specified for the AUXDEPTHNAME AUXILIARY
!variable, then ELEV is the elevation at which the drain starts to discharge and ELEV + DDRN
!(assuming DDRN is the AUXDEPTHNAME variable) is the elevation when the drain conductance
!(COND) scaling factor is 1. If a negative drainage depth value is specified for DDRN, then ELEV
!+ DDRN is the elevation at which the drain starts to discharge and ELEV is the elevation when the
!conductance (COND) scaling factor is 1. A linear- or cubic-scaling is used to scale the drain con-
!ductance (COND) when the Standard or Newton-Raphson Formulation is used, respectively.          
          ELSE
           IF(PBMAN%FLEXD.EQ.1)THEN
            WRITE(JU,'(3I10,2G15.7,I10,A)') JLAY,IROW,ICOL,(XTMP(JTOP(I)),I=1,NTOP),JSYS,TRIM(COMMENT)
           ELSE
            WRITE(JU,FRM) JLAY,IROW,ICOL,(XTMP(JTOP(I)),I=1,NTOP),JSYS
           ENDIF
          ENDIF
          NP_IPER(IPER)=NP_IPER(IPER)+1
          
         CASE DEFAULT

           DO I=1,NTOP; XTMP(I)=PCK(I)%X(ICOL,IROW); ENDDO
           XTMP(1)=XTMP(1)*TLP(ILAY)

           !## in current model (layers)
           JSYS=1; IF(PBMAN%SSYSTEM.EQ.0)JSYS=ISYS
           !## generate riv package without inf-factor
           IF(ITOPIC.EQ.TRIV)THEN
            WP=XTMP(JTOP(1)); CD=XTMP(JTOP(2)); BH=XTMP(JTOP(3)); FC=XTMP(JTOP(4))
            CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVLEVEL_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=WP)
            !## make sure for unconfinedness bottom river is not lower than bottom of model layer
            IF(LAYCON(JLAY).EQ.2)THEN
             BH=MAX(BOT(JLAY)%X(ICOL,IROW),BH)            
            ENDIF
            IF(PBMAN%INFFCT.EQ.1)THEN
             IF(CD*(1.0D0-FC).GT.0.0D0)THEN
              IF(PBMAN%IFORMAT.EQ.6)THEN
               !## convert concentration to density
               CONC=XTMP(5); IF(WQ%VDF%MTDNCONC.EQ.0)CONC=(CONC/WQ%VDF%DENSESLP)+WQ%VDF%DENSEREF
               WRITE(JU,'(3(I5,1X),4(G15.7,1X),I5,A)') JLAY,IROW,ICOL,WP,CD*(1.0D0-FC),WP,CONC,JSYS,' D'
               CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVCONC_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=CONC)
              ELSE
               WRITE(JU,'(3(I5,1X),3(G15.7,1X),I5,A)') JLAY,IROW,ICOL,WP,CD*(1.0D0-FC),WP,JSYS,' D'
              ENDIF
              CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVCOND_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=CD*(1.0D0-FC))
              CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVBOTTOM_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=WP)              
              NP_IPER(IPER)=NP_IPER(IPER)+1
             ENDIF
             IF(WP.GE.BH.AND.CD*FC.GT.0.0D0)THEN
              IF(PBMAN%IFORMAT.EQ.6.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1)THEN
               CONC=XTMP(5); IF(WQ%VDF%MTDNCONC.EQ.0)CONC=(CONC/WQ%VDF%DENSESLP)+WQ%VDF%DENSEREF
               WRITE(JU,'(3(I5,1X),4(G15.7,1X),I5,A)') JLAY,IROW,ICOL,WP,CD*FC,BH,CONC,JSYS,' I'
               CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVCONC_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=CONC)
              ELSE
               WRITE(JU,'(3(I5,1X),3(G15.7,1X),I5,A)') JLAY,IROW,ICOL,WP,CD*FC,BH,JSYS,' I'
              ENDIF
              CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVCOND_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=CD*FC)
              CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVBOTTOM_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=BH)              
              NP_IPER(IPER)=NP_IPER(IPER)+1
             ENDIF
            ELSE
             WRITE(JU,'(3(I5,1X),4(G15.7,1X),I5)') JLAY,IROW,ICOL,WP,CD,BH,FC,JSYS
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVCOND_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=CD)
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'RIVBOTTOM_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=BH)              
             NP_IPER(IPER)=NP_IPER(IPER)+1
            ENDIF
             
           ELSE
            IF(PBMAN%IFORMAT.EQ.6.AND.TOPICS(TVDF)%IACT_MODEL.EQ.1)THEN
             CONC=XTMP(NTOP); IF(WQ%VDF%MTDNCONC.EQ.0)CONC=(CONC/WQ%VDF%DENSESLP)+WQ%VDF%DENSEREF; XTMP(NTOP)=CONC
            ENDIF
            WRITE(JU,FRM) JLAY,IROW,ICOL,(XTMP(JTOP(I)),I=1,NTOP),JSYS
            IF(ITOPIC.EQ.TGHB)THEN
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'GHBLEVEL_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=XTMP(JTOP(1)))
             CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'GHBCOND_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=XTMP(JTOP(2)))
            ENDIF
            NP_IPER(IPER)=NP_IPER(IPER)+1
           ENDIF

         END SELECT

      ENDDO 

     ENDDO; ENDDO

     !## add drainage from level-controlled drainage
     IF(PBMAN%FLEXD.EQ.1.AND.ITOPIC.EQ.TDRN.AND.ISYS.EQ.1)THEN
      DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
       IF(FLXDRL%X(ICOL,IROW).EQ.FLXDRL%NODATA)CYCLE
       !## cell area
       XTMP(1)=IDFGETAREA(PRJIDF,ICOL,IROW)
       !## correct for nopp/sopp area
       F=1.0D0-((FLXSOPP%X(ICOL,IROW)+FLXNOPP%X(ICOL,IROW))/XTMP(1))
       WRITE(JU,'(3I10,2G15.7,I10,A)') 1,IROW,ICOL,FLXDRL%X(ICOL,IROW),(XTMP(1)*F)/FLXDRR%X(ICOL,IROW),1,' >>> added by flexd fraction='//TRIM(RTOS(F,'F',2))//' <<<'
       CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'FLXDRNCOND_'//TRIM(ITOS(JLAY)), -IPER,IR=IROW,IC=ICOL,X=(XTMP(1)*F)/FLXDRR%X(ICOL,IROW))
       CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'FLXDRNLEVEL_'//TRIM(ITOS(JLAY)),-IPER,IR=IROW,IC=ICOL,X=FLXDRL%X(ICOL,IROW)            )              
       NP_IPER(IPER)=NP_IPER(IPER)+1
      ENDDO; ENDDO
     ENDIF
     
    END SELECT

   ENDDO

   IF(ITOPIC.NE.TFHB.AND. &
      ITOPIC.NE.TUZF.AND. &
      ITOPIC.NE.TEVT.AND. &
      ITOPIC.NE.TRCH)THEN
    LINE=TRIM(ITOS(NP_IPER(IPER))); IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  
   !## maximum input per simulation
   MP=MAX(MP,NP_IPER(IPER))
    
   IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
    SELECT CASE (ITOPIC)
     CASE (TDRN,TRIV,TGHB,TOLF,TCHD)
      CALL IDFWRITEFREE_HEADER(JU,PRJIDF)
    END SELECT
   ENDIF
  
   CLOSE(JU)

   IF(PBMAN%IFORMAT.GE.2)THEN
    
    IF(PBMAN%IFORMAT.EQ.3)THEN
     SELECT CASE (ITOPIC)
      CASE (TEVT)
       IF(INEVTR.EQ.1.OR.INSURF.EQ.1.OR.INEXDP.EQ.1)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
      CASE (TRCH)
       IF(INRECH.EQ.1)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
      CASE (TUZF)
      CASE DEFAULT
!       IF(NP_IPER(IPER).GT.0)
       WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
     END SELECT
    ENDIF  

    IF(NP_IPER(IPER).GT.0)THEN
     SFNAME=EXFNAME
     N=3
     IF(PBMAN%SSYSTEM.EQ.0.AND.PBMAN%IFORMAT.EQ.3)N=5
     IF(PBMAN%SSYSTEM.EQ.1.AND.PBMAN%IFORMAT.EQ.3)N=4
     DO I=1,N; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
     I=LEN_TRIM(SFNAME)
     IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%IPESTP.EQ.1)THEN
      SFNAME='..'//EXFNAME(I+1:)
     ELSE
      SFNAME='.'//EXFNAME(I+1:)
     ENDIF
     IF(ITOPIC.NE.TUZF)WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
    ENDIF

    IF(PBMAN%IFORMAT.EQ.3)THEN
     SELECT CASE (ITOPIC)
      CASE (TEVT)
       IF(INEVTR.EQ.1.OR.INSURF.EQ.1.OR.INEXDP.EQ.1)WRITE(IU,'(A)') 'END PERIOD'
      CASE (TRCH)
       IF(INRECH.EQ.1)WRITE(IU,'(A)') 'END PERIOD'
      CASE (TUZF)
      CASE DEFAULT
!       IF(NP_IPER(IPER).GT.0)
       WRITE(IU,'(A)') 'END PERIOD'
     END SELECT
    ENDIF  
!    IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD '
   ENDIF
  
!   IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD '

   !## store previous stress-period information for this timestep
   LPER=KPER

  ENDDO

  !## write fhb package
  IF(ITOPIC.EQ.TFHB)THEN
   IF(ALLOCATED(FHBFLW))THEN
    LINE=TRIM(ITOS(IFHBUN))//',1.0,0'; WRITE(IU,'(A)') TRIM(LINE)
    !## store values in fhb package
    I=0; DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
     IF(BND(ILAY)%X(ICOL,IROW).EQ. 2.0D0)THEN
      !## to be sure that volumes are rectangles and not triangles modify
      I=I+1
      DO J=2,NBDTIM
       FHBFLW(I,J)=FHBFLW(I,J)+(FHBFLW(I,J)-FHBFLW(I,J-1))
      ENDDO
      WRITE(IU,'(4(I10,1X),999(1X,G15.7))') ILAY,IROW,ICOL,1,(FHBFLW(I,J),J=1,NBDTIM)
      DO J=1,NBDTIM
       CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'FHBFLW_'//TRIM(ITOS(ILAY)),-J,IR=IROW,IC=ICOL,X=FHBFLW(I,J))
      ENDDO
     ENDIF
    ENDDO; ENDDO; ENDDO
   ENDIF
   IF(ALLOCATED(FHBHED))THEN
    LINE=TRIM(ITOS(IFHBUN))//',1.0,0'; WRITE(IU,'(A)') TRIM(LINE)
    !## store values in fhb package
    I=0; DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
     IF(BND(ILAY)%X(ICOL,IROW).EQ.-2.0D0)THEN
     I=I+1; WRITE(IU,'(4(I10,1X),999(1X,G15.7))') ILAY,IROW,ICOL,1,(FHBHED(I,J),J=1,NBDTIM)
      DO J=1,NBDTIM
       CALL PMANAGER_SAVEEXAMINE(PCK(JTOP(1)),'FHBHED_'//TRIM(ITOS(ILAY)),-J,IR=IROW,IC=ICOL,X=FHBHED(I,J))
      ENDDO
     ENDIF
    ENDDO; ENDDO; ENDDO
   ENDIF
  ENDIF

  CLOSE(IU)
  IF(ALLOCATED(TLP))    DEALLOCATE(TLP)
  IF(ALLOCATED(TP))     DEALLOCATE(TP)
  IF(ALLOCATED(BT))     DEALLOCATE(BT)
  IF(ALLOCATED(KH))     DEALLOCATE(KH)
  IF(ALLOCATED(XTMP))   DEALLOCATE(XTMP)
 
!  CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK()

  !## apply nevtop/nrchop options
  SELECT CASE(ITOPIC)
   CASE (TUZF)
    IF(PBMAN%IFORMAT.NE.3)NP_IPER(0)=NUZTOP
   CASE (TEVT)
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)NP_IPER(0)=NEVTOP
    IF(PBMAN%IFORMAT.EQ.3)NP_IPER(0)=MAXVAL(NP_IPER) 
   CASE (TRCH)
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)NP_IPER(0)=NRCHOP
    IF(PBMAN%IFORMAT.EQ.3)NP_IPER(0)=MAXVAL(NP_IPER) 
   CASE DEFAULT; NP_IPER(0)=MP
  END SELECT

  IF(ITOPIC.EQ.TEVT.OR.ITOPIC.EQ.TRCH)THEN
   IF(TOPICS(TLAK)%IACT_MODEL.EQ.1.AND.NP_IPER(0).EQ.1)THEN 
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is compulsory to apply the '//TRIM(TOPICS(ITOPIC)%TNAME)//' package to the'//CHAR(13)// &
         'first active modellayer in combination with the LAK package.'//CHAR(13)// &
         'Assign zero (0) as a model layer for the package','Error')
    RETURN
   ENDIF
  ENDIF
  
  !## mf6 does not allow max dimensions to be zero
  IF(PBMAN%IFORMAT.EQ.3)NP_IPER(0)=MAX(1,NP_IPER(0))
  
  IF(PBMAN%IFORMAT.EQ.3)THEN
   MP=MAX(1,MP)
   IF(PBMAN%SSYSTEM.EQ.0)THEN
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',(/NP_IPER(0)/))
   ELSE
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP_IPER(0)/))
   ENDIF
  ELSE
   CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP_IPER(0)/))
  ENDIF

  IF(ALLOCATED(NP_IPER))DEALLOCATE(NP_IPER)
 
 ENDDO
 
 IF(PBMAN%FLEXD.EQ.1)THEN
  CALL IDFDEALLOCATEX(FLXDRL);  CALL IDFDEALLOCATEX(FLXDRR); CALL IDFDEALLOCATEX(FLXPLN)
  CALL IDFDEALLOCATEX(FLXNOPP); CALL IDFDEALLOCATEX(FLXSOPP)
 ENDIF

 IF(NINACTIVE.EQ.1)THEN
  WRITE(*,'(/A)') 'Number of removed '//TRIM(CPCKIN)//' that are in inactive/constant heads is '//TRIM(ITOS(NINACTIVE))
 ENDIF

 CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK()

 PMANAGER_SAVEMF2005_PCK=.TRUE.
  
 END FUNCTION PMANAGER_SAVEMF2005_PCK

 !####====================================================================
 REAL(KIND=DP_KIND) FUNCTION PMANAGER_SAVE2005_FHBGETQ(XBND,PCK,JTOP,NTOP,ICOL,IROW) 
 !####====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:,:) :: XBND
 INTEGER,INTENT(IN) :: ICOL,IROW,NTOP
 INTEGER,INTENT(IN),DIMENSION(NTOP) :: JTOP
 INTEGER :: JCOL,JROW
 TYPE(IDFOBJ),INTENT(IN),DIMENSION(NTOP) :: PCK
 REAL(KIND=DP_KIND) :: QN,QW,QE,QS
 LOGICAL :: LEX
 
 !## single flux file given
 IF(NTOP.EQ.2)THEN; PMANAGER_SAVE2005_FHBGETQ=PCK(JTOP(1))%X(ICOL,IROW); RETURN; ENDIF
 
 !## usage of frf and fff flux terms
 
 !## apply offset
 JCOL=ICOL+1; JROW=IROW+1
 
 !## north if available
 QN=0.0D0; LEX=.FALSE.
 IF(IROW.EQ.1)THEN
  LEX=.TRUE.
 ELSE
  IF(XBND(ICOL,IROW-1).EQ.0.0D0)LEX=.TRUE.
 ENDIF
 IF(LEX)THEN
  QN=PCK(JTOP(2))%X(JCOL,JROW-1); IF(QN.EQ.PCK(JTOP(2))%NODATA)QN=0.0D0; QN=-1.0D0*QN
 ENDIF
 
 !## west if available
 QW=0.0D0; LEX=.FALSE.
 IF(ICOL.EQ.1)THEN
  LEX=.TRUE.
 ELSE
  IF(XBND(ICOL-1,IROW).EQ.0.0D0)LEX=.TRUE.
 ENDIF
 IF(LEX)THEN
  QW=PCK(JTOP(1))%X(JCOL-1,JROW); IF(QW.EQ.PCK(JTOP(1))%NODATA)QW=0.0D0; QW=-1.0D0*QW
 ENDIF
 
 !## south if available
 QS=0.0D0; LEX=.FALSE.
 IF(IROW.EQ.PRJIDF%NROW)THEN
  LEX=.TRUE.
 ELSE
  IF(XBND(ICOL,IROW+1).EQ.0.0D0)LEX=.TRUE.
 ENDIF
 IF(LEX)THEN
  QS=PCK(JTOP(2))%X(JCOL,JROW); IF(QS.EQ.PCK(JTOP(2))%NODATA)QS=0.0D0
 ENDIF

 !## east if available
 QE=0.0D0; LEX=.FALSE.
 IF(ICOL.EQ.PRJIDF%NCOL)THEN
  LEX=.TRUE.
 ELSE
  IF(XBND(ICOL+1,IROW).EQ.0.0D0)LEX=.TRUE.
 ENDIF
 IF(LEX)THEN
  QE=PCK(JTOP(1))%X(JCOL,JROW); IF(QE.EQ.PCK(JTOP(1))%NODATA)QE=0.0D0
 ENDIF
 
 PMANAGER_SAVE2005_FHBGETQ=QN+QW+QS+QE
 
 END FUNCTION PMANAGER_SAVE2005_FHBGETQ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SSM_READSAVE(MAINDIR,DIR,DIRMNAME,IBATCH,IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,IPRT
 CHARACTER(LEN=*),INTENT(IN) :: MAINDIR,DIR,DIRMNAME
 INTEGER :: I,ITOPIC,SCL_D,SCL_U,IROW,ICOL,IPER,KPER,IU,ILAY,J,K,IFBND,ISYS,NSYS,KTOP,NTOP, &
   NCOLIPF,NROWIPF,IOS,N,IL1,IL2,KU
 REAL(KIND=DP_KIND) :: Q,C,X,Y,CONC
 INTEGER(KIND=8) :: ITIME,JTIME
 INTEGER,DIMENSION(6) :: IPREV
 INTEGER,ALLOCATABLE,DIMENSION(:) :: NSS,JU
 INTEGER,DIMENSION(6) :: SSMTOPIC,SSMTYPE,COLUMN
 LOGICAL :: LSSM
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:,:) :: CONCACT
 INTEGER(KIND=1),ALLOCATABLE,DIMENSION(:,:,:)    :: CONCCNT
 CHARACTER(LEN=52),DIMENSION(4) :: STRING
 CHARACTER(LEN=11) :: TXT
 CHARACTER(LEN=256) :: ARRFNAME
 
 PMANAGER_SAVEMF2005_SSM_READSAVE=.TRUE.; IF(PBMAN%IFORMAT.NE.6.OR.WQ%VDF%MTDNCONC.EQ.0)RETURN

 SSMTOPIC=[TWEL,TDRN,TRCH,TEVT,TRIV,TGHB]
 
 PMANAGER_SAVEMF2005_SSM_READSAVE=.FALSE.

 !## read lake package (also adjust ibound for lakes)
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.SSM1_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
 IF(IU.EQ.0)RETURN

 LINE=''; DO I=1,SIZE(SSMTOPIC)
  ITOPIC=SSMTOPIC(I)
  IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.1)THEN; LINE=TRIM(LINE)//' T'; ELSE; LINE=TRIM(LINE)//' F'; ENDIF
 ENDDO
 WRITE(IU,'(A)') TRIM(LINE)//' F F F F' 
 
 SSMTOPIC=[TRCH,TEVT,TWEL,TDRN,TRIV,TGHB]; ALLOCATE(NSS(PRJNPER+1)); NSS=0
 !## ssm types
 SSMTYPE =[0,0,2,3,4,5]; COLUMN=[0,0,5,6,7,6]
 
 SCL_D=1; SCL_U=2; ALLOCATE(FNAMES(1)) 

 !## mxss
 WRITE(IU,'(A)') 'NaN1#' 
 
 !## allocate pck-information
 ALLOCATE(CONCACT(PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY))
 ALLOCATE(CONCCNT(PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY))
 
 N=SIZE(SSMTOPIC); ALLOCATE(PCKSSM(N))
 DO I=1,N
  NULLIFY(PCKSSM(I)%ILAY); NULLIFY(PCKSSM(I)%IROW)
  NULLIFY(PCKSSM(I)%ICOL); NULLIFY(PCKSSM(I)%CONC)
 ENDDO
 
 !## get maximal packages available
 NSS(1)=0; ALLOCATE(JU(N)); JU=0; DO I=1,N
  ITOPIC=SSMTOPIC(I); IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.0)CYCLE
  SELECT CASE (ITOPIC)
   CASE (TRCH,TEVT); NSS(1)=NSS(1)+PRJIDF%NROW*PRJIDF%NCOL; CYCLE
   CASE DEFAULT
    JU(I)=UTL_GETUNIT(); OPEN(JU(I),FILE=TRIM(DIRMNAME)//'.'//TOPICS(ITOPIC)%CMOD//'7',STATUS='OLD',ACTION='READ')
    READ(JU(I),*) N; NSS(1)=NSS(1)+N
  END SELECT
 ENDDO
 
 !## add constant head to nss(1)
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(BND(ILAY)%X(ICOL,IROW).LT.0.0D0)NSS(1)=NSS(1)+1
 ENDDO; ENDDO; ENDDO
 
 !## define per stressperiod
 DO IPER=1,PRJNPER
  
  DO I=1,2
   !## process recharge/evapotranspiration
   ITOPIC=SSMTOPIC(I)
   IF(TOPICS(ITOPIC)%IACT_MODEL.EQ.1)THEN
    !## get appropriate stress-period to store in runfile   
    KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
    !## reuse previous timestep
    IF(KPER.LE.0)THEN
     WRITE(IU,'(I10,10X,A)') -1,TRIM(TOPICS(ITOPIC)%TNAME)
     CYCLE
    ENDIF

    NTOP=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)
    DO ISYS=1,NSYS
     !## read last subtopic
     KTOP=NTOP
     FNAMES(1)%ICNST=TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ICNST 
     FNAMES(1)%CNST =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%CNST  
     FNAMES(1)%FCT  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FCT   
     FNAMES(1)%IMP  =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%IMP   
     FNAMES(1)%ILAY =TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%ILAY  
     FNAMES(1)%FNAME=TOPICS(ITOPIC)%STRESS(KPER)%FILES(KTOP,ISYS)%FNAME     
     !## read concentrations    
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(PRJIDF,ITOPIC,1,SCL_D,SCL_U,0,IPRT))RETURN
     CALL PMANAGER_SAVEMF2005_CORRECT(1,BND,PRJIDF,0,ITOPIC)
     WRITE(IU,'(A)') '1'
     IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\SSM\'//TRIM(TOPICS(ITOPIC)%CMOD)//'_CONC.ARR',PRJIDF,0,IU,1,IFBND))RETURN
    ENDDO
   ENDIF
  ENDDO

  !## read locations for package
  IPREV=0; DO I=1,SIZE(JU)
   IF(JU(I).EQ.0)CYCLE
   READ(JU(I),*) IPREV(I)
   IF(IPREV(I).GT.0)THEN
    READ(JU(I),'(2A)') TXT,ARRFNAME; READ(ARRFNAME,*) ARRFNAME
    ARRFNAME=TRIM(MAINDIR)//'\'//TRIM(ARRFNAME(3:))
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_READLSTFILE(ARRFNAME,IPREV(I),I,COLUMN(I)))THEN
     RETURN
    ENDIF
   ELSE
    IPREV(I)=0; IF(ASSOCIATED(PCKSSM(I)%CONC))IPREV(I)=SIZE(PCKSSM(I)%CONC)
   ENDIF
  ENDDO
  
  LSSM=.FALSE.;  DO I=3,SIZE(SSMTOPIC); IF(IPREV(I).GT.0)LSSM=.TRUE.; ENDDO

  IF(LSSM)THEN
   
   WRITE(IU,'(A10,10X,A)') 'NaN'//TRIM(ITOS(IPER+1))//'#',' SSM FOR PACKAGES '//TRIM(SIM(IPER)%CDATE)
   DO I=3,SIZE(SSMTOPIC)

    !## skip drn package
    IF(SSMTYPE(I).EQ.3)CYCLE
    
    !## get current topic
    ITOPIC=SSMTOPIC(I); IF(TOPICS(ITOPIC)%IACT_MODEL.NE.1)CYCLE; CONCACT=0.0D0; CONCCNT=INT(0,1)
    DO J=1,IPREV(I)
     ILAY=PCKSSM(I)%ILAY(J)
     IROW=PCKSSM(I)%IROW(J)
     ICOL=PCKSSM(I)%ICOL(J)
     CONC=PCKSSM(I)%CONC(J)
     CONCACT(ICOL,IROW,ILAY)=CONCACT(ICOL,IROW,ILAY)+CONC
     CONCCNT(ICOL,IROW,ILAY)=CONCCNT(ICOL,IROW,ILAY)+INT(1,1)
    ENDDO
    DO J=1,IPREV(I)
     ILAY=PCKSSM(I)%ILAY(J)
     IROW=PCKSSM(I)%IROW(J)
     ICOL=PCKSSM(I)%ICOL(J)
     IF(CONCCNT(ICOL,IROW,ILAY).GT.INT(0,1))THEN
      CONC=CONCACT(ICOL,IROW,ILAY)/REAL(CONCCNT(ICOL,IROW,ILAY),8)
      WRITE(IU,'(3I10,F10.2,I10)') ILAY,IROW,ICOL,CONC,SSMTYPE(I)
      NSS(IPER+1)=NSS(IPER+1)+1
      CONCCNT(ICOL,IROW,ILAY)=INT(0,1)
     ENDIF
    ENDDO
   ENDDO
  ELSE
   WRITE(IU,'(A)') '-1 RE-USE ALL EXISTING SSM PACKAGES '//TRIM(SIM(IPER)%CDATE)
  ENDIF
 ENDDO
 DEALLOCATE(FNAMES,JU,CONCACT,CONCCNT) 
 CLOSE(IU)
 
 CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.SSM1_',NSS)
 
 PMANAGER_SAVEMF2005_SSM_READSAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_SSM_READSAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LAK_READ(IPER,IPRT,KPER)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPER,IPRT
 INTEGER,INTENT(INOUT) :: KPER
 INTEGER :: I,ITOPIC,SCL_D,SCL_U,IROW,ICOL,JPER
 INTEGER(KIND=8) :: ITIME,JTIME
 
 PMANAGER_SAVEMF2005_LAK_READ=.TRUE.

 IF(TOPICS(TLAK)%IACT_MODEL.EQ.0)RETURN
 
 PMANAGER_SAVEMF2005_LAK_READ=.FALSE.

 !## lak settings - use most frequent 
 ITOPIC=TLAK

 !## initialisation of lake package
 IF(IPER.EQ.0)THEN
  !## search for first lake definition in time
  DO JPER=1,PRJNPER
   !## get appropriate input file for first stress-period 
   KPER=PMANAGER_GETCURRENTIPER(JPER,ITOPIC,ITIME,JTIME)
   IF(KPER.GT.0)EXIT
  ENDDO
  !## nothing found
  IF(JPER.GT.PRJNPER)KPER=0
! ELSE
!  !## get appropriate input file for first stress-period 
!  KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)
!  !## nothing found
!  IF(IPER.EQ.1.AND.KPER.LE.0)KPER=0
 ENDIF
 
! IF(KPER.LT.0)THEN; PMANAGER_SAVEMF2005_LAK_READ=.TRUE.; RETURN; ENDIF
 
 !## get appropriate filename for first system and i-th subsystem for kper-th period
 ALLOCATE(FNAMES(TOPICS(ITOPIC)%NSUBTOPICS),PRJILIST(1)); PRJILIST=ITOPIC
 IF(PMANAGER_GETFNAMES(1,1,1,0,KPER).LE.0)RETURN

 DO I=1,SIZE(LAK)
  SELECT CASE (I)
   CASE (1);     SCL_D=0; SCL_U=7
   CASE DEFAULT; SCL_D=1; SCL_U=2
  END SELECT
  CALL IDFCOPY(PRJIDF,LAK(I))

  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(LAK(I),ITOPIC,I,SCL_D,SCL_U,0,IPRT))RETURN 
  IF(I.EQ.1)THEN
   !## remove negative lake-numbers and nodata cells
   DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
    IF(LAK(1)%X(ICOL,IROW).LT.0.0D0)LAK(1)%X(ICOL,IROW)=0.0D0
    IF(LAK(1)%X(ICOL,IROW).EQ.LAK(1)%NODATA)LAK(1)%X(ICOL,IROW)=0.0D0
   ENDDO; ENDDO
  ELSE
   !## clean rest of input
   CALL PMANAGER_SAVEMF2005_CORRECT(1,LAK,LAK(I),0,ITOPIC)
  ENDIF
 ENDDO
 
 DEALLOCATE(FNAMES,PRJILIST)

 PMANAGER_SAVEMF2005_LAK_READ=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_LAK_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LAK_SAVE(IULAK,IINI,IBATCH,DIR,KPER,DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR
 CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: DIRMNAME
 INTEGER,INTENT(IN),OPTIONAL :: KPER
 INTEGER,INTENT(IN) :: IBATCH,IINI
 INTEGER,INTENT(INOUT) :: IULAK
 INTEGER :: NSSITR,I,J,IOP,ILAY,ITMP1,IFBND
 REAL(KIND=DP_KIND) :: THETA,SSCNCR,LVL,FCT,SURFDEPTH

 PMANAGER_SAVEMF2005_LAK_SAVE=.TRUE.

 IF(TOPICS(TLAK)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_LAK_SAVE=.FALSE.
  
 !## initial timestep - open file and write header
 IF(KPER.EQ.1)THEN
 
  !## a THETA is automatically set to a value of 1.0D0 for all steady-state stress periods
  !## a THETA of 0.5 represents the average lake stage during a time step.
  !## a THETA of 1.0D0 represents the lake stage at the end of the time step.
  !## a negative THETA of applies for a SURFDEPTH decreases the lakebed conductance for vertical flow across a horizontal lakebed
  !## caused both by a groundwater head that is between the lakebed and the lakebed plus SURFDEPTH and a lake stage that is also
  !## between the lakebed and the lakebed plus SURFDEPTH. This method provides a smooth transition from a condition of no groundwater
  !## discharge to a lake, when groundwater head is below the lakebed, to a condition of increasing groundwater discharge to a lake as
  !## groundwater head becomes greater than the elevation of the dry lakebed. The method also allows for the transition of seepage from
  !## a lake to groundwater when the lake stage decreases to the lakebed elevation. Values of SURFDEPTH ranging from 0.01D0 to 0.5 have
  !## been used successfully in test simulations. SURFDEP is read only if THETA is specified as a negative value.
  THETA=-1.0D0; SSCNCR=0.01D0; NSSITR=100; SURFDEPTH=0.25D0

  !## read lake package (also adjust ibound for lakes)
  IULAK=UTL_GETUNIT(); CALL OSD_OPEN(IULAK,FILE=TRIM(DIRMNAME)//'.LAK7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IULAK.EQ.0)RETURN

  !## set number of lakes
  LINE=TRIM(ITOS(NLAKES))//','//TRIM(ITOS(ILAKCB))
  WRITE(IULAK,'(A)') TRIM(LINE)

  !## set global settings
  LINE=TRIM(RTOS(THETA,'G',5))//','//TRIM(ITOS(NSSITR))//','//TRIM(RTOS(SSCNCR,'G',5))//','//TRIM(RTOS(SURFDEPTH,'G',5))
  WRITE(IULAK,'(A)') TRIM(LINE)
 
 ENDIF
 
 !## initial timestep
 IF(IINI.EQ.1)THEN

  !## get initial, minimal and maximal stages per lake
  DO I=1,NLAKES
   DO J=3,5
    SELECT CASE (J)
     CASE (3); IOP=1 !## initial (take average value)
     CASE (4); IOP=2 !## minimal
     CASE (5); IOP=3 !## maximal
    END SELECT
    IF(.NOT.PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE(LAK(1)%X,LAK(J)%X,ULAKES(I),LVL,IBATCH,IOP))RETURN
    IF(J.EQ.3)THEN
     LINE=TRIM(RTOS(LVL,'G',5))
    ELSE
     LINE=TRIM(LINE)//','//TRIM(RTOS(LVL,'G',5))
    ENDIF
   ENDDO
   WRITE(IULAK,'(A)') TRIM(LINE)//'      ORIGINAL LAKE IDENTIFICATION: '//TRIM(ITOS(ULAKES(I)))
  ENDDO
 
  ITMP1=1; LINE='1,'//TRIM(ITOS(ITMP1))//',0'; WRITE(IULAK,'(A)') TRIM(LINE)
 
  !## save lake identification
  IFBND=0
  DO ILAY=1,PRJNLAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LAK7\LKARR_L'//TRIM(ITOS(ILAY))//'.ARR', &
       LBD(ILAY),1,IULAK,ILAY,IFBND))RETURN 
  ENDDO
  !## get lakebed leakance
  IFBND=0
  DO ILAY=1,PRJNLAY
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\LAK7\BDLKNC_L'//TRIM(ITOS(ILAY))//'.ARR', &
       LCD(ILAY),0,IULAK,ILAY,IFBND))RETURN
  ENDDO
  !## no connected lakes
  LINE=TRIM(ITOS(0))
  WRITE(IULAK,'(A)') TRIM(LINE) 
 
 ELSE
 
!  ITMP1=1; IF(KPER.EQ.0)ITMP1=0; IF(KPER.LT.0)ITMP1=-1
  !## iini=-1 to previous usage of lak settings but renewed read in rch/evt
  IF(KPER.GT.0)ITMP1= 1 !SIGN(KPER) !IINI !ABS(IINI)
  IF(KPER.LT.0)ITMP1=-1 !SIGN(KPER) !IINI !ABS(IINI)
  
  !## HIER MOET IINI OOK DE WAARDE 1 KUNNEN KRIJGEN ALS ER WEL RCH.EVT MOET WORDEN INGELZEN
  LINE='-1,'//TRIM(ITOS(ITMP1))//',0'; WRITE(IULAK,'(A)') TRIM(LINE)

 ENDIF

 !## get average prcplk,evaplk sum of rnf,wthdrw
 IF(ITMP1.GT.0)THEN
  IOP=1
  DO I=1,NLAKES
   DO J=7,10
    SELECT CASE (J)
     CASE (7,8); IOP=1; FCT=0.01D0 !## prcplk,evaplk
     CASE (9);   IOP=1; FCT=1.00D0 !## rnf
     CASE (10);  IOP=1; FCT=1.00D0 !## wthdrw
    END SELECT
    IF(.NOT.PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE(LAK(1)%X,LAK(J)%X,ULAKES(I),LVL,IBATCH,IOP))RETURN
    IF(J.EQ.7)THEN
     LINE=TRIM(RTOS(LVL*FCT,'G',5))
    ELSE
     LINE=TRIM(LINE)//','//TRIM(RTOS(LVL*FCT,'G',5))
    ENDIF
   ENDDO
   WRITE(IULAK,'(A)') TRIM(LINE) 
  ENDDO
 ENDIF
 
 PMANAGER_SAVEMF2005_LAK_SAVE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_LAK_SAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SFT_READ(IPRT)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPRT
 INTEGER :: ITOPIC,SCL_D,SCL_U,I,IINV,NTOP,NSYS,ISYS,KTOP,ICNST,ILAY
 REAL(KIND=DP_KIND) :: FCT,CNST,IMP
 CHARACTER(LEN=256) :: SFNAME
 
 PMANAGER_SAVEMF2005_SFT_READ=.TRUE.

 !## use sft1
 IF(TOPICS(TSFT)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_SFT_READ=.FALSE.

 !## sft settings
 ITOPIC=TSFT; IINV=0; SCL_D=1

 DO I=1,SIZE(SFT); CALL IDFCOPY(PRJIDF,SFT(I)); ENDDO
 
 !## allocate memory for packages
 NTOP=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,1); NSYS=SIZE(TOPICS(ITOPIC)%STRESS(1)%FILES,2)

 !## number of systems
 DO ISYS=1,NSYS

  !## number of subtopics
  DO KTOP=1,NTOP

   ICNST =TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%ICNST 
   CNST  =TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%CNST  
   FCT   =TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%FCT   
   IMP   =TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%IMP   
   ILAY  =TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%ILAY  
   !## always layer
   ILAY  =1
   SFNAME=TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%FNAME 

   WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
      ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(SFNAME)//CHAR(39)

   !## thickness in meters
   IF(KTOP.EQ.1)THEN
   
    !## constant value
    IF(ICNST.EQ.1)THEN
     SFT(1)%X=CNST
    !## read/clip/scale idf file
    ELSEIF(TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%ICNST.EQ.2)THEN
     SFT(1)%FNAME=SFNAME
     SCL_U=2
     IF(.NOT.IDFREADSCALE(SFT(1)%FNAME,SFT(1),SCL_U,SCL_D,1.0D0,0))RETURN
    ENDIF
    CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,SFT(1),FCT,IMP,SCL_D)
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SFT(1),0,ITOPIC)
   
   !## geometric for permeability
   ELSEIF(KTOP.EQ.2)THEN

    !## constant value
    IF(ICNST.EQ.1)THEN
     SFT(2)%X=CNST
    !## read/clip/scale idf file
    ELSEIF(TOPICS(ITOPIC)%STRESS(1)%FILES(KTOP,ISYS)%ICNST.EQ.2)THEN
     SFT(2)%FNAME=SFNAME
     SCL_U=3
     IF(.NOT.IDFREADSCALE(SFT(ILAY)%FNAME,SFT(2),SCL_U,SCL_D,1.0D0,0))RETURN
    ENDIF
    CALL PMANAGER_SAVEMF2005_FCTIMP(0,ICNST,SFT(2),FCT,IMP,SCL_D)
    CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,SFT(2),0,ITOPIC)

   ENDIF   
  
  ENDDO 
 ENDDO  
 
 PMANAGER_SAVEMF2005_SFT_READ=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_SFT_READ
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_TDIS(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU,KPER
 CHARACTER(LEN=52) :: CLINE
 
 PMANAGER_SAVEMF2005_TDIS=.TRUE.; IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)RETURN

 !## file already written
 IF(PBMAN%ISUBMODEL.GT.1)RETURN

 PMANAGER_SAVEMF2005_TDIS=.FALSE.
 
 !## construct pcg-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.TDIS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# TDIS6 File Generated by '//TRIM(UTL_IMODVERSION())

 WRITE(IU,'(/A/)') '#General Options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 WRITE(IU,'(A)') ' TIME_UNITS DAYS'
 DO KPER=1,PRJNPER; IF(SIM(KPER)%DELT.GT.0.0D0)EXIT; ENDDO
 IF(KPER.LE.PRJNPER)THEN
  WRITE(IU,'(A)') ' START_DATE_TIME '//TRIM(ITOS(SIM(KPER)%IYR))//'-'//TRIM(ITOS(SIM(KPER)%IMH))//'-'//TRIM(ITOS(SIM(KPER)%IDY))// &
    'T00:00:00TZD+01:00'
 ENDIF
 WRITE(IU,'(A)') 'END OPTIONS'

 WRITE(IU,'(/A/)') '#Time Dimensions'
 WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
 WRITE(IU,'(A)') ' NPER '//TRIM(ITOS(PRJNPER))
 WRITE(IU,'(A)') 'END DIMENSIONS'

 WRITE(IU,'(/A/)') '#Stress periods'
 WRITE(IU,'(A)') 'BEGIN PERIODDATA'
 !## time information
 DO KPER=1,PRJNPER
  !## set delt.eq.1 otherwise MF6 won't work
  IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
   IF(PRJNPER.EQ.1)THEN
    LINE=TRIM(RTOS(1.0D0,'G',7))//','// &
         TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
         TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
   ELSE
    LINE=TRIM(RTOS(0.0D0,'G',7))//','// &
         TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
         TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
   ENDIF
  ELSE
!   KKPER=KPER; IF(PBMAN%ISAVEENDDATE.EQ.1)KKPER=KKPER+1
   LINE=TRIM(RTOS(SIM(KPER)%DELT,'G',7))//','// &
        TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
        TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
  ENDIF
  IF(SIM(KPER)%DELT.EQ.0.0D0)THEN
   LINE=TRIM(LINE)//' ['//TRIM(SIM(KPER)%CDATE)//'] ['//TRIM(SIM(KPER)%CDATE)//']'
  ELSE
   CLINE=TRIM(SIM(KPER+1)%CDATE) !TRIM(ITOS_DBL(ADD_DT_TO_IDATE(SIM(KPER)%IYR,SIM(KPER)%IMH,SIM(KPER)%IDY,SIM(KPER)%IHR,SIM(KPER)%IMT,SIM(KPER)%ISC,SIM(KPER)%DELT,0)))
   LINE =TRIM(LINE)//' ['//TRIM(SIM(KPER)%CDATE)//'] ['//TRIM(CLINE)//']'
  ENDIF
  WRITE(IU,'(A)') ' '//TRIM(LINE)
 ENDDO
 WRITE(IU,'(A)') 'END PERIODDATA'
 CLOSE(IU)

 PMANAGER_SAVEMF2005_TDIS=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_TDIS
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MET(DIRIN,DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRIN,DIRMNAME
 INTEGER :: IU,KPER,I,N1,N2
 CHARACTER(LEN=256) :: DIR,KEYWORD
 
 IF(PBMAN%OUTPUT.NE.'')THEN
  DIR=PBMAN%OUTPUT
 ELSE
  DIR=TRIM(DIRIN(:INDEX(DIRIN,'\',.TRUE.)-1))
 ENDIF
 
 PMANAGER_SAVEMF2005_MET=.TRUE.; IF(PBMAN%IFORMAT.EQ.3)RETURN
 PMANAGER_SAVEMF2005_MET=.FALSE.
 
 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  IF(PEST%PE_MXITER.LT.0)THEN
   N1=-1; N2=N1
  ELSE
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  ENDIF
 ELSEIF(PBMAN%IIES.EQ.1)THEN
  N1=1; N2=PEST%NREALS
 ENDIF
 DO I=N1,N2
  !## skip zero
  IF(I.EQ.0)CYCLE
  IU=UTL_GETUNIT()
  IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.MET7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ELSEIF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_P#'//TRIM(ITOS(I))//'.MET7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ELSE
    CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.MET7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_R#'//TRIM(ITOS(I))//'.MET7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  ENDIF
  IF(IU.EQ.0)RETURN

  WRITE(IU,'(A)') '# MET7 File Generated by '//TRIM(UTL_IMODVERSION())
  LINE='COORD_XLL '//TRIM(RTOS(PRJIDF%XMIN,'F',3))  ; WRITE(IU,'(A)') TRIM(LINE)
  LINE='COORD_YLL '//TRIM(RTOS(PRJIDF%YMIN,'F',3))  ; WRITE(IU,'(A)') TRIM(LINE)
  LINE='COORD_XLL_NB '//TRIM(RTOS(PBMAN%XMIN,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
  LINE='COORD_YLL_NB '//TRIM(RTOS(PBMAN%YMIN,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
  LINE='COORD_XUR_NB '//TRIM(RTOS(PBMAN%XMAX,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
  LINE='COORD_YUR_NB '//TRIM(RTOS(PBMAN%YMAX,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
!  LINE='COORD_XLL_NB '//TRIM(RTOS(PRJIDF%XMIN,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
!  LINE='COORD_YLL_NB '//TRIM(RTOS(PRJIDF%YMIN,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
!  LINE='COORD_XUR_NB '//TRIM(RTOS(PRJIDF%XMAX,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
!  LINE='COORD_YUR_NB '//TRIM(RTOS(PRJIDF%YMAX,'F',3)); WRITE(IU,'(A)') TRIM(LINE)
  !## look for first
  DO KPER=1,PRJNPER; IF(SIM(KPER)%DELT.GT.0.0D0)EXIT; ENDDO
  IF(KPER.LE.PRJNPER)THEN
   IF(PBMAN%IFORMAT.EQ.6)THEN
    LINE='START_YEAR '//TRIM(ITOS(SIM(KPER)%IYR));  WRITE(IU,'(A)') TRIM(LINE)
    LINE='START_MONTH '//TRIM(ITOS(SIM(KPER)%IMH)); WRITE(IU,'(A)') TRIM(LINE)
    LINE='START_DAY '//TRIM(ITOS(SIM(KPER)%IDY));   WRITE(IU,'(A)') TRIM(LINE)
   ELSE
    LINE='STARTTIME YEAR '//TRIM(ITOS(SIM(KPER)%IYR))//' MONTH '//TRIM(ITOS(SIM(KPER)%IMH))//' DAY '//TRIM(ITOS(SIM(KPER)%IDY))
    WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  ENDIF
  KEYWORD='RESULTDIR'; IF(PBMAN%IFORMAT.EQ.6)KEYWORD='RESULT_DIR'
  IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
   LINE=TRIM(KEYWORD)//' "'//TRIM(DIR)//'"'; WRITE(IU,'(A)') TRIM(LINE)
  ELSEIF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    LINE=TRIM(KEYWORD)//' "'//TRIM(DIR)//'\IPEST_P#'//TRIM(ITOS(I))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ELSE
    LINE=TRIM(KEYWORD)//' "'//TRIM(DIR)//'\IPEST_L#'//TRIM(ITOS(ABS(I)))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   IF(I.GT.0)THEN
    LINE=TRIM(KEYWORD)//' "'//TRIM(DIR)//'\IIES_R#'//TRIM(ITOS(I))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ELSE
    LINE=TRIM(KEYWORD)//' "'//TRIM(DIR)//'\IIES_L#'//TRIM(ITOS(ABS(I)))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  ENDIF
  IF(PBMAN%IPEST+PBMAN%IPESTP.GT.0.AND.PBMAN%IFORMAT.NE.6)THEN
   LINE='IPESTPDIR "'//TRIM(DIR)//'"'; WRITE(IU,'(A)') TRIM(LINE)
  ENDIF
  LINE='SAVEDOUBLE '//TRIM(ITOS(PBMAN%IDOUBLE)); WRITE(IU,'(A)') TRIM(LINE)
  IF(PBMAN%IFORMAT.NE.6)THEN; LINE='SAVEDATE 1'; WRITE(IU,'(A)') TRIM(LINE); ENDIF
  CLOSE(IU)
 ENDDO
 
 PMANAGER_SAVEMF2005_MET=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_MET

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_HFB(IBATCH,DIRMNAME,IPRT,LTB)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,IPRT
 LOGICAL,INTENT(IN) :: LTB
 INTEGER :: IU,JU,ILAY,ITOPIC,NPHFB,MXFB,HFBNPER,IPER,KPER,INAN
 INTEGER(KIND=DP_KIND) :: ITIME,JTIME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IUGEN,IUDAT,NHFBNP
 CHARACTER(LEN=1) :: VTXT
 CHARACTER(LEN=12) :: CHFBTRAN
 CHARACTER(LEN=256) :: FNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: NNAN
 
 PMANAGER_SAVEMF2005_HFB=.TRUE.; IF(TOPICS(THFB)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_HFB=.FALSE.

 ITOPIC=THFB; VTXT='7'; IF(PBMAN%IFORMAT.EQ.3)VTXT='6' 
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.HFB'//VTXT//'...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.HFB'//VTXT//'...'
 
 HFBNPER=1; IF(TOPICS(THFB)%TIMDEP)HFBNPER=PRJNPER; ALLOCATE(NNAN(HFBNPER))
 
 CHFBTRAN=''; IF(TOPICS(THFB)%TIMDEP)CHFBTRAN='HFBTRAN'
 
 !## construct hfb-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.HFB'//VTXT//'_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# HFB'//VTXT//' File Generated by '//TRIM(UTL_IMODVERSION())

 IF(PBMAN%IFORMAT.EQ.3)THEN
  WRITE(IU,'(/A/)') '#General Options'  
  WRITE(IU,'(A)') 'BEGIN OPTIONS'
!  WRITE(IU,'(A)') ' PRINT_INPUT'
  WRITE(IU,'(A)') 'END OPTIONS'
  WRITE(IU,'(/A/)') '#General Dimensions'  
  WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
  WRITE(IU,'(1X,A)') ' MAXHFB NaN1#'
  WRITE(IU,'(A)') 'END DIMENSIONS'
 ENDIF

 CALL UTL_CREATEDIR(DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN')
 
 !## is the number of horizontal-flow barrier parameters
 NPHFB=0 
 !## is the number of HFB barriers not defined by parameters
 MXFB=0
 !## number of faults
 ALLOCATE(NHFBNP(PRJNLAY))
 
 !## apply resistances
 IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
  IF(LTB)THEN
   WRITE(IU,'(2I10,A)') NPHFB,MXFB,',NaN1# NOPRINT HFBRESIS SYSTEM '//TRIM(CHFBTRAN)
  ELSE
   WRITE(IU,'(2I10,A)') NPHFB,MXFB,',NaN1# NOPRINT HFBFACT SYSTEM '//TRIM(CHFBTRAN) 
  ENDIF
 ENDIF

 INAN=0; NNAN=0; DO IPER=1,HFBNPER
 
  IF(TOPICS(THFB)%TIMDEP)THEN

   !## get appropriate stress-period to store in runfile   
   KPER=PMANAGER_GETCURRENTIPER(IPER,ITOPIC,ITIME,JTIME)

   !## output
   WRITE(IPRT,'(1X,A,2I10,2(1X,I14))') 'Exporting timestep ',IPER,KPER,ITIME,JTIME  
   IF(IBATCH.EQ.1)WRITE(6,'(A,3I6,2(1X,I14))') '+Exporting timestep ',IPER,PRJNPER,KPER,ITIME,JTIME  
  
   !## reuse previous timestep
   IF(KPER.LE.0)THEN
    IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
     IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
     ELSE; WRITE(IU,'(I10)') -1; ENDIF
    ENDIF
    !## goto next timestep
    CYCLE
   ENDIF

  ELSE
   KPER=1
  ENDIF
 
  IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))

  !## creating and collect all faults
  FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_HFB.TXT'
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  IF(.NOT.PMANAGER_SAVEMF2005_HFB_COMPUTE(PRJIDF,ITOPIC,JU,BND,TOP,BOT,IPRT,IBATCH,KPER))RETURN
 
  ALLOCATE(IUGEN(PRJNLAY),IUDAT(PRJNLAY)); IUGEN=0; IUDAT=0
  DO ILAY=1,PRJNLAY
   IF(.NOT.TOPICS(THFB)%TIMDEP)THEN
    FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_HFB_L'//TRIM(ITOS(ILAY))//'.GEN'
   ELSE
    IF(ITIME.EQ.0D0)THEN
     FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_STEADY-STATE_HFB_L'//TRIM(ITOS(ILAY))//'.GEN'
    ELSE
     FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_'//TRIM(ITOS_DBL(ITIME))//'_HFB_L'//TRIM(ITOS(ILAY))//'.GEN'
    ENDIF
   ENDIF
   IUGEN(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(IUGEN(ILAY),FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   IF(IUGEN(ILAY).EQ.0)RETURN
   IF(.NOT.TOPICS(THFB)%TIMDEP)THEN
    FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_HFB_L'//TRIM(ITOS(ILAY))//'.DAT'
   ELSE
    IF(ITIME.EQ.0D0)THEN
     FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_STEADY-STATE_HFB_L'//TRIM(ITOS(ILAY))//'.DAT'
    ELSE
     FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_'//TRIM(ITOS_DBL(ITIME))//'_HFB_L'//TRIM(ITOS(ILAY))//'.DAT'
    ENDIF
   ENDIF
   IUDAT(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(IUDAT(ILAY),FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
   IF(IUDAT(ILAY).EQ.0)RETURN
   IF(LTB)THEN
    WRITE(IUDAT(ILAY),'(A10,3(1X,A15),6A10)') 'NO','CONF_RESIS','UNCONF_RESIS','FRACTION','SYSTEM','ICOL1','IROW1','ICOL2','IROW2','IBND'
   ELSE
    WRITE(IUDAT(ILAY),'(A10,1X,A15,6A10)') 'NO','FRACTION','SYSTEM','ICOL1','IROW1','ICOL2','IROW2','IBND'
   ENDIF
  ENDDO

  !## collect all faults
  FNAME=DIRMNAME(:INDEX(DIRMNAME,'\',.TRUE.)-1)//'\GEN\'//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_HFB.TXT'
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED')
  INAN=INAN+1; IF(TOPICS(THFB)%TIMDEP)WRITE(IU,'(A)') 'NaN'//TRIM(ITOS(INAN))//'#'
  NHFBNP=0; CALL PMANAGER_SAVEMF2005_HFB_EXPORT(NHFBNP,IU,JU,IUGEN,IUDAT,PRJIDF,LTB); NNAN(INAN)=SUM(NHFBNP)
  
  DO ILAY=1,PRJNLAY
   IF(NHFBNP(ILAY).GT.0)THEN
    CLOSE(IUGEN(ILAY)); CLOSE(IUDAT(ILAY))
   ELSE
    CLOSE(IUGEN(ILAY),STATUS='DELETE'); CLOSE(IUDAT(ILAY),STATUS='DELETE')
   ENDIF
  ENDDO

  DEALLOCATE(IUGEN,IUDAT)
 
  IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD'
  CLOSE(JU,STATUS='DELETE') 
 
 ENDDO
 
 !## close hfb file
 CLOSE(IU)

 CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.HFB'//VTXT//'_',NNAN) !(/SUM(NHFBNP)/)) 
 
 DEALLOCATE(NHFBNP,NNAN)
 
 PMANAGER_SAVEMF2005_HFB=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_HFB
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_OCD(DIRMNAME,MAINDIR)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME,MAINDIR
 CHARACTER(LEN=256) :: NAME
 INTEGER :: IU,JU,ILAY,IPER,I,J,K,IFLX,N1,N2
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_OCD=.FALSE.
  
 JU=0
 
 IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN
  IF(PBMAN%IPESTP.EQ.1)THEN
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'_L.OC',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
   WRITE(IU,'(A)') '# OC File Generated by '//TRIM(UTL_IMODVERSION())
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(DIRMNAME)//'_P.OC',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
   WRITE(JU,'(A)') '# OC File Generated by '//TRIM(UTL_IMODVERSION())
  ELSE
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.OC',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
   WRITE(IU,'(A)') '# OC File Generated by '//TRIM(UTL_IMODVERSION())
  ENDIF
  
  IF(TOPICS(TSCO)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TSCO)%ILAY,'SAVECONCLAYER',0,IU) 

  LINE='HEAD SAVE UNIT '//TRIM(ITOS(IHEDUN)); WRITE(IU,'(A)') TRIM(LINE)
  IF(JU.GT.0)WRITE(JU,'(A)') TRIM(LINE)
  DO IFLX=1,SIZE(TFLX)
   IF(ASSOCIATED(PBMAN%ISAVE(TFLX(IFLX))%ILAY))EXIT
  ENDDO; IF(IFLX.GT.SIZE(TFLX))IFLX=0
    
  LEX=.FALSE.; IF(PBMAN%IPESTP.EQ.1)LEX=.TRUE.
  IF(PBMAN%ISS.EQ.1.AND.PBMAN%ISTEADY.EQ.0)LEX=.FALSE.

  DO IPER=1,PRJNPER
 
   LINE='PERIOD '//TRIM(ITOS(IPER))//' STEP '//TRIM(ITOS(SIM(IPER)%NSTP)); WRITE(IU,'(A)') TRIM(LINE)
   IF(JU.GT.0)WRITE(JU,'(A)') TRIM(LINE)
   LINE='PRINT BUDGET'; WRITE(IU,'(A)') TRIM(LINE)
   IF(JU.GT.0)WRITE(JU,'(A)') TRIM(LINE)

   !## save all head for l-versions (overwrite given settings), only in case steady-state or transient/isteady=1 and in case mxiter>0
   IF(PBMAN%IPESTP.EQ.1)THEN
    LINE='SAVE HEAD'
    IF(LEX.AND.PEST%PE_MXITER.GT.0)THEN !
     DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO
    ELSE
     IF(ASSOCIATED(PBMAN%ISAVE(TSHD)%ILAY))THEN
      IF(PBMAN%ISAVE(TSHD)%ILAY(1).EQ.-1)THEN
       DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO
      ELSE
       DO ILAY=1,SIZE(PBMAN%ISAVE(TSHD)%ILAY); LINE=TRIM(LINE)//' '//TRIM(ITOS(PBMAN%ISAVE(TSHD)%ILAY(ILAY))); ENDDO
      ENDIF
     ENDIF
    ENDIF
    WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
   IF(ASSOCIATED(PBMAN%ISAVE(TSHD)%ILAY))THEN
    IF(PBMAN%ISAVE(TSHD)%ILAY(1).EQ.-1)THEN
     LINE='SAVE HEAD'; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO
     IF(JU.EQ.0)WRITE(IU,'(A)') TRIM(LINE); IF(JU.GT.0)WRITE(JU,'(A)') TRIM(LINE)
    ELSE
     LINE='SAVE HEAD'; DO ILAY=1,SIZE(PBMAN%ISAVE(TSHD)%ILAY); LINE=TRIM(LINE)//' '//TRIM(ITOS(PBMAN%ISAVE(TSHD)%ILAY(ILAY))); ENDDO
     IF(JU.EQ.0)WRITE(IU,'(A)') TRIM(LINE); IF(JU.GT.0)WRITE(JU,'(A)') TRIM(LINE)
    ENDIF
   ENDIF
   
   !## write output fluxes
   IF(IFLX.GT.0)THEN
    IF(ASSOCIATED(PBMAN%ISAVE(TFLX(IFLX))%ILAY))THEN
     CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TFLX(IFLX))%ILAY,'BUDGET',IBCFCB,IU)
    ENDIF
   ENDIF

   IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TCAP)%ILAY,'BUDGET',ICAPCB,IU)
   IF(TOPICS(TUZF)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TUZF)%ILAY,'BUDGET',IUZFCB1,IU)
   IF(TOPICS(TSFR)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TSFR)%ILAY,'BUDGET',ISFRCB,IU)
   IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TFHB)%ILAY,'BUDGET',IFHBCB,IU)

   IF(TOPICS(TDRN)%IACT_MODEL.EQ.1)THEN
    CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TDRN)%ILAY,'BUDGET',IDRNCB,IU)
   ELSE
    IF(TOPICS(TOLF)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TOLF)%ILAY,'BUDGET',IDRNCB,IU)
   ENDIF
   IF(TOPICS(TRIV)%IACT_MODEL.EQ.1)THEN
    CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TRIV)%ILAY,'BUDGET',IRIVCB,IU)
   ELSE
    IF(TOPICS(TISG)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TISG)%ILAY,'BUDGET',IRIVCB,IU)
   ENDIF
   IF(TOPICS(TGHB)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TGHB)%ILAY,'BUDGET',IGHBCB,IU)
   IF(TOPICS(TWEL)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TWEL)%ILAY,'BUDGET',IWELCB,IU)
   IF(TOPICS(TRCH)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TRCH)%ILAY,'BUDGET',IRCHCB,IU)
   IF(TOPICS(TEVT)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TEVT)%ILAY,'BUDGET',IEVTCB,IU)
   IF(TOPICS(TMNW)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TMNW)%ILAY,'BUDGET',IWL2CB,IU)
   IF(TOPICS(TLAK)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TLAK)%ILAY,'BUDGET',ILAKCB,IU) 
   IF(TOPICS(TSCR)%IACT_MODEL.EQ.1)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TSCR)%ILAY,'SUBCR' ,ISCRCB,IU) 
   
  ENDDO

  CLOSE(IU); IF(JU.GT.0)CLOSE(JU)

 ELSEIF(PBMAN%IFORMAT.EQ.3)THEN
 
 !## write *.ocd file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   IF(PEST%PE_MXITER.LT.0)THEN
    N1=-1; N2=N1
   ELSE
    N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   N1=1; N2=PEST%NREALS
  ENDIF
  
  DO I=N1,N2
   !## skip zero
   IF(I.EQ.0)CYCLE
   IU=UTL_GETUNIT()
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    NAME=TRIM(DIRMNAME)//'.OC6'
   ELSEIF(PBMAN%IPESTP.EQ.1)THEN
    IF(I.GT.0)THEN
     IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
     NAME=TRIM(DIRMNAME)//'_P#'//TRIM(ITOS(I))//'.OC6'
    ELSE
     NAME=TRIM(DIRMNAME)//'_L#'//TRIM(ITOS(ABS(I)))//'.OC6'
    ENDIF
   ELSEIF(PBMAN%IIES.EQ.1)THEN
    NAME=TRIM(DIRMNAME)//'_R#'//TRIM(ITOS(I))//'.OC6'
   ENDIF
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=NAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
   
   IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
    NAME='GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELOUTPUT'
   ELSEIF(PBMAN%IPESTP.EQ.1)THEN
    IF(I.GT.0)THEN
     IF(PEST%PARAM(I)%PACT.EQ.0.OR.PEST%PARAM(I)%PIGROUP.LT.0)CYCLE
     NAME='GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELOUTPUT'//'\IPEST_P#'//TRIM(ITOS(I))
    ELSE
     NAME='GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELOUTPUT'//'\IPEST_L#'//TRIM(ITOS(ABS(I)))
    ENDIF
   ELSEIF(PBMAN%IIES.EQ.1)THEN
    NAME='GWF_'//TRIM(ITOS(PBMAN%ISUBMODEL))//'\MODELOUTPUT'//'\IPEST_R#'//TRIM(ITOS(ABS(I)))
   ENDIF

   WRITE(IU,'(A)') '# OC6 File Generated by '//TRIM(UTL_IMODVERSION())
   WRITE(IU,'(/A/)') '#General Options'
   WRITE(IU,'(A)') 'BEGIN OPTIONS'
   LSHD=.FALSE.; LBDG=.FALSE.
   DO J=1,SIZE(MC(3)%T)
    K=MC(3)%T(J)
    SELECT CASE (K)
     CASE (TCHD,TSHD)
      IF(ASSOCIATED(PBMAN%ISAVE(K)%ILAY).AND..NOT.LSHD)THEN
       LSHD=.TRUE.
       IF(PBMAN%IPESTP.EQ.1)THEN
        WRITE(IU,'(1X,A)') 'HEAD FILEOUT ..\'//TRIM(NAME)//'\HEAD\HEAD.HED'
       ELSE
        WRITE(IU,'(1X,A)') 'HEAD FILEOUT .\'//TRIM(NAME)//'\HEAD\HEAD.HED'
       ENDIF
      ENDIF
     CASE DEFAULT
      IF(ASSOCIATED(PBMAN%ISAVE(K)%ILAY).AND..NOT.LBDG)THEN
       LBDG=.TRUE.
       IF(PBMAN%IPESTP.EQ.1)THEN
        WRITE(IU,'(1X,A)') 'BUDGET FILEOUT ..\'//TRIM(NAME)//'\BUDGET\BUDGET.CBC'
       ELSE
        WRITE(IU,'(1X,A)') 'BUDGET FILEOUT .\'//TRIM(NAME)//'\BUDGET\BUDGET.CBC'
       ENDIF
      ENDIF
    END SELECT
   ENDDO
   CALL UTL_CREATEDIR(TRIM(MAINDIR)//'\'//TRIM(NAME))
   IF(LSHD)CALL UTL_CREATEDIR(TRIM(MAINDIR)//'\'//TRIM(NAME)//'\HEAD')
   IF(LBDG)CALL UTL_CREATEDIR(TRIM(MAINDIR)//'\'//TRIM(NAME)//'\BUDGET')
   WRITE(IU,'(A)') 'END OPTIONS'
 
   DO IPER=1,PRJNPER
 
    WRITE(IU,'(/A/)') '#Stressperiod Save Options'
    WRITE(IU,'(A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))
    IF(LSHD)WRITE(IU,'(A)') ' SAVE HEAD ALL'
    IF(LBDG)WRITE(IU,'(A)') ' SAVE BUDGET ALL'
    WRITE(IU,'(A)') 'END PERIOD'
  
   ENDDO
  
   CLOSE(IU); IF(JU.GT.0)CLOSE(JU)
   
  ENDDO
  
 ENDIF
 
! CLOSE(IU); IF(JU.GT.0)CLOSE(JU)
 
 PMANAGER_SAVEMF2005_OCD=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_OCD
 
 !####====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_OCD_ISAVE(ISAVE,SWHAT,ID,IU)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),POINTER,DIMENSION(:) :: ISAVE
 CHARACTER(LEN=*),INTENT(IN) :: SWHAT
 INTEGER,INTENT(IN) :: ID,IU
 INTEGER :: I

 IF(ASSOCIATED(ISAVE))THEN
  IF(ISAVE(1).EQ.-1)THEN
   IF(ID.EQ.0)THEN
    LINE=TRIM(SWHAT); DO I=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(I)); ENDDO
   ELSE
    LINE='SAVE '//TRIM(SWHAT)//' '//TRIM(ITOS(ID)); DO I=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(I)); ENDDO
   ENDIF
  ELSE
   IF(ID.EQ.0)THEN
    LINE=TRIM(SWHAT); DO I=1,SIZE(ISAVE); LINE=TRIM(LINE)//' '//TRIM(ITOS(ISAVE(I))); ENDDO
   ELSE
    LINE='SAVE '//TRIM(SWHAT)//' '//TRIM(ITOS(ID)); DO I=1,SIZE(ISAVE); LINE=TRIM(LINE)//' '//TRIM(ITOS(ISAVE(I))); ENDDO
   ENDIF
  ENDIF
  WRITE(IU,'(A)') TRIM(LINE)
 ENDIF

 END SUBROUTINE PMANAGER_SAVEMF2005_OCD_ISAVE
 
 !####====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_RUN_ISAVE(ISAVE,CID,IU)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),POINTER,DIMENSION(:) :: ISAVE
 CHARACTER(LEN=*),INTENT(IN) :: CID
 INTEGER,INTENT(IN) :: IU
 INTEGER :: I,N
  
 IF(ASSOCIATED(ISAVE))THEN
  IF(ISAVE(1).EQ.-1)THEN
   LINE='1,1,0'
  ELSE
   N=SIZE(ISAVE)
   LINE='1,'//TRIM(ITOS(N)); DO I=1,SIZE(ISAVE); LINE=TRIM(LINE)//','//TRIM(ITOS(ISAVE(I))); ENDDO
  ENDIF
 ELSE
  LINE='1,0'
 ENDIF
 LINE=TRIM(LINE)//' '//TRIM(CID)

 WRITE(IU,'(A)') TRIM(LINE)
 
 END SUBROUTINE PMANAGER_SAVEMF2005_RUN_ISAVE

 !####====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MF6TOIDF_ISAVE(ISAVE,CID,IU)
 !####====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),POINTER,DIMENSION(:) :: ISAVE
 CHARACTER(LEN=*),INTENT(IN) :: CID
 INTEGER,INTENT(IN) :: IU
  
 IF(ASSOCIATED(ISAVE))THEN
  LINE=ITOS(ISAVE(1)); DO I=2,SIZE(ISAVE); LINE=TRIM(LINE)//','//TRIM(ITOS(ISAVE(I))); ENDDO
  LINE=TRIM(CID)//'='//TRIM(LINE)
  WRITE(IU,'(A)') 'ECHO '//TRIM(LINE)//' >> MF6TOIDF.INI'
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEMF2005_MF6TOIDF_ISAVE

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCG(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU

 PMANAGER_SAVEMF2005_PCG=.TRUE.

 IF(TOPICS(TPCG)%IACT_MODEL.EQ.0)RETURN; IF(PBMAN%IFORMAT.EQ.3)RETURN

 PMANAGER_SAVEMF2005_PCG=.FALSE.

 !## construct pcg-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.PCG7',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# PCG7 File Generated by '//TRIM(UTL_IMODVERSION())
 CALL PMANAGER_SAVEPCG(IU,2)
 CLOSE(IU)
 
 PMANAGER_SAVEMF2005_PCG=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_PCG

 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_GCG(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU,ISOLVE,NCRS

 PMANAGER_SAVEMF2005_GCG=.TRUE.

 IF(TOPICS(TGCG)%IACT_MODEL.EQ.0)RETURN; IF(PBMAN%IFORMAT.NE.6.OR.WQ%VDF%MTDNCONC.EQ.0)RETURN

 PMANAGER_SAVEMF2005_GCG=.FALSE.

 !## construct pcg-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.GCG1',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 !## use Jacob; dispersion tensor crossterm 
 WRITE(IU,'(4I10)') WQ%GCG%MXITER,WQ%GCG%ITER1,WQ%GCG%ISOLVE,WQ%GCG%NCRS
 WRITE(IU,'(F10.2,F15.7,I10)') WQ%GCG%ACCL,WQ%GCG%CCLOSE,WQ%GCG%IPRGCG

 CLOSE(IU)
 
 PMANAGER_SAVEMF2005_GCG=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_GCG
 
!####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_IMS(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU,ILAY

 PMANAGER_SAVEMF2005_IMS=.TRUE.; IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)RETURN

 PMANAGER_SAVEMF2005_IMS=.FALSE.

 !## construct pcg-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.IMS6',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# IMS6 File Generated by '//TRIM(UTL_IMODVERSION())

 WRITE(IU,'(/A/)') '#General options'
 WRITE(IU,'(A)') 'BEGIN OPTIONS'
 WRITE(IU,'(A)') ' PRINT_OPTION SUMMARY'
 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
  WRITE(IU,'(A)') ' COMPLEXITY COMPLEX'  !## complex
 ELSE
  WRITE(IU,'(A)') ' COMPLEXITY '//PBMAN%COMPLEXITY
 ENDIF
! WRITE(IU,'(A)') ' COMPLEXITY '//TRIM(PBMAN%TCOMPLEX) !MODERATE'  !## simple complex
! DO ILAY=1,PRJNLAY
!  IF(LAYCON(ILAY).EQ.2)THEN
!   WRITE(IU,'(A)') ' COMPLEXITY COMPLEX'; EXIT
!  ENDIF
! ENDDO
! IF(ILAY.GT.PRJNLAY)THEN
!  ELSE
!   WRITE(IU,'(A)') ' COMPLEXITY MODERATE' !## moderate
!  ENDIF
! ENDIF
 WRITE(IU,'(A)') ' CSV_OUTER_OUTPUT FILEOUT '//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_OUTER.CSV'
 WRITE(IU,'(A)') ' CSV_INNER_OUTPUT FILEOUT '//TRIM(DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:))//'_INNER.CSV'
 WRITE(IU,'(A)') 'END OPTIONS'

!## set by complexity
 WRITE(IU,'(/A/)') '#Nonlinear options'
 WRITE(IU,'(A)') 'BEGIN NONLINEAR'
 WRITE(IU,'(A,G15.7)') ' OUTER_DVCLOSE ',PCG%HCLOSE
 WRITE(IU,'(A,I10)')   ' OUTER_MAXIMUM ',PCG%NOUTER
! WRITE(IU,'(A)') ' [UNDER_RELAXATION <under_relaxation>]'
! WRITE(IU,'(A)') ' [UNDER_RELAXATION_THETA <under_relaxation_theta>]'
! WRITE(IU,'(A)') ' [UNDER_RELAXATION_KAPPA <under_relaxation_kappa>]'
! WRITE(IU,'(A)') ' [UNDER_RELAXATION_GAMMA <under_relaxation_gamma>]'
! WRITE(IU,'(A)') ' [UNDER_RELAXATION_MOMENTUM <under_relaxation_momentum>]'
! WRITE(IU,'(A)') ' [BACKTRACKING_NUMBER <backtracking_number>]'
! WRITE(IU,'(A)') ' [BACKTRACKING_TOLERANCE <backtracking_tolerance>]'
! WRITE(IU,'(A)') ' [BACKTRACKING_REDUCTION_FACTOR <backtracking_reduction_factor>]'
! WRITE(IU,'(A)') ' [BACKTRACKING_RESIDUAL_LIMIT <backtracking_residual_limit>]'
 WRITE(IU,'(A)') 'END NONLINEAR'

 WRITE(IU,'(/A/)') '#Linear options'
 WRITE(IU,'(A)')       'BEGIN LINEAR'
 WRITE(IU,'(A,I10)')   ' INNER_MAXIMUM ',PCG%NINNER
 WRITE(IU,'(A,G15.7)') ' INNER_DVCLOSE ',PCG%HCLOSE
 WRITE(IU,'(A,G15.7)') ' INNER_RCLOSE ',PCG%RCLOSE
! WRITE(IU,'(A)')       ' LINEAR_ACCELERATION CG'
! WRITE(IU,'(A,G15.7)') ' RELAXATION_FACTOR ',PCG%RELAX <--- deze niet gebruiken, default values hanteren
! WRITE(IU,'(A)') ' [PRECONDITIONER_LEVELS <preconditioner_levels>]'
! WRITE(IU,'(A)') ' [PRECONDITIONER_DROP_TOLERANCE <preconditioner_drop_tolerance>]'
! WRITE(IU,'(A)') ' [NUMBER_ORTHOGONALIZATIONS <number_orthogonalizations>]'
! WRITE(IU,'(A)') ' [SCALING_METHOD <scaling_method>]'
! WRITE(IU,'(A)') ' [REORDERING_METHOD <reordering_method>]'
 WRITE(IU,'(A)')      'END LINEAR'

 CLOSE(IU)
 
 PMANAGER_SAVEMF2005_IMS=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_IMS

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEPCG(IU,IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,IOPTION

 !## prj file
 IF(IOPTION.EQ.0)THEN
  WRITE(IU,'(1X,A)') 'MXITER=  '//TRIM(ITOS(PCG%NOUTER))
  WRITE(IU,'(1X,A)') 'ITER1=   '//TRIM(ITOS(PCG%NINNER))
  WRITE(IU,'(1X,A)') 'HCLOSE=  '//TRIM(RTOS(PCG%HCLOSE,'G',7))
  WRITE(IU,'(1X,A)') 'RCLOSE=  '//TRIM(RTOS(PCG%RCLOSE,'G',7))
  WRITE(IU,'(1X,A)') 'RELAX=   '//TRIM(RTOS(PCG%RELAX,'G',7))
  WRITE(IU,'(1X,A)') 'NPCOND=  '//TRIM(ITOS(PCG%NPCOND))
  WRITE(IU,'(1X,A)') 'IPRPCG=  '//TRIM(ITOS(PCG%IPRPCG))
  WRITE(IU,'(1X,A)') 'MUTPCG=  '//TRIM(ITOS(PCG%MUTPCG))
  WRITE(IU,'(1X,A)') 'DAMPPCG= '//TRIM(RTOS(PCG%DAMPPCG,'G',7))
  WRITE(IU,'(1X,A)') 'DAMPPCGT='//TRIM(RTOS(PCG%DAMPPCGT,'G',7))
  WRITE(IU,'(1X,A)') 'IQERROR= '//TRIM(ITOS(PCG%IQERROR))
  WRITE(IU,'(1X,A)') 'QERROR=  '//TRIM(RTOS(PCG%QERROR,'G',7))

 !## run file
 ELSEIF(IOPTION.EQ.1)THEN
 
 !## mf2005 file
 ELSEIF(IOPTION.EQ.2)THEN
  LINE=TRIM(ITOS(PCG%NOUTER))         //','// &
       TRIM(ITOS(PCG%NINNER))         //','// &
       TRIM(ITOS(PCG%NPCOND))
  WRITE(IU,'(A)') TRIM(LINE)
  LINE=TRIM(RTOS(PCG%HCLOSE,'G',5))   //','// &
       TRIM(RTOS(PCG%RCLOSE,'G',5))   //','// &
       TRIM(RTOS(PCG%RELAX ,'G',5))   //','// &
       TRIM(RTOS(1.0D0,'G',5))          //','// &
       TRIM(ITOS(PCG%IPRPCG))         //','// &
       TRIM(ITOS(PCG%MUTPCG))         //','// &
       TRIM(RTOS(PCG%DAMPPCG ,'G',5)) //','// &
       TRIM(RTOS(PCG%DAMPPCGT ,'G',5))
  WRITE(IU,'(A)') TRIM(LINE)

 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEPCG
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_LOADPCG(IU)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU
 INTEGER :: IOS
 
 PMANAGER_LOADPCG=.FALSE.
 
 !## prj file
 READ(IU,'(A256)') LINE
 READ(LINE,*,IOSTAT=IOS) PCG%NOUTER,PCG%NINNER,PCG%HCLOSE,PCG%RCLOSE,PCG%RELAX,PCG%NPCOND, &
              PCG%IPRPCG,PCG%MUTPCG,PCG%DAMPPCG,PCG%DAMPPCGT,PCG%IQERROR,PCG%QERROR
 IF(IOS.NE.0)THEN
  PCG%IQERROR=0; PCG%QERROR=0.0D0
  READ(LINE,*,IOSTAT=IOS) PCG%NOUTER,PCG%NINNER,PCG%HCLOSE,PCG%RCLOSE,PCG%RELAX,PCG%NPCOND, &
               PCG%IPRPCG,PCG%MUTPCG,PCG%DAMPPCG,PCG%DAMPPCGT
 ENDIF
 !## try new style
 IF(IOS.NE.0)THEN
  BACKSPACE(IU)
  IF(.NOT.UTL_READINITFILE('MXITER',LINE,IU,0))RETURN;   READ(LINE,*) PCG%NOUTER
  IF(.NOT.UTL_READINITFILE('ITER1',LINE,IU,0))RETURN;    READ(LINE,*) PCG%NINNER
  IF(.NOT.UTL_READINITFILE('HCLOSE',LINE,IU,0))RETURN;   READ(LINE,*) PCG%HCLOSE
  IF(.NOT.UTL_READINITFILE('RCLOSE',LINE,IU,0))RETURN;   READ(LINE,*) PCG%RCLOSE
  IF(.NOT.UTL_READINITFILE('RELAX',LINE,IU,0))RETURN;    READ(LINE,*) PCG%RELAX
  IF(.NOT.UTL_READINITFILE('NPCOND',LINE,IU,0))RETURN;   READ(LINE,*) PCG%NPCOND
  IF(.NOT.UTL_READINITFILE('IPRPCG',LINE,IU,0))RETURN;   READ(LINE,*) PCG%IPRPCG
  IF(.NOT.UTL_READINITFILE('MUTPCG',LINE,IU,0))RETURN;   READ(LINE,*) PCG%MUTPCG
  IF(.NOT.UTL_READINITFILE('DAMPPCG',LINE,IU,0))RETURN;  READ(LINE,*) PCG%DAMPPCG
  IF(.NOT.UTL_READINITFILE('DAMPPCGT',LINE,IU,0))RETURN; READ(LINE,*) PCG%DAMPPCGT
  IF(.NOT.UTL_READINITFILE('IQERROR',LINE,IU,0))RETURN;  READ(LINE,*) PCG%IQERROR
  IF(.NOT.UTL_READINITFILE('QERROR',LINE,IU,0))RETURN;   READ(LINE,*) PCG%QERROR
 ENDIF
 
 PMANAGER_LOADPCG=.TRUE.
 
 END FUNCTION PMANAGER_LOADPCG
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PKS(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU,NP,ICOL,IROW

 PMANAGER_SAVEMF2005_PKS=.TRUE.; IF(PBMAN%IFORMAT.EQ.3)RETURN; IF(.NOT.LPKS)RETURN

 PMANAGER_SAVEMF2005_PKS=.FALSE.

 !## a single processor used
 NP=1
 
 !## construct pcg-file
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.PKS',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
 WRITE(IU,'(A)') '# PKS File Generated by '//TRIM(UTL_IMODVERSION())

 !## number of processors
 LINE='ISOLVER '//TRIM(ITOS(NP)); WRITE(IU,'(A)') TRIM(LINE)

 !## preconditioner
 LINE='NPC '//TRIM(ITOS(2)); WRITE(IU,'(A)') TRIM(LINE)

 LINE='HCLOSEPKS '//TRIM(RTOS(PCG%HCLOSE,'E',7)); WRITE(IU,'(A)') TRIM(LINE)
 LINE='RCLOSEPKS '//TRIM(RTOS(PCG%RCLOSE,'E',7)); WRITE(IU,'(A)') TRIM(LINE)
 LINE='MXITER '//TRIM(ITOS(PCG%NOUTER));          WRITE(IU,'(A)') TRIM(LINE)
 LINE='INNERIT '//TRIM(ITOS(PCG%NINNER));         WRITE(IU,'(A)') TRIM(LINE)
 LINE='RELAX '//TRIM(RTOS(PCG%RELAX,'E',7));      WRITE(IU,'(A)') TRIM(LINE)

 IF(PBMAN%NRPROC.GT.1)THEN
  LINE='PARTOPT 3';                               WRITE(IU,'(A)') TRIM(LINE)
  LINE='PARTDATA';                                WRITE(IU,'(A)') TRIM(LINE)
  LINE=TRIM(ITOS(PBMAN%NRPROC));                  WRITE(IU,'(A)') TRIM(LINE)
  !## construct submodels
  CALL PKS_INIT(IU,PRJIDF) !,PRJNLAY) 
  !## save network
  LINE='GNCOL '//TRIM(ITOS(PRJIDF%NCOL)); WRITE(IU,'(A)') TRIM(LINE)
  LINE='GNROW '//TRIM(ITOS(PRJIDF%NROW)); WRITE(IU,'(A)') TRIM(LINE)
  IF(PRJIDF%IEQ.EQ.0)THEN
   LINE='GDELR ';                          WRITE(IU,'(A)') TRIM(LINE)
   WRITE(IU,'(A)') TRIM(RTOS(PRJIDF%DX,'E',7))
  ELSE
   LINE='GDELRS';                          WRITE(IU,'(A)') TRIM(LINE)
   WRITE(IU,*) (PRJIDF%SX(ICOL)-PRJIDF%SX(ICOL-1),ICOL=1,PRJIDF%NCOL)
  ENDIF
  IF(PRJIDF%IEQ.EQ.0)THEN
   LINE='GDELC ';                          WRITE(IU,'(A)') TRIM(LINE)
   WRITE(IU,'(A)') TRIM(RTOS(PRJIDF%DY,'E',7))
  ELSE
   LINE='GDELCS';                         WRITE(IU,'(A)') TRIM(LINE)
   WRITE(IU,*) (PRJIDF%SY(IROW-1)-PRJIDF%SY(IROW),IROW=1,PRJIDF%NROW)
  ENDIF

!NOVLAPADV 2
  
 ENDIF

 WRITE(IU,'(A)') 'END'

 CLOSE(IU)
 
 IF(PBMAN%IFORMAT.EQ.6)THEN
  !## construct pcg-file
  IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.PKST',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
  WRITE(IU,'(A)') '# PKS File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(IU,'(A)') 'ISOLVER 1'
  WRITE(IU,'(A)') 'NPC 2'
  WRITE(IU,'(A)') 'NPCDEF 0'
  LINE='MXITER '//TRIM(ITOS(PCG%NOUTER));          WRITE(IU,'(A)') TRIM(LINE)
  LINE='INNERIT '//TRIM(ITOS(PCG%NINNER));         WRITE(IU,'(A)') TRIM(LINE)
  LINE='RELAX '//TRIM(RTOS(PCG%RELAX,'E',7));      WRITE(IU,'(A)') TRIM(LINE)
  LINE='HCLOSEPKS '//TRIM(RTOS(PCG%HCLOSE,'E',7)); WRITE(IU,'(A)') TRIM(LINE)
  WRITE(IU,'(A)') 'RCLOSEPKS 2000.'
  WRITE(IU,'(A)') 'H_FSTRICTPKS 1.'
  WRITE(IU,'(A)') 'R_FSTRICTPKS 1.'
  WRITE(IU,'(A)') 'PARTOPT 5'
  WRITE(IU,'(A)') 'PARTDATA'
  WRITE(IU,'(A)') 'external 265 1. (free) -1'
  WRITE(IU,'(A)') 'GNCOL 800'
  WRITE(IU,'(A)') 'GNROW 600'
  WRITE(IU,'(A)') 'GDELR'
  WRITE(IU,'(A)') '25.'
  WRITE(IU,'(A)') 'GDELC'
  WRITE(IU,'(A)') '25.'
  WRITE(IU,'(A)') 'NOVLAPADV 2'
  WRITE(IU,'(A)') 'END'
  CLOSE(IU)
 ENDIF
 
 PMANAGER_SAVEMF2005_PKS=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_PKS
 
 !####====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MSP(DIR,DIRMNAME,IBATCH,IPRT) 
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,IPRT
 INTEGER :: ISYS,ILAY,ITOPIC,IPER,IINV,SCL_U,SCL_D,IROW,ICOL
 INTEGER :: I,J,NIDF
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: NODATA
 CHARACTER(LEN=256) :: FFNAME,DIRMSP,FNNAME

 PMANAGER_SAVEMF2005_MSP=.TRUE.
 
 IF(TOPICS(TCAP)%IACT_MODEL.EQ.0)RETURN
 
 PMANAGER_SAVEMF2005_MSP=.FALSE.
 
 !## determine number of idf to be read
 NIDF=TOPICS(TCAP)%NSUBTOPICS; ALLOCATE(NODATA(NIDF))
 
 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing MetaSwap files ...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing MetaSwap files ...'

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

 !## initialize unit numbers
 INDSB=0; IAREA=0; ISELSVAT=0; IGWMP=0; IMODSIM=0; ISCAP=0; IINFI=0; IIDF=0; IDFM_MSWP=0; IMSWP_PDFM=0; IUNOD=0; 
 WINDEX_MSWP=0; RINDEX_MSWP=0; WMF6_MSWP=0; RMF6_MSWP=0; IMSWP_SDFM=0; IMSWP_RDFM=0; IFLEXD=0 !; IDQSAT=0
 
 DIRMSP=DIR(:INDEX(DIR,'\',.TRUE.)-1)
 IF(PBMAN%IFORMAT.EQ.3)THEN
  DIRMSP=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)
  !## OPEN NODENR2SVAT.INP
  FFNAME=TRIM(DIRMSP)//'\NODENR2SVAT.DXC'; IUNOD=UTL_GETUNIT(); CALL OSD_OPEN(IUNOD,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN WELLINDEX2SVAT.DXC
  FFNAME=TRIM(DIRMSP)//'\WELLINDEX2SVAT.DXC'; WINDEX_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(WINDEX_MSWP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN RCHINDEX2SVAT.DXC
  FFNAME=TRIM(DIRMSP)//'\RCHINDEX2SVAT.DXC'; RINDEX_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(RINDEX_MSWP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 ENDIF

 IF(PBMAN%IFORMAT.EQ.3)THEN
  !## OPEN MSW.WEL6
  DIRMSP=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MODELINPUT'
  FFNAME=TRIM(DIRMSP)//'\MSW.WEL6_'; WMF6_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(WMF6_MSWP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN MSW.RCH6
  FFNAME=TRIM(DIRMSP)//'\MSW.RCH6_'; RMF6_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(RMF6_MSWP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 ENDIF

 DIRMSP=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MSWAPINPUT'

 !## open indsb
 FFNAME=TRIM(DIRMSP)//'\SVAT2SWNR_ROFF.INP'; INDSB=UTL_GETUNIT(); CALL OSD_OPEN(INDSB,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN IAREA
 FFNAME=TRIM(DIRMSP)//'\AREA_SVAT.INP'; IAREA=UTL_GETUNIT(); CALL OSD_OPEN(IAREA,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN ISCAP
 FFNAME=TRIM(DIRMSP)//'\SCAP_SVAT.INP'; ISCAP=UTL_GETUNIT(); CALL OSD_OPEN(ISCAP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN IGWMP
 FFNAME=TRIM(DIRMSP)//'\MOD2SVAT.INP'; IGWMP=UTL_GETUNIT(); CALL OSD_OPEN(IGWMP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 IF(PBMAN%IFORMAT.NE.3)THEN
  !## open MODFLOW dxc file (not for MF6)
  FFNAME=TRIM(DIRMNAME)//'.DXC'; IDXC=UTL_GETUNIT(); CALL OSD_OPEN(IDXC,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 ENDIF
 !## OPEN MOD-SIM.TXT
 FFNAME=TRIM(DIRMSP)//'\MOD-SIM.TXT'; IMODSIM=UTL_GETUNIT(); CALL OSD_OPEN(IMODSIM,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN ISELSVAT
 FFNAME=TRIM(DIRMSP)//'\SEL_SVAT_BDA.INP'; ISELSVAT=UTL_GETUNIT(); CALL OSD_OPEN(ISELSVAT,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN INFI_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\INFI_SVAT.INP'; IINFI=UTL_GETUNIT(); OPEN(IINFI,FILE=FFNAME,STATUS='REPLACE',CARRIAGECONTROL='LIST',ACTION='WRITE')
 !## OPEN IDF_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\IDF_SVAT.INP'; IIDF=UTL_GETUNIT(); CALL OSD_OPEN(IIDF,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 !## OPEN USCL_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\USCL_SVAT.INP'; IUSCL=UTL_GETUNIT(); CALL OSD_OPEN(IUSCL,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 IF(PBMAN%DMMFILE.EQ.1)THEN
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\DFM2DWATLEVTOMSW_H.DMM'; IDFM_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(IDFM_MSWP,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MSWPONDINGTODFM2D_DV.DMM'; IMSWP_PDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_PDFM,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MSWSPRINKTODFM1D_Q.DMM'; IMSWP_SDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_SDFM,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MSWRUNOFFTODFM1D_Q.DMM'; IMSWP_RDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_RDFM,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 ENDIF
 IF(PBMAN%FLEXD.EQ.1)THEN
  !## OPEN MODSUB_SVAT.INP
  FFNAME=TRIM(DIRMSP)//'\MODSUB_SVAT.INP'; IFLEXD=UTL_GETUNIT(); CALL OSD_OPEN(IFLEXD,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 ENDIF
! !## OPEN DQSAT_SVAT.INP
! FFNAME=TRIM(DIRMSP)//'\DQSAT_SVAT.INP'; IDQSAT=UTL_GETUNIT(); CALL OSD_OPEN(IDQSAT,FILE=FFNAME,STATUS='REPLACE',ACTION='WRITE')
 
 !## metaswap
 PBMAN%IARMWP=0
 IF(TOPICS(TCAP)%IACT_MODEL.EQ.1)THEN
  IF(ASSOCIATED(TOPICS(TCAP)%STRESS))THEN
   FFNAME=TOPICS(TCAP)%STRESS(1)%FILES(8,1)%FNAME
   IF(INDEX(UTL_CAP(FFNAME,'U'),'IPF').GT.0)PBMAN%IARMWP=1
  ENDIF
 ENDIF

 ISYS=0; ILAY=1; ITOPIC=TCAP; IPER=1; IINV=0

 ALLOCATE(FNAMES(TOPICS(ITOPIC)%NSUBTOPICS),PRJILIST(1)); PRJILIST=ITOPIC
 IF(PMANAGER_GETFNAMES(1,1,1,0,1).LE.0)RETURN
 
 !## open all files
 DO ISYS=1,NIDF
  !## skip ipf for artificial recharge
  IF(PBMAN%IARMWP.EQ.1.AND.ISYS.EQ.8)CYCLE
  !## skip ipf for level-controlled drainage
  IF(PBMAN%FLEXD.EQ.1.AND.ISYS.EQ.24)CYCLE
  
  SELECT CASE (ISYS)
   !## bnd
   CASE (1);             NODATA(ISYS)=-999.0D0;  SCL_U=1; SCL_D=0
   !## lgn,root,soil,meteo
   CASE (2:5,7:9);       NODATA(ISYS)=-999.0D0;  SCL_U=7; SCL_D=0
   !## surf,ponding,ponding,pwtlevel,drainagelevel
   CASE (6,12,13,20,25); NODATA(ISYS)=-999.99D0; SCL_U=2; SCL_D=1
   !## soilfactor,cond.factor
   CASE (21,22);         NODATA(ISYS)=-999.99D0; SCL_U=2; SCL_D=0
   !## qinfub,qinfru
   CASE (18,19);         NODATA(ISYS)=-999.99D0; SCL_U=7; SCL_D=0 
   !## plot number
   CASE (23);            NODATA(ISYS)=   0.0D0;  SCL_U=7; SCL_D=0  
   !## runoff,runoff,runon,runon
   CASE (14:17);         NODATA(ISYS)=-999.99D0; SCL_U=7; SCL_D=0 
   !## wetted area/urban area
   CASE (10,11);         NODATA(ISYS)=-999.99D0; SCL_U=5; SCL_D=0
   !## drainage resistance
   CASE (26);            NODATA(ISYS)=-999.99D0; SCL_U=6; SCL_D=1
  END SELECT

  !## read in data
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(PRJIDF,ITOPIC,ISYS,SCL_D,SCL_U,IINV,IPRT))RETURN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(PRJIDF%X(ICOL,IROW).EQ.PRJIDF%NODATA)PRJIDF%X(ICOL,IROW)=NODATA(ISYS)
   SELECT CASE (ISYS)
    CASE (1);  SIMGRO(ICOL,IROW)%IBOUND=INT(PRJIDF%X(ICOL,IROW))
    CASE (2);  SIMGRO(ICOL,IROW)%LGN=INT(PRJIDF%X(ICOL,IROW))
    CASE (3);  SIMGRO(ICOL,IROW)%RZ=PRJIDF%X(ICOL,IROW)
    CASE (4);  SIMGRO(ICOL,IROW)%BODEM=INT(PRJIDF%X(ICOL,IROW))
    CASE (5);  SIMGRO(ICOL,IROW)%METEO=INT(PRJIDF%X(ICOL,IROW))
    CASE (6);  SIMGRO(ICOL,IROW)%MV=PRJIDF%X(ICOL,IROW)
    CASE (7);  SIMGRO(ICOL,IROW)%BEREGEN=INT(PRJIDF%X(ICOL,IROW))
    CASE (8);  SIMGRO(ICOL,IROW)%BER_LAAG=INT(PRJIDF%X(ICOL,IROW))
    CASE (9);  SIMGRO(ICOL,IROW)%BEREGEN_Q=PRJIDF%X(ICOL,IROW)
    CASE (10); SIMGRO(ICOL,IROW)%NOPP=PRJIDF%X(ICOL,IROW)
    CASE (11); SIMGRO(ICOL,IROW)%SOPP=PRJIDF%X(ICOL,IROW)
    CASE (12); SIMGRO(ICOL,IROW)%VXMU_SOPP=PRJIDF%X(ICOL,IROW)
    CASE (13); SIMGRO(ICOL,IROW)%VXMU_ROPP=PRJIDF%X(ICOL,IROW)
    CASE (14); SIMGRO(ICOL,IROW)%CRUNOFF_SOPP=PRJIDF%X(ICOL,IROW)
    CASE (15); SIMGRO(ICOL,IROW)%CRUNOFF_ROPP=PRJIDF%X(ICOL,IROW)
    CASE (16); SIMGRO(ICOL,IROW)%CRUNON_SOPP=PRJIDF%X(ICOL,IROW)
    CASE (17); SIMGRO(ICOL,IROW)%CRUNON_ROPP=PRJIDF%X(ICOL,IROW)
    CASE (18); SIMGRO(ICOL,IROW)%QINFBASIC_SOPP=PRJIDF%X(ICOL,IROW)
    CASE (19); SIMGRO(ICOL,IROW)%QINFBASIC_ROPP=PRJIDF%X(ICOL,IROW)
    CASE (20); SIMGRO(ICOL,IROW)%PWT_LEVEL=PRJIDF%X(ICOL,IROW)
    CASE (21); SIMGRO(ICOL,IROW)%MOISTURE=PRJIDF%X(ICOL,IROW)
    CASE (22); SIMGRO(ICOL,IROW)%COND=PRJIDF%X(ICOL,IROW)
    CASE (23); SIMGRO(ICOL,IROW)%PLN=PRJIDF%X(ICOL,IROW)
    CASE (24); !## ipf
    CASE (25); SIMGRO(ICOL,IROW)%PDL=PRJIDF%X(ICOL,IROW)
    CASE (26); SIMGRO(ICOL,IROW)%PDR=PRJIDF%X(ICOL,IROW)
   END SELECT
  ENDDO; ENDDO

 ENDDO

 !## read metaswap beregening IPF if needed
 IF(.NOT.PMANAGER_SAVEMF2005_MSP_READIPF(TOPICS(ITOPIC)%STRESS(IPER)%FILES(8,ILAY)%FNAME,IBATCH))RETURN
 !## read metaswap level-controlled drainage IPF file (if needed)
 IF(PBMAN%FLEXD.EQ.1)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD(TOPICS(ITOPIC)%STRESS(IPER)%FILES(24,ILAY)%FNAME,IBATCH,SIMGRO%PLN,1))RETURN
 ENDIF
 
 IF(TOPICS(TPWT)%IACT_MODEL.EQ.0)SIMGRO%PWT_LEVEL=NODATA(20) 
 
 !## check input parameters
 IF(.NOT.PMANAGER_SAVEMF2005_MSP_CHECK(NODATA,IBATCH))RETURN
  
 CALL PMANAGER_SAVEMF2005_MSP_INPFILES(NODATA,TOPICS(TPWT)%IACT_MODEL,DIRMSP,IBATCH) 
   
 IF(PBMAN%IARMWP.EQ.1)DEALLOCATE(IPFMSP)
 IF(PBMAN%FLEXD.EQ.1 )DEALLOCATE(IPFFLX)
 
 !## 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,'METE_GRID.INP').GT.0)THEN
    CALL METASWAP_METEGRID1(FFNAME,TRIM(DIRMSP)//'\METE_GRID.INP')     
   ELSEIF(INDEX(FFNAME,'PARA_SIM.INP').GT.0)THEN
    CALL PMANAGER_SAVEMF2005_MSP_PARASIM(FFNAME,DIRMSP)
   ELSE
    FNNAME=TRIM(DIRMSP)//'\'//TRIM(FFNAME(INDEX(FFNAME,'\',.TRUE.)+1:))
    CALL SYSTEM('COPY "'//TRIM(FFNAME)//'" "'//TRIM(FNNAME)//'" /Y ')
   ENDIF
  ENDDO
 ENDIF
 
 !## metaswap 727 computing with recharge (possibility) if mete_grid.inp exists
 CALL METASWAP_METEGRID2(TRIM(DIRMSP))

 DEALLOCATE(SIMGRO,NODATA)
 
 PMANAGER_SAVEMF2005_MSP=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_MSP

 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MSP_PARASIM(FNAME,DIRMSP)
 !###====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME,DIRMSP
 INTEGER :: IU,JU,I,IOS,IC1,IC2,IR1,IR2,SNCOL,SNROW,IFLEXD
 REAL(KIND=DP_KIND) :: X1,Y1,TINY
 CHARACTER(LEN=256) :: S,S1,RUNDIR

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

 !## get working director
 CALL IOSDIRNAME(RUNDIR) 
 
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ')
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(DIRMSP)//'\PARA_SIM.INP',STATUS='REPLACE',ACTION='WRITE')
 IFLEXD=0; DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  S=TRIM(ADJUSTL(LINE)); S=UTL_CAP(S,'L')
!  IF(S(1:14).EQ.'unsa_svat_path')THEN
!   I=INDEX(LINE,'=')
!   S1=ADJUSTL(LINE(I+1:LEN_TRIM(LINE)))
!   READ(S1,*) S2 
!   CALL UTL_REL_TO_ABS(RUNDIR,S2) 
!   LINE=LINE(1:I)//' "'//TRIM(S2)//'"'
!  END IF
  !## do not copy simgro_opt settings if existing
  IF(INDEX(TRIM(S),'simgro_opt').EQ.0)THEN
   IF(INDEX(TRIM(S),'subirrigation_mdl').GT.0)THEN
    !## add string if flexible drainage is active
    IF(PBMAN%FLEXD.EQ.1)THEN; WRITE(JU,'(A)') TRIM(LINE); IFLEXD=1; ENDIF
   ELSE
    WRITE(JU,'(A)') TRIM(LINE)
   ENDIF
  ENDIF
 ENDDO
 IF(IFLEXD.EQ.0.AND.PBMAN%FLEXD.EQ.1)WRITE(JU,'(4A,A)') 'subirrigation_mdl      =          1'

 CLOSE(IU)

 TINY=0.001D0
 CALL POL1LOCATE(PRJIDF%SX,PRJIDF%NCOL+1,PRJIDF%XMIN+TINY,IC1)
 CALL POL1LOCATE(PRJIDF%SX,PRJIDF%NCOL+1,PRJIDF%XMAX-TINY,IC2)
 CALL POL1LOCATE(PRJIDF%SY,PRJIDF%NROW+1,PRJIDF%YMAX-TINY,IR1)
 CALL POL1LOCATE(PRJIDF%SY,PRJIDF%NROW+1,PRJIDF%YMIN+TINY,IR2)

 !## check to make sure dimensions are within bounds!
 IC1  = MAX(1,IC1); IC2  = MIN(IC2,PRJIDF%NCOL)
 IR1  = MAX(1,IR1); IR2  = MIN(IR2,PRJIDF%NROW)
 SNCOL=(IC2-IC1)+1; SNROW=(IR2-IR1)+1
 
 X1=PRJIDF%XMIN
 Y1=PRJIDF%YMIN
 
 WRITE(JU,'(A)') '*'
 WRITE(JU,'(A)') '*  Parameters for IDF output'
 WRITE(JU,'(A)') '*'
 WRITE(JU,'(A)') '      simgro_opt             =     -1    ! simgro output file'
 WRITE(JU,'(A)') '      idf_per                =      1    ! Writing IDF files' 
 LINE='      idf_xmin                =      '//TRIM(RTOS(X1,'G',7))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_ymin                =      '//TRIM(RTOS(Y1,'G',7))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_dx                  =      '//TRIM(RTOS(PRJIDF%DX,'G',7))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_dy                  =      '//TRIM(RTOS(PRJIDF%DY,'G',7))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_ncol                =      '//TRIM(ITOS(SNCOL))
 WRITE(JU,'(A)') TRIM(LINE)
 LINE='      idf_nrow                =      '//TRIM(ITOS(SNROW))
 WRITE(JU,'(A)') TRIM(LINE) 
 LINE='      idf_nodata              =      '//TRIM(RTOS(-9999.00D0,'F',2)) 
 WRITE(JU,'(A)') TRIM(LINE)

 IF(PRJIDF%IEQ.EQ.0)THEN
  LINE='      idf_sx                  =      0'
  WRITE(JU,'(A)') TRIM(LINE)
 ELSE
  LINE='      idf_sx                  =      1'
  WRITE(JU,'(A)') TRIM(LINE)
  DO IC1=1,PRJIDF%NCOL
   WRITE(JU,'(A,F15.3)') '      idf_dx'//trim(itos(ic1))//'=',PRJIDF%SX(IC1)-PRJIDF%SX(IC1-1)
  ENDDO
 ENDIF
 
 IF(PRJIDF%IEQ.EQ.0)THEN
  LINE='      idf_sy                  =      0'
  WRITE(JU,'(A)') TRIM(LINE)
 ELSE
  LINE='      idf_sy                  =      1'
  WRITE(JU,'(A)') TRIM(LINE)
  DO IR1=1,PRJIDF%NROW
   WRITE(JU,'(A,F15.3)') '      idf_dy'//trim(itos(ir1))//'=',PRJIDF%SY(IR1-1)-PRJIDF%SY(IR1)
  ENDDO
 ENDIF
 
 CLOSE(JU)

 END SUBROUTINE PMANAGER_SAVEMF2005_MSP_PARASIM
 
 !###====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MSP_READIPF(IPFFILE,IBATCH) 
 !###====================================================================
 IMPLICIT NONE
 LOGICAL :: LPWT
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=*),INTENT(IN) :: IPFFILE
 INTEGER :: I,J,JU,M,N,LYBE,NUND,MDND
 REAL(KIND=DP_KIND) :: XC,YC,QBER
 
 PMANAGER_SAVEMF2005_MSP_READIPF=.TRUE.
 
 IF(PBMAN%IARMWP.EQ.0)RETURN

 PMANAGER_SAVEMF2005_MSP_READIPF=.FALSE.

 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)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'IPF for artificial recharge should be at least 5 column, x,y,ilay,id,capacity','Error')
   RETURN
  ENDIF
  DO I=1,M+1; READ(JU,*) ; ENDDO
  IF(J.EQ.2)THEN; ALLOCATE(IPFMSP(MDND)); IPFMSP%ILAY=0; IPFMSP%CAP=0.0D0; 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; IPFMSP(NUND)%X=XC; IPFMSP(NUND)%Y=YC; IPFMSP(NUND)%ILAY=LYBE; IPFMSP(NUND)%CAP=QBER; ENDIF   
  ENDDO
  CLOSE(JU)
 ENDDO
 
 PMANAGER_SAVEMF2005_MSP_READIPF=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_MSP_READIPF
 
 !###====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD(IPFFILE,IBATCH,PLN,ICHECK) 
 !###====================================================================
 IMPLICIT NONE
 LOGICAL :: LPWT
 INTEGER,INTENT(IN) :: IBATCH,ICHECK
 INTEGER,DIMENSION(:,:),INTENT(INOUT) :: PLN
 CHARACTER(LEN=*),INTENT(IN) :: IPFFILE
 INTEGER :: I,J,K,JU,M,N,MXID,ICOL,IROW,ID
 REAL(KIND=DP_KIND) :: XS,YS,CAP,HTL,LTL,XE,YE,ZE
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TLP,KH,TP,BT
 INTEGER,ALLOCATABLE,DIMENSION(:) :: CNT
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD=.FALSE.
 
 IF(ALLOCATED(IPFFLX))DEALLOCATE(IPFFLX)
 ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))

 JU=UTL_GETUNIT(); MXID=0
 DO J=1,2
  CALL OSD_OPEN(JU,FILE=IPFFILE,ACTION='READ',STATUS='OLD') 
  READ(JU,*) N; READ(JU,*) M
  IF(M.LT.8)THEN
   IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'IPF for controlled-level drainage should be at least 8 column for x,y,capacity,lowtargetlevel,hightargetlevel,x_extraction,y_extraction,z_extraction','Error')
   IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'IPF for controlled-level drainag should be at least 8 column for x,y,capacity,lowtargetlevel,hightargetlevel,x_extraction,y_extraction,z_extraction'
   RETURN
  ENDIF
  DO I=1,M+1; READ(JU,*) ; ENDDO
  IF(J.EQ.2)THEN
   !## capacity is tricker whether an extraction exists for a plotnumber
   ALLOCATE(IPFFLX(MXID)); IPFFLX%CAP=-9999.0D0; IPFFLX%XS=-9999.0D0
  ENDIF
  DO I=1,N
   READ(JU,*) XS,YS,CAP,LTL,HTL,XE,YE,ZE
   !## get screening number from simgro()%pln
   CALL IDFIROWICOL(PRJIDF,IROW,ICOL,XS,YS)
   ID=PLN(ICOL,IROW)
   !## skip this incorrect plotnumber
   IF(ID.LE.0)CYCLE
   
   IF(J.EQ.1)THEN
    MXID=MAX(MXID,ID)
   ELSE

    IF(IPFFLX(ID)%CAP.NE.-9999.0D0)THEN
     CLOSE(JU)
     IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Multiple screening locations specified for plot number: '//TRIM(ITOS(ID)),'Error')
     IF(IBATCH.EQ.1)WRITE(*,'(/A/)') 'Multiple screening locations specified for plot number: '//TRIM(ITOS(ID))
     RETURN    
    ENDIF
        
    IPFFLX(ID)%XS =XS
    IPFFLX(ID)%YS =YS
    IPFFLX(ID)%CAP=CAP
    IPFFLX(ID)%LTL=LTL
    IPFFLX(ID)%HTL=HTL
    
    IF(XE.EQ.-9999.0D0.OR.YE.EQ.-9999.0D0.OR.ZE.EQ.-9999.0D0)THEN
     XE=-9999.0D0; YE=-9999.0D0; ZE=-9999.0D0; IPFFLX(ID)%IL=0
    ELSE
     !## determine layer number for the extraction
     CALL PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KDW,TP,BT,KH,.TRUE.)
     CALL UTL_PCK_GETTLP(PRJNLAY,TLP,KH,TP,BT,ZE,ZE,0.0D0)
     DO K=1,PRJNLAY; IF(TLP(K).GT.0.0D0)THEN; IPFFLX(ID)%IL=K; EXIT; ENDIF; ENDDO
     !## if not assigned to a proper layer, turn the extraction off
     IF(IPFFLX(ID)%IL.EQ.0)IPFFLX(ID)%CAP=0.0D0
    ENDIF

    IPFFLX(ID)%YE=YE
    IPFFLX(ID)%XE=XE
    IPFFLX(ID)%ZE=ZE
    
   ENDIF
  ENDDO
  CLOSE(JU)
 ENDDO

 !## set nodata of CAP to zero
 IPFFLX%CAP=MAX(IPFFLX%CAP,0.0D0)

 MXID=MAXVAL(PLN); ALLOCATE(CNT(MXID)); CNT=0
 
 !## check whether all plot numbers have a steering point
 K=0; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  ID=PLN(ICOL,IROW)
  IF(ID.LE.0)THEN; PLN(ICOL,IROW)=0; CYCLE; ENDIF
  IF(CNT(ID).NE.0)CYCLE
  LEX=.FALSE.
  IF(ID.GT.SIZE(IPFFLX))THEN
   LEX=.TRUE.
  ELSE
   IF(IPFFLX(ID)%XS.EQ.-9999.0D0)LEX=.TRUE.
  ENDIF
  IF(LEX)THEN
   !## id is not okay
   CNT(ID)=-1
   IF(ICHECK.EQ.1)THEN
    K=K+1
    IF(K.EQ.1)THEN
     WRITE(*,'(/1X,A)') 'Missing Steering Points for plotnumber:'
     WRITE(*,'(A10)') 'ID'; WRITE(*,'(A10)') '----------'
    ENDIF
    WRITE(*,'(I10)') ID
   ENDIF
  !## id is okay
  ELSE
   CNT(ID)=1
  ENDIF
 ENDDO; ENDDO
 !## clean pln array for not existing plotnumbers
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  ID=PLN(ICOL,IROW); IF(ID.EQ.0)CYCLE; IF(CNT(ID).EQ.-1)PLN(ICOL,IROW)=0
 ENDDO; ENDDO
 DEALLOCATE(CNT)
 IF(ICHECK.EQ.1)THEN
  IF(K.GT.0)WRITE(*,'(/1X,A/)') '>>> Above mentioned plot numbers are discarded <<<'
 ENDIF
 
 DEALLOCATE(TLP,KH,TP,BT)
 
 PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_MSP_READIPF_FLEXD
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MSP_INPFILES(NODATA,IPWT,DIRMSP,IBATCH) 
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,IPWT
 REAL(KIND=DP_KIND),DIMENSION(:),INTENT(IN) :: NODATA
 CHARACTER(LEN=*),INTENT(IN) :: DIRMSP
 CHARACTER(LEN=256) :: DIR
 INTEGER,PARAMETER :: AEND=0 !## no surfacewater units
 INTEGER :: NUND,IROW,ICOL,LYBE,TYBE,BEREGENID,JROW,JCOL,N,M,I,J,JU,IOS,INEAREST, &    !MDND
  NDFM_MSWP,NMSWP_PDFM,NMSWP_RDFM,NMSWP_SDFM,DRC,L,L1,L2,IL,LFLX,PLN,FLXID,SVATID,ILAY
 REAL(KIND=DP_KIND) :: XC,YC,ARND,QBER,FLBE,TINY,LTL,HTL,CAP,DRL,DRR,DRI
 TYPE IPFOBJ
  INTEGER :: ILAY
  REAL(KIND=DP_KIND) :: X,Y,CAP
 END TYPE IPFOBJ
 TYPE(IPFOBJ),ALLOCATABLE,DIMENSION(:) :: IPF
 LOGICAL :: LURBAN,LEX
 INTEGER :: NDXC,UNID,IACT,NWEL,NRCH,NUFLXID
 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: DXCID
 TYPE(IDFOBJ) :: ACTPLN,SVATRURAL,SVATURBAN
 INTEGER,ALLOCATABLE,DIMENSION(:) :: FLXUD,FLXUID
 
 IF (ALLOCATED(DXCID)) DEALLOCATE(DXCID)
 ALLOCATE(DXCID(PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY))
 DXCID = 0
 NDXC = 0
 
 IF(PBMAN%FLEXD.EQ.1)THEN
  N=PRJIDF%NROW*PRJIDF%NCOL; ALLOCATE(FLXUD(N))
  N=0; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(SIMGRO(ICOL,IROW)%IBOUND.LE.0)CYCLE
   !## plotnumber
   FLXID=INT(SIMGRO(ICOL,IROW)%PLN)
   IF(FLXID.GT.0)THEN
    N=N+1; FLXUD(N)=FLXID
   ENDIF
  ENDDO; ENDDO
  CALL UTL_GETUNIQUE_INT(FLXUD,N,NUFLXID,0) 
  ALLOCATE(FLXUID(FLXUD(NUFLXID))); FLXUID=0
  DO I=1,NUFLXID; FLXUID(FLXUD(I))=I; ENDDO
  DEALLOCATE(FLXUD)
 ENDIF
 
 !## write wel-package
 IF(PBMAN%IFORMAT.EQ.3)THEN
  WRITE(WMF6_MSWP,'(A)') '# WEL6 File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(WMF6_MSWP,'(/A)') '#General Options'
  WRITE(WMF6_MSWP,'(/A)') 'BEGIN OPTIONS'
  WRITE(WMF6_MSWP,'(A )') 'END OPTIONS'
  WRITE(WMF6_MSWP,'(/A)') '#General Dimensions'
  WRITE(WMF6_MSWP,'(A)') 'BEGIN DIMENSIONS'
  WRITE(WMF6_MSWP,'(A)') 'MAXBOUND NaN1#'
  WRITE(WMF6_MSWP,'(A)') 'END DIMENSIONS'
  WRITE(WMF6_MSWP,'(/A)') 'BEGIN PERIOD 1'
  WRITE(RMF6_MSWP,'(A)') '# RCH6 File Generated by '//TRIM(UTL_IMODVERSION())
  WRITE(RMF6_MSWP,'(/A)') '#General Options'
  WRITE(RMF6_MSWP,'(/A)') 'BEGIN OPTIONS'
  WRITE(RMF6_MSWP,'(A )') 'END OPTIONS'
  WRITE(RMF6_MSWP,'(/A)') '#General Dimensions'
  WRITE(RMF6_MSWP,'(A)') 'BEGIN DIMENSIONS'
  WRITE(RMF6_MSWP,'(A)') 'MAXBOUND NaN1#'
  WRITE(RMF6_MSWP,'(A)') 'END DIMENSIONS'
  WRITE(RMF6_MSWP,'(/A)') 'BEGIN PERIOD 1'
 ENDIF
  
 IF(PBMAN%DMMFILE.EQ.1)THEN
  DIR=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)
  CALL PMANAGER_SAVEMF2005_READ_DFFMPOINTS(DIR)
  WRITE(IDFM_MSWP,'(4A15)')  'SVAT','FM-X','FM-Y','WEIGHT'; NDFM_MSWP=0
  WRITE(IMSWP_PDFM,'(3A15)') 'FM-X','FM-Y','SVAT'; NMSWP_PDFM=0
  WRITE(IMSWP_RDFM,'(3A15)') 'FM-X','FM-Y','SVAT'; NMSWP_RDFM=0
  WRITE(IMSWP_SDFM,'(3A15)') 'FM-X','FM-Y','SVAT'; NMSWP_SDFM=0
 ENDIF
 IF(PBMAN%FLEXD.EQ.1)THEN
  CALL IDFNULLIFY(ACTPLN); CALL IDFCOPY(PRJIDF,ACTPLN); ACTPLN%X=ACTPLN%NODATA
 ENDIF
 CALL IDFNULLIFY(SVATRURAL); CALL IDFCOPY(PRJIDF,SVATRURAL); SVATRURAL%X=SVATRURAL%NODATA
 CALL IDFNULLIFY(SVATURBAN); CALL IDFCOPY(PRJIDF,SVATURBAN); SVATURBAN%X=SVATURBAN%NODATA

 DO IACT=1,2
  NWEL=0; NRCH=0; NUND=0; UNID=0 
  DO IROW=1,PRJIDF%NROW
   DO ICOL=1,PRJIDF%NCOL
    LURBAN=.FALSE.
    
    IF(SIMGRO(ICOL,IROW)%IBOUND.LE.0)CYCLE
    
    ILAY=SIMGRO(ICOL,IROW)%IBOUND
    
    ARND=IDFGETAREA(PRJIDF,ICOL,IROW)
    ARND= ARND-SIMGRO(ICOL,IROW)%NOPP-SIMGRO(ICOL,IROW)%SOPP

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

     CALL IDFGETLOC(PRJIDF,IROW,ICOL,XC,YC)

     IF(IACT.EQ.2)THEN
      WRITE(IIDF,'(3I10,2F15.3)') NUND,IROW,ICOL,XC,YC 
      SVATRURAL%X(ICOL,IROW)=NUND
     ENDIF
      
     !## write sel_svat_bda.inp
     IF(IACT.EQ.2)THEN
      WRITE(ISELSVAT,'(I10)') NUND

      IF(PBMAN%DMMFILE.EQ.1)THEN
       !## coupling to 2d network
       WRITE(IDFM_MSWP,'(I15,3F15.3)') NUND,XC,YC,1.0D0; NDFM_MSWP =NDFM_MSWP +1
       !## coupling for ponding
       WRITE(IMSWP_PDFM,'(2F15.3,I15)') XC,YC,NUND;      NMSWP_PDFM=NMSWP_PDFM+1
       !## coupling for rural runoff - nearest DFMFM-point in same afwat-unit
       INEAREST=PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,.TRUE.,DRC)
       IF(INEAREST.GT.0)THEN
        WRITE(IMSWP_RDFM,'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NUND
        NMSWP_RDFM=NMSWP_RDFM+1
       ENDIF
      ENDIF
    
      !## 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.0D0,               &
            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

     ENDIF
    
     !## add couple location modflow
     CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,ILAY,IROW,ICOL,UNID,IACT)

     IF(IACT.EQ.2)THEN
      IF(PBMAN%IFORMAT.EQ.3)THEN
       WRITE(IUNOD,'(3I10)') UNID,NUND,1
       NRCH=NRCH+1
       WRITE(RINDEX_MSWP,'(3I10)')  NRCH,NUND,1
       WRITE(RMF6_MSWP,'(3I10,F10.2)')  ILAY,IROW,ICOL,0.0D0       
      ENDIF
      WRITE(IGWMP,'(I10,2X,I10,I5)')   UNID,NUND,1
      WRITE(IMODSIM,'(I10,2X,I10,I5)') UNID,NUND,1
     ENDIF
    
     !## begin modsub_svat.inp
     IF(PBMAN%FLEXD.EQ.1)THEN
      !## perceelsnumber
      CAP=0.0D0; SVATID=0; FLXID=INT(SIMGRO(ICOL,IROW)%PLN)
      !## no steering location present for this plotnumber
      IF(FLXID.GT.SIZE(IPFFLX))FLXID=0
      IF(FLXID.GT.0)THEN
       !## steering location
       CALL IDFIROWICOL(PRJIDF,JROW,JCOL,IPFFLX(FLXID)%XS,IPFFLX(FLXID)%YS)
       !## this is the steering location and the extraction need to be assigned to this one
       IF(ICOL.EQ.JCOL.AND.IROW.EQ.JROW)CAP=IPFFLX(FLXID)%CAP
       IF(CAP.EQ.0.0D0)THEN
        SVATID=-9999
        LFLX  =-9999
       ELSE
        !## extraction location
        CALL IDFIROWICOL(PRJIDF,JROW,JCOL,IPFFLX(FLXID)%XE,IPFFLX(FLXID)%YE)
        !## extraction outside model
        IF(JCOL.EQ.0.OR.JROW.EQ.0)THEN
         SVATID=-9999
         LFLX  =-9999
        ELSE
         LFLX=IPFFLX(FLXID)%IL
        ENDIF
        CAP=IPFFLX(FLXID)%CAP
        !## add couple location for extraction to modflow, always use layer number 1 for the svat unit and only if position of extraction is in current model
        IF(SVATID.NE.-9999)CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,ILAY,JROW,JCOL,SVATID,IACT)
       ENDIF
       IF(IACT.EQ.2)THEN
        LTL=IPFFLX(FLXID    )%LTL
        HTL=IPFFLX(FLXID    )%HTL
        PLN=SIMGRO(ICOL,IROW)%PLN
        !## renumbered plotnumber
        PLN=FLXUID(PLN)
        DRI=1.0D0
        DRL=SIMGRO(ICOL,IROW)%PDL; IF(DRL.EQ.NODATA(25))THEN; DRL=-9999.0D0; DRI=-9999.0D0; ENDIF
        DRR=SIMGRO(ICOL,IROW)%PDR; IF(DRR.EQ.NODATA(25))THEN; DRR=-9999.0D0; DRI=-9999.0D0; ENDIF
        !## nund is svat of current position, unid is svat of extraction location
        IF(CAP.EQ.0.0D0)THEN
         ACTPLN%X(ICOL,IROW)= PLN
         WRITE(IFLEXD,'(2I10,G10.3,2I10,12F10.3)') NUND,PLN,-9999.0,SVATID,LFLX,LTL,HTL,DRL,DRR,DRI,(-9999.0D0,I=1,7)
        ELSE
         ACTPLN%X(ICOL,IROW)=-PLN
         WRITE(IFLEXD,'(2I10,G10.3,2I10,12F10.3)') NUND,PLN,CAP,SVATID,LFLX,LTL,HTL,DRL,DRR,DRI,(-9999.0D0,I=1,7)         
        ENDIF
       ENDIF
       
      ENDIF
      
      !## add this to the svat list only for the extraction as the svat itself is already present in the list.
      IF(CAP.NE.0.0D0.AND.SVATID.NE.-9999)THEN
       NWEL=NWEL+1
       IF(IACT.EQ.1)THEN
        !## store modflow id, if extraction is in model (or active)
        CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,LFLX,JROW,JCOL,UNID,IACT)
       ELSE
        !## get correct modflow id
        CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,LFLX,JROW,JCOL,UNID,IACT)
        IF(PBMAN%IFORMAT.EQ.3)THEN
         WRITE(IUNOD,'(3I10)') UNID,SVATID,LFLX
         WRITE(WMF6_MSWP,'(3I10,F10.2)')  LFLX,JROW,JCOL,0.0D0
         WRITE(WINDEX_MSWP,'(3I10)')      NWEL,SVATID,LFLX
        ENDIF
        WRITE(IGWMP,'(I10,2X,I10,I5)')   UNID,SVATID,LFLX
        WRITE(IMODSIM,'(I10,2X,I10,I5)') UNID,SVATID,LFLX
       ENDIF
      ENDIF
      
     ENDIF

     !## BEGIN scap_svat.inp - grondwater + ow
     IF(PBMAN%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(IPFMSP))THEN
       LYBE=IPFMSP(BEREGENID)%ILAY
       IF(LYBE.GT.0.AND.LYBE.LE.PRJNLAY)THEN
        QBER=IPFMSP(BEREGENID)%CAP
        TYBE=1 !## groundwater
        CALL IDFIROWICOL(PRJIDF,JROW,JCOL,IPFMSP(BEREGENID)%X,IPFMSP(BEREGENID)%Y)
       ENDIF
      ENDIF
     ENDIF    
    
     IF(JROW.NE.0.AND.JCOL.NE.0)THEN
    
      FLBE=0.0D0
      IF(TYBE.EQ.1)THEN
       !## maximum groundwater   abstraction mm/day fmmxabgw
       FLBE=QBER
      ELSEIF(TYBE.EQ.2)THEN
       !## maximum surface water abstraction mm/day fmmxabsw
       FLBE=QBER
      ENDIF
      
      !## maximum groundwater   abstraction mm/day fmmxabgw
      IF(FLBE.GT.0.0D0)THEN
       IF(TYBE.EQ.1)THEN
        IF(IACT.EQ.2)THEN
         WRITE(ISCAP,'(I10,F8.2,24X,I10,I6)') NUND,QBER,NUND,LYBE
        ENDIF
       ELSEIF(TYBE.EQ.2)THEN
        IF(IACT.EQ.2)WRITE(ISCAP,'(I10,8X,F8.2,32X,I10)') NUND,QBER,AEND
       ENDIF
      ENDIF
    
      !## coupling to surface water
      IF(IACT.EQ.2.AND.PBMAN%DMMFILE.EQ.1.AND.TYBE.EQ.2)THEN
       !## coupling for sprinklink - nearest DFMFM-point no matter what afwat-unit
       CALL IDFGETLOC(PRJIDF,JROW,JCOL,XC,YC)
       INEAREST=PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,.FALSE.,DRC)
       IF(INEAREST.GT.0)THEN
        WRITE(IMSWP_SDFM,'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NUND
        NMSWP_SDFM=NMSWP_SDFM+1
       ENDIF
      ENDIF
      
      !## sprinkling from other than modellayer 1 or other location
      IF(TYBE.EQ.1.AND.LYBE.GT.1)THEN
 
       NWEL=NWEL+1
 
       !## add couple location modflow
       CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,LYBE,JROW,JCOL,UNID,IACT)

       IF(IACT.EQ.2)THEN
        IF(PBMAN%IFORMAT.EQ.3)THEN
         WRITE(WMF6_MSWP,'(3I10,F10.2)')  LYBE,JROW,JCOL,0.0D0
         WRITE(WINDEX_MSWP,'(3I10)')      NWEL,NUND,LYBE
        ENDIF
        WRITE(IGWMP,'(I10,2X,I10,I5)')   UNID,NUND,LYBE
        WRITE(IMODSIM,'(I10,2X,I10,I5)') UNID,NUND,LYBE
       ENDIF
      
      ENDIF 
     ENDIF

     !## END scap_svat.inp - grondwater + ow

     !## BEGIN mod2svat.inp; NB: als opp. water of glas dan laag = 0
    
     IF(IPWT.EQ.0)THEN
      IF(IACT.EQ.2)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(20))THEN
       IF(IACT.EQ.2)WRITE(IUSCL,'(I10,4F8.3,2I10)')    NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0D0, &
                                                       SIMGRO(ICOL,IROW)%MV-SIMGRO(ICOL,IROW)%PWT_LEVEL,ICOL,IROW
      ELSE
       IF(IACT.EQ.2)WRITE(IUSCL,'(I10,3F8.3,8X,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0D0,ICOL,IROW
      ENDIF
     ENDIF
    
     !## END mod2svat.inp; NB: als opp. water of glas dan laag = 0

    !## end rural area
    ENDIF

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

     !## write idf_svat.inp
     IF(IACT.EQ.2)THEN
      WRITE(IIDF,'(3I10,2F15.3)') NUND,IROW,ICOL,XC,YC 
      SVATURBAN%X(ICOL,IROW)=NUND
     ENDIF
       
     !## write sel_svat_bda.inp
     IF(IACT.EQ.2)THEN
      WRITE(ISELSVAT,'(I10)') NUND

      CALL IDFGETLOC(PRJIDF,IROW,ICOL,XC,YC)
      
      IF(PBMAN%DMMFILE.EQ.1)THEN
       WRITE(IDFM_MSWP,'(I15,3F15.3)') NUND,XC,YC,1.0D0; NDFM_MSWP =NDFM_MSWP +1
       WRITE(IMSWP_PDFM,'(2F15.3,I15)') XC,YC,NUND;      NMSWP_PDFM=NMSWP_PDFM+1
       !## coupling for urban runoff - nearest DFMFM-point in same afwat-unit
       INEAREST=PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,.TRUE.,DRC)
       IF(INEAREST.GT.0)THEN
        WRITE(IMSWP_SDFM,'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NUND       
        NMSWP_SDFM=NMSWP_SDFM+1
       ENDIF
      ENDIF
      
      WRITE(IAREA,'(I10,F10.1,F8.3,8X,I6,16X,I6,F8.3,I10,2F8.2)') &  
        NUND,ARND,SIMGRO(ICOL,IROW)%MV,SIMGRO(ICOL,IROW)%BODEM,18,0.1,SIMGRO(ICOL,IROW)%METEO,1.0D0,1.0D0

      WRITE(INDSB,'(2I10,F8.3,2F8.1)') NUND,0,SIMGRO(ICOL,IROW)%VXMU_SOPP,SIMGRO(ICOL,IROW)%CRUNOFF_SOPP,SIMGRO(ICOL,IROW)%CRUNON_SOPP 
     ENDIF
    
     !## add couple location modflow
     CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,ILAY,IROW,ICOL,UNID,IACT)

     IF(IACT.EQ.2)THEN
      IF(PBMAN%IFORMAT.EQ.3)THEN
       WRITE(IUNOD,'(3I10)') UNID,NUND,1
       IF(.NOT.LURBAN)THEN
        !## new recharge point
        NRCH=NRCH+1
        WRITE(RMF6_MSWP,'(3I10,F10.2)')  ILAY,IROW,ICOL,0.0D0
!        WRITE(RMF6_MSWP,'(3I10,F10.2)')  1,IROW,ICOL,0.0D0
       ENDIF
       WRITE(RINDEX_MSWP,'(3I10)')  NRCH,NUND,1
      ENDIF      
      WRITE(IGWMP,'(I10,2X,I10,I5)')   UNID,NUND,1
      WRITE(IMODSIM,'(I10,2X,I10,I5)') UNID,NUND,1
     ENDIF
    
     IF(IPWT.EQ.0)THEN
      IF(IACT.EQ.2)WRITE(IUSCL,'(I10,3F8.3,8X,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0D0,ICOL,IROW
     ELSE
      IF(SIMGRO(ICOL,IROW)%PWT_LEVEL.NE.NODATA(20))THEN
       IF(IACT.EQ.2)WRITE(IUSCL,'(I10,4F8.3,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0D0, &
                                         SIMGRO(ICOL,IROW)%MV-SIMGRO(ICOL,IROW)%PWT_LEVEL,ICOL,IROW
      ELSE
       IF(IACT.EQ.2)WRITE(IUSCL,'(I10,3F8.3,8X,2I10)') NUND,SIMGRO(ICOL,IROW)%MOISTURE,SIMGRO(ICOL,IROW)%COND,1.0D0,ICOL,IROW
      ENDIF
     ENDIF
    
     !## write infi_svat.inp, infiltratiecapaciteit per cel, de rest -9999.
     IF(IACT.EQ.2)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(IACT.EQ.1)CALL GENIDDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,NDXC)
 ENDDO

! IF(PBMAN%FLEXD.EQ.1)THEN
! DO I=1,NUND; WRITE(IDQSAT,'(I10,F8.3)') I,6.0; ENDDO
! ENDIF

 !## write *.dxc (not for MF6)
 IF(PBMAN%IFORMAT.NE.3)CALL WRITEDXC(IDXC,DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,NDXC)
 DEALLOCATE(DXCID)

 IF(PBMAN%IFORMAT.EQ.3)THEN
  WRITE(WMF6_MSWP,'(A)') 'END PERIOD'
  WRITE(RMF6_MSWP,'(A)') 'END PERIOD'
 ENDIF
  
 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)
 IF(IUNOD.GT.0)      CLOSE(IUNOD)
 IF(IFLEXD.GT.0)     CLOSE(IFLEXD)
! IF(IDQSAT.GT.0)     CLOSE(IDQSAT)
 IF(WINDEX_MSWP.GT.0)CLOSE(WINDEX_MSWP)
 IF(RINDEX_MSWP.GT.0)CLOSE(RINDEX_MSWP)
 IF(WMF6_MSWP.GT.0)  CLOSE(WMF6_MSWP)
 IF(RMF6_MSWP.GT.0)  CLOSE(RMF6_MSWP)
 IF(ALLOCATED(FLXUID))DEALLOCATE(FLXUID)
 
 IF(PBMAN%DMMFILE.EQ.1)THEN
  IF(IDFM_MSWP.GT.0)THEN
   IF(NDFM_MSWP.GT.0)THEN;  CLOSE(IDFM_MSWP);  ELSE; CLOSE(IDFM_MSWP,STATUS='DELETE'); ENDIF
  ENDIF
  IF(IMSWP_PDFM.GT.0)THEN
   IF(NMSWP_PDFM.GT.0)THEN; CLOSE(IMSWP_PDFM); ELSE; CLOSE(IMSWP_PDFM,STATUS='DELETE'); ENDIF
  ENDIF
  IF(IMSWP_SDFM.GT.0)THEN
   IF(NMSWP_SDFM.GT.0)THEN; CLOSE(IMSWP_SDFM); ELSE; CLOSE(IMSWP_SDFM,STATUS='DELETE'); ENDIF
  ENDIF
  IF(IMSWP_RDFM.GT.0)THEN
   IF(NMSWP_RDFM.GT.0)THEN; CLOSE(IMSWP_RDFM); ELSE; CLOSE(IMSWP_RDFM,STATUS='DELETE'); ENDIF
  ENDIF
  CALL PMANAGER_SAVEMF2005_DEALL_DFFMGRID()
  DEALLOCATE(DFFM)
 ENDIF
 IF(PBMAN%FLEXD.EQ.1)THEN
  ACTPLN%FNAME=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)//'\MSWAPINPUT\ACTPLN.IDF'
  IF(.NOT.IDFWRITE(ACTPLN,ACTPLN%FNAME,1))THEN
  ENDIF
  CALL IDFDEALLOCATEX(ACTPLN)
 ENDIF
 SVATRURAL%FNAME=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)//'\MSWAPINPUT\SVATRURAL.IDF'
 IF(.NOT.IDFWRITE(SVATRURAL,SVATRURAL%FNAME,1))THEN; ENDIF; CALL IDFDEALLOCATEX(SVATRURAL)
 SVATURBAN%FNAME=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)//'\MSWAPINPUT\SVATURBAN.IDF'
 IF(.NOT.IDFWRITE(SVATURBAN,SVATURBAN%FNAME,1))THEN; ENDIF; CALL IDFDEALLOCATEX(SVATURBAN)
 
 IF(PBMAN%IFORMAT.EQ.3)THEN
  DIR=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)//'\MODELINPUT'
  CALL UTL_MF2005_MAXNO(TRIM(DIR)//'\MSW.WEL6_',(/NWEL/))
  CALL UTL_MF2005_MAXNO(TRIM(DIR)//'\MSW.RCH6_',(/NRCH/))
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEMF2005_MSP_INPFILES

 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_DEALL_DFFMGRID()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IROW,ICOL
 
 !## deallocate any tree memory
 IF(ALLOCATED(DFFMGRID))THEN
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(ASSOCIATED(DFFMGRID(ICOL,IROW)%ID))THEN
    DEALLOCATE(DFFMGRID(ICOL,IROW)%ID)
   ENDIF
  ENDDO; ENDDO
  DEALLOCATE(DFFMGRID)
 ENDIF

 END SUBROUTINE PMANAGER_SAVEMF2005_DEALL_DFFMGRID

 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_READ_DFFMPOINTS(DIR)
 !###====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR
 INTEGER :: JU,I,J,N,IOS,IZ,IROW,ICOL
 LOGICAL :: LEX
 
 JU=UTL_GETUNIT()
 INQUIRE(FILE=TRIM(DIR)//'\DFLOWFM_POINTS.DAT',EXIST=LEX)
 IF(LEX)THEN
  CALL OSD_OPEN(JU,FILE=TRIM(DIR)//'\DFLOWFM_POINTS.DAT',STATUS='OLD', &
                FORM='FORMATTED',ACTION='READ,DENYWRITE',ACCESS='SEQUENTIAL')
  ALLOCATE(DFFM(1))
  N=0; DO I=1,2
   READ(JU,*,IOSTAT=IOS); IF(IOS.NE.0)THEN; DEALLOCATE(DFFM); EXIT; ENDIF
   J=1; DO
    READ(JU,*,IOSTAT=IOS) DFFM(J)%ISEG,DFFM(J)%INODE,DFFM(J)%IZONE,DFFM(J)%X,DFFM(J)%Y
    IF(IOS.NE.0)EXIT; IF(I.EQ.1)N=N+1
    J=J+1; IF(I.EQ.1)J=1; IF(I.EQ.2.AND.J.GT.N)EXIT 
   ENDDO
   IF(I.EQ.1)THEN
    DEALLOCATE(DFFM); IF(N.GT.0)ALLOCATE(DFFM(N))
   ENDIF
   REWIND(JU)
  ENDDO
 ENDIF

 !## create raster with id's 
 ALLOCATE(DFFMGRID(PRJIDF%NCOL,PRJIDF%NROW))
 DO I=1,2
  DFFMGRID%NID=0
  DO J=1,SIZE(DFFM)
   CALL IDFIROWICOL(PRJIDF,IROW,ICOL,DFFM(J)%X,DFFM(J)%Y)
   DFFMGRID(ICOL,IROW)%NID=DFFMGRID(ICOL,IROW)%NID+1
   IF(I.EQ.2)THEN
    DFFMGRID(ICOL,IROW)%ID(DFFMGRID(ICOL,IROW)%NID)=J
   ENDIF
  ENDDO
  IF(I.EQ.1)THEN
   DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
    NULLIFY(DFFMGRID(ICOL,IROW)%ID)
    IF(DFFMGRID(ICOL,IROW)%NID.GT.0)THEN
     ALLOCATE(DFFMGRID(ICOL,IROW)%ID(DFFMGRID(ICOL,IROW)%NID))
    ENDIF
   ENDDO; ENDDO
  ENDIF
 ENDDO
 
 !## read afwatidf 
 IF(AFWATIDF%FNAME.NE.'')THEN
  CALL IDFCOPY(BND(1),AFWATIDF)
  IF(.NOT.IDFREADSCALE(AFWATIDF%FNAME,AFWATIDF,7,0,0.0D0,0))THEN
   WRITE(*,'(/1X,A/)') 'CANNOT READ '//TRIM(AFWATIDF%FNAME); STOP
  ENDIF
 ENDIF
 
! afwatidf%x=dffmgrid%nid
! if(.not.idfwrite(afwatidf,'d:\tmp.idf',0))then; endif
 
! IF(MINVAL(DFFM%IZONE).EQ.MAXVAL(DFFM%IZONE))THEN
!  ALLOCATE(XY(N,2)); XY(:,1)=DFFM%X; XY(:,2)=DFFM%Y
!  TREE=>CREATE_TREE(XY)
!  DEALLOCATE(XY)
! ENDIF

 END SUBROUTINE PMANAGER_SAVEMF2005_READ_DFFMPOINTS

 !###====================================================================
 INTEGER FUNCTION PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,LZONE,DRC)
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 INTEGER,INTENT(INOUT) :: DRC
 LOGICAL,INTENT(IN) :: LZONE
 INTEGER :: I,II,J,N,IZONE,ICOL,IROW,JROW,JCOL
 REAL(KIND=DP_KIND) :: D,TD
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_DMM_GETXY=0
 
 !## get zone  number for dfflow-fm node
 IZONE=0; IF(AFWATIDF%FNAME.NE.''.AND.LZONE)THEN
  CALL IDFIROWICOL(AFWATIDF,IROW,ICOL,XC,YC)
  IF(AFWATIDF%X(ICOL,IROW).EQ.AFWATIDF%NODATA)THEN
   IZONE=0
  ELSE
   IZONE=AFWATIDF%X(ICOL,IROW)
  ENDIF
  !## not to be assigned
  IF(IZONE.EQ.0)RETURN
 ENDIF

 CALL IDFIROWICOL(PRJIDF,IROW,ICOL,XC,YC)

 TD=HUGE(1.0); J=0; DRC=0; DO
  
  !## nothing found
  IF(MAX(1,IROW-DRC).EQ.1.AND.MIN(PRJIDF%NROW,IROW+DRC).EQ.PRJIDF%NROW.AND. &
     MAX(1,ICOL-DRC).EQ.1.AND.MIN(PRJIDF%NCOL,ICOL+DRC).EQ.PRJIDF%NCOL)THEN
   !## reset drc and search again without zone-checking
   DRC=0; IZONE=0
  ENDIF
  
  DO JROW=MAX(1,IROW-DRC),MIN(PRJIDF%NROW,IROW+DRC)
   DO JCOL=MAX(1,ICOL-DRC),MIN(PRJIDF%NCOL,ICOL+DRC)
   
    N=DFFMGRID(JCOL,JROW)%NID
    DO II=1,N
     I=DFFMGRID(JCOL,JROW)%ID(II)
     LEX=.TRUE.; IF(IZONE.NE.0)THEN
      IF(IZONE.NE.DFFM(I)%IZONE)LEX=.FALSE.
     ENDIF
     IF(LEX)THEN
      D=UTL_DIST(XC,YC,DFFM(I)%X,DFFM(I)%Y)
      IF(D.LT.TD)THEN
       TD=D; J=I
      ENDIF
     ENDIF
    ENDDO

   ENDDO
  ENDDO
  !## found something, if not increase search-box
  IF(J.NE.0)EXIT
  DRC=DRC+1
 ENDDO
 
 !## reduce with one for next time
 DRC=DRC-1

 PMANAGER_SAVEMF2005_DMM_GETXY=J
 
 END FUNCTION PMANAGER_SAVEMF2005_DMM_GETXY
 
 !###====================================================================
 SUBROUTINE STOREDXC(DXCID,NCOL,NROW,NLAY,ILAY,IROW,ICOL,ID,IACT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NCOL,NROW,NLAY
 INTEGER,INTENT(INOUT) :: ID
 INTEGER,INTENT(IN) :: IACT
 INTEGER,INTENT(INOUT), DIMENSION(NCOL,NROW,NLAY) :: DXCID
 INTEGER,INTENT(IN) :: ILAY, IROW, ICOL

 IF(IACT.EQ.2) THEN
  ID=DXCID(ICOL,IROW,ILAY)
  RETURN
 END IF
 
 IF(DXCID(ICOL,IROW,ILAY).EQ.0) THEN
  DXCID(ICOL,IROW,ILAY)=1
 ENDIF
 
 END SUBROUTINE STOREDXC

 !###====================================================================
 SUBROUTINE GENIDDXC(DXCID,NCOL,NROW,NLAY,ID)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NCOL,NROW,NLAY
 INTEGER,INTENT(OUT) :: ID
 INTEGER,INTENT(INOUT), DIMENSION(NCOL,NROW,NLAY) :: DXCID
 INTEGER :: ILAY, ICOL, IROW
 
 !## generate id's
 IF(PBMAN%IFORMAT.EQ.3)THEN
  !## use modflow-cell id for mf6
  ID=0; DO ILAY=1,NLAY; DO IROW=1,NROW; DO ICOL=1,NCOL
   !## increase for ibound <> 0, modflow number is excluding inactive cells
   IF(BND(ILAY)%X(ICOL,IROW).NE.0.0D0)ID=ID+1
   IF(DXCID(ICOL,IROW,ILAY).NE.0)THEN
!    ID=(ILAY-1)*NROW*NCOL+(IROW-1)*NCOL+ICOL
    DXCID(ICOL,IROW,ILAY)=ID
   ENDIF
  ENDDO; ENDDO; ENDDO
 ELSE
  !## use unique id's
  ID=0
  DO ILAY=1,NLAY; DO IROW=1,NROW; DO ICOL=1,NCOL
   IF(DXCID(ICOL,IROW,ILAY).NE.0)THEN
    ID=ID+1; DXCID(ICOL,IROW,ILAY)=ID
   ENDIF
  ENDDO; ENDDO; ENDDO
 ENDIF
 
 END SUBROUTINE
 
 !###====================================================================
 SUBROUTINE WRITEDXC(IDXC,DXCID,NCOL,NROW,NLAY,NDXC)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IDXC,NCOL,NROW,NLAY,NDXC 
 INTEGER,INTENT(IN), DIMENSION(NCOL,NROW,NLAY) :: DXCID
 INTEGER :: ICOL,IROW,ILAY,ID
               
 WRITE(IDXC,'(2I10)') NDXC,ICAPCB
 WRITE(IDXC,'(I10)')  NDXC 
 
 DO ILAY=1,NLAY; DO IROW=1,NROW; DO ICOL=1,NCOL
  ID=DXCID(ICOL,IROW,ILAY)
  IF(ID.NE.0)THEN        
   IF(ID.LT.0)THEN 
    WRITE(IDXC,*) -ILAY,IROW,ICOL,ABS(DXCID(ICOL,IROW,ILAY))
   ELSE
    WRITE(IDXC,*)  ILAY,IROW,ICOL,ABS(DXCID(ICOL,IROW,ILAY))
   ENDIF 
  ENDIF   
 ENDDO; ENDDO; ENDDO
 IF(PBMAN%DMMFILE.EQ.1)THEN
  WRITE(IDXC,'(A)') 'DFLOWFM'
!  WRITE(IDXC,'(A)') TRIM(ITOS(NDFLOWFMRIV1+NDFLOWFMRIV2))//','// &
!                    TRIM(ITOS(NDFLOWFMRIV1+NDFLOWFMRIV2))//','// &
!                    TRIM(ITOS(NDFLOWFMDRN1))
 ENDIF

 IF(IDXC.GT.0)CLOSE(IDXC)

 END SUBROUTINE WRITEDXC
  
 !###====================================================================
 SUBROUTINE METASWAP_METEGRID1(FNAME,FNAME2)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: NA=11
 CHARACTER(LEN=1024) :: S
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=*),INTENT(IN) :: FNAME2
 INTEGER :: IU,JU,I,IOS
 CHARACTER(LEN=256), DIMENSION(11) :: SA
 CHARACTER(LEN=256) :: RUNDIR
 CHARACTER(LEN=8) :: FRM
 
 WRITE(FRM,'(A1,I2.2,A2)') '(',NA,'A)'
 
 CALL IOSDIRNAME(RUNDIR) 

 IU=UTL_GETUNIT(); OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ')
 JU=UTL_GETUNIT(); OPEN(JU,FILE=FNAME2,STATUS='REPLACE',ACTION='WRITE')
 DO
  READ(IU,'(A1024)',IOSTAT=IOS) S; IF(IOS.NE.0)EXIT
  IF(LEN_TRIM(S).EQ.0)CYCLE
  !## initial value
  SA='NoValue'
  READ(S,*,IOSTAT=IOS)(SA(I),I=1,NA)
  CALL UTL_REL_TO_ABS(RUNDIR,SA(3)) 
  CALL UTL_REL_TO_ABS(RUNDIR,SA(4))
  DO I=3,NA;   SA(I)='"'//TRIM(ADJUSTL(SA(I)))//'"'; END DO
  DO I=1,NA-1; SA(I)=TRIM(SA(I))//','              ; END DO
  WRITE(S,FRM)(TRIM(SA(I)),I=1,NA)
  WRITE(JU,'(A)') TRIM(S)
 ENDDO
 CLOSE(IU)
 CLOSE(JU)

 END SUBROUTINE METASWAP_METEGRID1
 
 !###====================================================================
 SUBROUTINE METASWAP_METEGRID2(DIRMSP)
 !###====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMSP
 LOGICAL :: LEX
 REAL(KIND=DP_KIND) :: TD
 INTEGER :: IU,IY
 CHARACTER(LEN=256) :: PRECFNAME,ETFNAME

 !## inquire the existence of mete_grid.inp
 INQUIRE(FILE=TRIM(DIRMSP)//'\METE_GRID.INP',EXIST=LEX); IF(.NOT.LEX)RETURN

 !## open mete_grid.inp
 IU=UTL_GETUNIT()
 OPEN(IU,FILE=TRIM(DIRMSP)//'\METE_GRID.INP',STATUS='OLD',ACTION='READ')
 READ(IU,*) TD,IY,PRECFNAME,ETFNAME
 CLOSE(IU)
 
 !## create coupling tables
 CALL METASWAP_METEGRID_INP(PRECFNAME,TRIM(DIRMSP)//'\SVAT2PRECGRID.INP')
 CALL METASWAP_METEGRID_INP(ETFNAME,  TRIM(DIRMSP)//'\SVAT2ETREFGRID.INP')

 END SUBROUTINE METASWAP_METEGRID2

 !###====================================================================
 SUBROUTINE METASWAP_METEGRID_INP(ASCIIFNAME,INPFNAME)
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IU,A_NROW,A_NCOL,IROW,ICOL,IR1,IR2,IC1,IC2,NUND
 CHARACTER(LEN=*),INTENT(IN) :: ASCIIFNAME,INPFNAME
 REAL(KIND=DP_KIND) :: A_XLLC,A_YLLC,A_NODATA,A_CELLSIZE,IX,IY,ARND
 CHARACTER(LEN=52) :: TXT
 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: PDELR,PDELC

 IF(ALLOCATED(PDELR))DEALLOCATE(PDELR)
 IF(ALLOCATED(PDELC))DEALLOCATE(PDELC)
 ALLOCATE(PDELR(2,PRJIDF%NCOL),PDELC(2,PRJIDF%NROW))

 !## read header of ascii file
 IU=UTL_GETUNIT(); OPEN(IU,FILE=ASCIIFNAME,ACTION='READ',STATUS='OLD')
 READ(IU,*) TXT,A_NCOL
 READ(IU,*) TXT,A_NROW
 READ(IU,*) TXT,A_XLLC
 TXT=UTL_CAP(TXT,'U');IX=0.0D0; IF(TRIM(TXT).EQ.'XLLCENTER')IX=1.0D0
 READ(IU,*) TXT,A_YLLC
 TXT=UTL_CAP(TXT,'U'); IY=0.0D0; IF(TRIM(TXT).EQ.'YLLCENTER')IY=1.0D0
 READ(IU,*) TXT,A_CELLSIZE
 READ(IU,*) TXT,A_NODATA
 A_XLLC=A_XLLC-(IX*(A_CELLSIZE/2.0D0)); A_YLLC=A_YLLC-(IY*(A_CELLSIZE/2.0D0))
 CLOSE(IU)

 CALL IMOD_UTL_SCALE1PDELRC(A_XLLC,A_YLLC,A_XLLC+(A_NCOL*A_CELLSIZE),A_YLLC+(A_NROW*A_CELLSIZE), &
           PRJIDF%SX,PRJIDF%SY,PDELR,PDELC,PRJIDF%NROW,PRJIDF%NCOL,A_CELLSIZE,A_NROW,A_NCOL,0,0,0)

 !## write koppeltabel
 IU=UTL_GETUNIT(); OPEN(IU,FILE=INPFNAME,ACTION='WRITE',STATUS='UNKNOWN')

 !## fill svat connection to recharge/et based upon svat-units
 NUND=0 
 DO IROW=1,PRJIDF%NROW
  DO ICOL=1,PRJIDF%NCOL
   !## rural area
   ARND=IDFGETAREA(PRJIDF,ICOL,IROW)
   ARND=ARND-SIMGRO(ICOL,IROW)%NOPP-SIMGRO(ICOL,IROW)%SOPP
   IF(SIMGRO(ICOL,IROW)%IBOUND.GT.0.AND.ARND.GT.0.0)THEN
    NUND  =NUND+1
    IR1=PDELC(1,IROW); IF(IR1.LT.0)IR1=PDELC(1,ABS(IR1))
    IR2=PDELC(2,IROW); IF(IR2.LT.0)IR2=PDELC(2,ABS(IR2))
    IC1=PDELR(1,ICOL); IF(IC1.LT.0)IC1=PDELR(1,ABS(IC1))
    IC2=PDELR(2,ICOL); IF(IC2.LT.0)IC2=PDELR(2,ABS(IC2))
    WRITE(IU,'(3I10,10X,2I10)') NUND,IR1,IC1,IR2,IC2
   ENDIF
   !## urban area
   ARND=IDFGETAREA(PRJIDF,ICOL,IROW)
   ARND=MIN(ARND,SIMGRO(ICOL,IROW)%SOPP)
   IF(SIMGRO(ICOL,IROW)%IBOUND.GT.0.AND.ARND.GT.0.0)THEN
    NUND=NUND+1
    IR1=PDELC(1,IROW); IF(IR1.LT.0)IR1=PDELC(1,ABS(IR1))
    IR2=PDELC(2,IROW); IF(IR2.LT.0)IR2=PDELC(2,ABS(IR2))
    IC1=PDELR(1,ICOL); IF(IC1.LT.0)IC1=PDELR(1,ABS(IC1))
    IC2=PDELR(2,ICOL); IF(IC2.LT.0)IC2=PDELR(2,ABS(IC2))
    WRITE(IU,'(3I10,10X,2I10)') NUND,IR1,IC1,IR2,IC2
   ENDIF
  ENDDO
 ENDDO

 CLOSE(IU)

 IF(ALLOCATED(PDELR))DEALLOCATE(PDELR)
 IF(ALLOCATED(PDELC))DEALLOCATE(PDELC)

 END SUBROUTINE METASWAP_METEGRID_INP
 
 !###====================================================================
 SUBROUTINE IMOD_UTL_SCALE1PDELRC(XMIN,YMIN,XMAX,YMAX,SXX,SYY,PDELR,PDELC,NROW,NCOL,CS,NROWIDF,NCOLIDF,IU,IEQ,ITB)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NROW,NCOL,NROWIDF,NCOLIDF,IU,IEQ,ITB
 REAL(KIND=8),INTENT(IN) :: CS,XMIN,YMIN,XMAX,YMAX
 REAL(KIND=8),INTENT(IN),DIMENSION(0:NCOL) :: SXX
 REAL(KIND=8),INTENT(IN),DIMENSION(0:NROW) :: SYY
 REAL(KIND=8) :: DX,DY
 INTEGER,INTENT(OUT),DIMENSION(2,NCOL) :: PDELR
 INTEGER,INTENT(OUT),DIMENSION(2,NROW) :: PDELC
 INTEGER :: I,J,IREC
 CHARACTER(LEN=256) :: IDFNAME
 REAL(KIND=8),ALLOCATABLE,DIMENSION(:) :: DELRIDF,DELCIDF

 IF(XMIN.GT.SXX(0).OR.XMAX.LT.SXX(NCOL).OR.YMIN.GT.SYY(NROW).OR.YMAX.LT.SYY(0))THEN
  INQUIRE(UNIT=IU,NAME=IDFNAME)
  WRITE(*,'(A)') '======================================='
  WRITE(*,'(A)') 'Warning!'
  WRITE(*,'(A)') 'File: '//TRIM(IDFNAME)
  WRITE(*,'(A)') 'Undersizes current model dimensions!'
  IF(XMIN.GT.SXX(0))THEN
   WRITE(*,'(A)') 'XMIN IDF '//TRIM(RTOS(XMIN,'F',2))//' > XMIN MODEL '//TRIM(RTOS(SXX(0),'F',2))
  ENDIF
  IF(XMAX.LT.SXX(NCOL))THEN
   WRITE(*,'(A)') 'XMAX IDF '//TRIM(RTOS(XMAX,'F',2))//' < XMAX MODEL '//TRIM(RTOS(SXX(NCOL),'F',2))
  ENDIF
  IF(YMIN.GT.SYY(NROW))THEN
   WRITE(*,'(A)') 'YMIN IDF '//TRIM(RTOS(YMIN,'F',2))//' > YMIN MODEL '//TRIM(RTOS(SYY(NROW),'F',2))
  ENDIF
  IF(YMAX.LT.SYY(0))THEN
   WRITE(*,'(A)') 'YMAX IDF '//TRIM(RTOS(YMAX,'F',2))//' < YMAX MODEL '//TRIM(RTOS(SYY(0),'F',2))
  ENDIF
  WRITE(*,'(A)') '======================================='
  WRITE(*,'(A)') 'Error'
 ENDIF

 IF(ALLOCATED(DELRIDF))DEALLOCATE(DELRIDF)
 IF(ALLOCATED(DELCIDF))DEALLOCATE(DELCIDF)
 ALLOCATE(DELRIDF(0:NCOLIDF),DELCIDF(0:NROWIDF))

 DELRIDF(0)=XMIN
 DELCIDF(0)=YMAX

 IF(IEQ.EQ.0)THEN
  DO I=1,NCOLIDF; DELRIDF(I)=XMIN+REAL(I)*CS; ENDDO
  DO I=1,NROWIDF; DELCIDF(I)=YMAX-REAL(I)*CS; ENDDO
 ELSEIF(IEQ.EQ.1)THEN
  IREC      =10+ITB*2
  DO I=1,NCOLIDF
   IREC=IREC+1
   READ(IU,REC=IREC+ICF) DELRIDF(I)
   DELRIDF(I)=DELRIDF(I-1)+DELRIDF(I)
  END DO
  DO I=1,NROWIDF
   IREC=IREC+1
   READ(IU,REC=IREC+ICF) DELCIDF(I)
   DELCIDF(I)=DELCIDF(I-1)-DELCIDF(I)
  END DO
 ENDIF

 !## start/end column direction
 DO I=1,NCOL
  CALL POL1LOCATE(DELRIDF,NCOLIDF+1,SXX(I-1),PDELR(1,I))
  !## check whether position is exact equally
  J=PDELR(1,I)
  IF(J.LE.NCOLIDF)THEN
   IF(DELRIDF(J).EQ.SXX(I-1))PDELR(1,I)=PDELR(1,I)+1
  ENDIF
  CALL POL1LOCATE(DELRIDF,NCOLIDF+1,SXX(I),PDELR(2,I))
  PDELR(1,I)=MIN(PDELR(1,I),NCOLIDF)
  PDELR(2,I)=MIN(PDELR(2,I),NCOLIDF)
 ENDDO

 DO I=1,NROW
  CALL POL1LOCATE(DELCIDF,NROWIDF+1,SYY(I-1),PDELC(1,I))
  CALL POL1LOCATE(DELCIDF,NROWIDF+1,SYY(I),PDELC(2,I))
  !## check whether position is exact equally
  J=PDELC(2,I)
  IF(J.LE.NROWIDF)THEN
   IF(DELCIDF(J-1).EQ.SYY(I))PDELC(2,I)=PDELC(2,I)-1
  ENDIF
  PDELC(1,I)=MIN(PDELC(1,I),NROWIDF)
  PDELC(2,I)=MIN(PDELC(2,I),NROWIDF)
 ENDDO
 IF(ALLOCATED(DELRIDF))DEALLOCATE(DELRIDF)
 IF(ALLOCATED(DELCIDF))DEALLOCATE(DELCIDF)

 DO I=1,NCOL
  IF(PDELR(2,I).LT.PDELR(1,I))then
   DX        =(SXX(I-1)-XMIN)/CS
   PDELR(1,I)=INT(DX)+1
   DX        =(SXX(I)-XMIN)/CS
   PDELR(2,I)=INT(DX)+1
   DX=SXX(I)-XMIN
   IF(MOD(DX,CS).EQ.0.0)PDELR(2,I)=PDELR(2,I)-1
   WRITE(*,'(A)') 'PDELR(2,I).LT.PDELR(1,I)'
  ENDIF
 ENDDO
 DO I=1,NROW
  IF(PDELC(2,I).LT.PDELC(1,I))THEN
   DY=(YMAX-SYY(I-1))/CS
   PDELC(1,I)=INT(DY)+1
   DY=(YMAX-SYY(I))
   PDELC(2,I)=INT(DY)+1
   DY=YMAX-SYY(I)
   IF(MOD(DY,CS).EQ.0.0)PDELC(2,I)=PDELC(2,I)-1
   WRITE(*,'(A)') 'PDELC(2,I).LT.PDELC(1,I)'
  ENDIF
 ENDDO

 !## adjust pdelr/pdelc in case reading idf is coarser, then you don't need to read it in again, values will be copied in READCOPYVALUES_R()
 J=1
 DO I=2,NCOL
  IF(PDELR(1,I).EQ.PDELR(1,J).AND. &
     PDELR(2,I).EQ.PDELR(2,J))THEN
   PDELR(1,I)=-J
   PDELR(2,I)=-J
  ELSE
   J=I
  ENDIF
 END DO
 J=1
 DO I=2,NROW
  IF(PDELC(1,I).EQ.PDELC(1,J).AND. &
     PDELC(2,I).EQ.PDELC(2,J))THEN
   PDELC(1,I)=-J
   PDELC(2,I)=-J
  ELSE
   J=I
  ENDIF
 END DO

 END SUBROUTINE IMOD_UTL_SCALE1PDELRC
 
 !###====================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MSP_CHECK(NODATA,IBATCH) 
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:),INTENT(IN) :: NODATA
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER,DIMENSION(:),ALLOCATABLE :: IERROR
 INTEGER :: IROW,ICOL,STRLEN,JROW,JCOL,LYBE,TYBE,BEREGENID,L,L1,L2,IL,ILAY,N
 LOGICAL :: LYESNO
 REAL(KIND=DP_KIND) :: DXY,ARND,X,Y,KDCRIT
 CHARACTER(LEN=:),ALLOCATABLE :: STR
 CHARACTER(LEN=1) :: CYESNO

 PMANAGER_SAVEMF2005_MSP_CHECK=.FALSE.
 
 !## inactivate constant head boundaries and inactive nodes
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  !## skip this location anyhow if simgro-ibound = 0
  IF(SIMGRO(ICOL,IROW)%IBOUND.EQ.0)CYCLE
  !## loop for appropriate modellayer
  DO ILAY=1,PRJNLAY
   IF(BND(ILAY)%X(ICOL,IROW).GT.0.0D0)THEN
    SIMGRO(ICOL,IROW)%IBOUND=ILAY; EXIT
   ENDIF
  ENDDO
  IF(ILAY.GT.PRJNLAY)SIMGRO(ICOL,IROW)%IBOUND=0
!   IF(BND(1)%X(ICOL,IROW).LE.0.0D0)SIMGRO(ICOL,IROW)%IBOUND=0
 ENDDO; ENDDO
 
 IF(PBMAN%FLEXD.EQ.1)THEN  
  DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
   IF(SIMGRO(ICOL,IROW)%PDL.EQ.NODATA(25))SIMGRO(ICOL,IROW)%PDR=NODATA(26)
   IF(SIMGRO(ICOL,IROW)%PDR.EQ.NODATA(26))SIMGRO(ICOL,IROW)%PDL=NODATA(25)
  ENDDO; ENDDO
 ENDIF
 
 !## make sure that for sopp>0 there is a vxmu value, turn nopp otherwise off
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(SIMGRO(ICOL,IROW)%VXMU_SOPP.EQ.NODATA(12))SIMGRO(ICOL,IROW)%SOPP=0.0D0
  IF(SIMGRO(ICOL,IROW)%SOPP.GT.0.0D0)THEN
   IF(SIMGRO(ICOL,IROW)%VXMU_SOPP     .EQ.NODATA(12))SIMGRO(ICOL,IROW)%SOPP=0.0D0
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_SOPP  .EQ.NODATA(14))SIMGRO(ICOL,IROW)%SOPP=0.0D0
   IF(SIMGRO(ICOL,IROW)%CRUNON_SOPP   .EQ.NODATA(16))SIMGRO(ICOL,IROW)%SOPP=0.0D0
   IF(SIMGRO(ICOL,IROW)%QINFBASIC_SOPP.EQ.NODATA(18))SIMGRO(ICOL,IROW)%SOPP=0.0D0
  ENDIF
  DXY=IDFGETAREA(PRJIDF,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.0D0)THEN
   IF(SIMGRO(ICOL,IROW)%VXMU_ROPP     .EQ.NODATA(13))SIMGRO(ICOL,IROW)%NOPP=ARND !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%CRUNOFF_ROPP  .EQ.NODATA(15))SIMGRO(ICOL,IROW)%NOPP=ARND !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%CRUNON_ROPP   .EQ.NODATA(17))SIMGRO(ICOL,IROW)%NOPP=ARND !## surface water, no metaswap
   IF(SIMGRO(ICOL,IROW)%QINFBASIC_ROPP.EQ.NODATA(19))SIMGRO(ICOL,IROW)%NOPP=ARND !## surface water, no metaswap
  ENDIF
 ENDDO; ENDDO

 !## check input
 ALLOCATE(IERROR(26)); IERROR=0
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%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(PBMAN%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(TOPICS(TPWT)%IACT_MODEL.EQ.1)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
!  !## check whether drainageinformation is given for level-controlled drainage
!  IF(PBMAN%FLEXD.EQ.1)THEN
!   IF(SIMGRO(ICOL,IROW)%PLN.NE.NODATA(23))THEN
!    IF(SIMGRO(ICOL,IROW)%PDL.EQ.NODATA(25))          IERROR(25)=IERROR(25)+1
!    IF(SIMGRO(ICOL,IROW)%PDR.EQ.NODATA(26))          IERROR(26)=IERROR(26)+1
!   ELSE
!    SIMGRO(ICOL,IROW)%PLN=0
!   ENDIF
!  ENDIF
 ENDDO; ENDDO

 !## error in data
 IF(SUM(IERROR).GT.0)THEN
   IF(PBMAN%FLEXD.EQ.1)THEN; STRLEN=22*30; ELSE; STRLEN=26*30; ENDIF
   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)))
   IF(PBMAN%FLEXD.EQ.1)THEN
    STR=TRIM(STR)//NEWLINE// &
     '- Plot Number     '//TRIM(ITOS(IERROR(23)))//NEWLINE// &
     '- Drainage Level  '//TRIM(ITOS(IERROR(25)))//NEWLINE// &
     '- Drainage Resist.'//TRIM(ITOS(IERROR(26)))
   ENDIF
   STR=TRIM(STR)//NEWLINE//'Process stopped!'
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,TRIM(STR),'Error')
  DEALLOCATE(STR,IERROR); RETURN
 ENDIF

! !## change surface water into gras; change urban into gras
! DO IROW=1,PRJIDF%NROW
!  DO ICOL=1,PRJIDF%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,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(SIMGRO(ICOL,IROW)%RZ.LT.10.0D0)SIMGRO(ICOL,IROW)%RZ=10.0D0
 ENDDO; ENDDO
 
 !## minimal nopp-value
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  SIMGRO(ICOL,IROW)%NOPP=MAX(0.0D0,SIMGRO(ICOL,IROW)%NOPP)
  !## minimal sopp-value
  SIMGRO(ICOL,IROW)%SOPP=MAX(0.0D0,SIMGRO(ICOL,IROW)%SOPP)
 ENDDO; ENDDO
 
! !## bodem 22/23 vertalen naar 9 -> 22 (stedelijk zand?)/23(geen bodem; stad) -> zand
! DO IROW=1,PRJIDF%NROW
!  DO ICOL=1,PRJIDF%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(PBMAN%IFORMAT.EQ.3)THEN
  !## search for correct layer for artificial recharge, if this one is removed due to zero thickness
  N=0; LYESNO=.FALSE.
  DO IROW=1,PRJIDF%NROW
   DO ICOL=1,PRJIDF%NCOL
    
    IF(SIMGRO(ICOL,IROW)%IBOUND.EQ.0)CYCLE
    
    !## BEGIN scap_svat.inp - grondwater + ow
    TYBE=0
    IF(PBMAN%IARMWP.EQ.0)THEN
     LYBE=SIMGRO(ICOL,IROW)%BER_LAAG
     TYBE=SIMGRO(ICOL,IROW)%BEREGEN
     JCOL=ICOL; JROW=IROW
    ELSE
     JCOL=0; JROW=0
     BEREGENID=INT(SIMGRO(ICOL,IROW)%BEREGEN)
     IF(BEREGENID.GT.0.AND.BEREGENID.LE.SIZE(IPFMSP))THEN
      LYBE=IPFMSP(BEREGENID)%ILAY
      IF(LYBE.GT.0.AND.LYBE.LE.PRJNLAY)THEN
       TYBE=1 !## groundwater
       CALL IDFIROWICOL(PRJIDF,JROW,JCOL,IPFMSP(BEREGENID)%X,IPFMSP(BEREGENID)%Y)
      ENDIF
     ENDIF
    ENDIF  
    
    !## not from groundwater, skip checking
    IF(TYBE.NE.1)CYCLE

    IF(BND(LYBE)%X(JCOL,JROW).EQ.0)THEN

     IF(.NOT.LYESNO)THEN
      IF(IBATCH.EQ.0)THEN
       CALL WMESSAGEBOX(YESNO,COMMONNO,QUESTIONICON,'iMOD found inactive cell (icol='//TRIM(ITOS(JCOL))//',irow='//TRIM(ITOS(JROW))//') '// &
         'for MetaSWAP well, would you like to continue and let iMOD put the well in an appropriate modellayer (1st layer with k>0.1m/d) ?', &
         'Question')
       CYESNO='N'; IF(WINFODIALOG(4).EQ.1)CYESNO='Y'
      ELSE
       WRITE(*,'(/A$)') 'iMOD found inactive cell (icol='//TRIM(ITOS(JCOL))//',irow='//TRIM(ITOS(JROW))//') for MetaSWAP well, would '// &
           'you like to continue and let iMOD put the well in an appropriate modellayer (1st layer with k>0.1m/d) (Y/N) ?'
       READ(*,'(A1)') CYESNO
      ENDIF
      IF(UTL_CAP(CYESNO,'U').EQ.'N')THEN
       IF(IBATCH.EQ.0)RETURN; IF(IBATCH.EQ.1)STOP
      ENDIF
      LYESNO=.TRUE.
     ENDIF
    
     !## skip permeability < 0.1
     L1=MIN(PRJNLAY,LYBE+1); L2=PRJNLAY; IL=1; KDCRIT=0.1D0
     DO I=1,4
      DO L=L1,L2,IL
       IF(BND(L)%X(JCOL,JROW).NE.0.0D0.AND.KDW(L)%X(JCOL,JROW).GT.KDCRIT)EXIT 
      ENDDO
      SELECT CASE (I)
       CASE (1)
        !## found layer beneath
        IF(L.LE.PRJNLAY)EXIT; L1=MAX(1,LYBE-1)      ; L2=1      ; IL=-1
       CASE (2)
        !## find layer above
        IF(L.GE.1)EXIT;       L1=MIN(PRJNLAY,LYBE+1); L2=PRJNLAY; IL=1; KDCRIT=0.0D0
       CASE (3)
        !## found layer beneath
        IF(L.LE.PRJNLAY)EXIT; L1=MAX(1,LYBE-1)      ; L2=1      ; IL=-1
       CASE DEFAULT
        !## find layer above
        IF(L.GE.1)EXIT
!        IF(IBATCH.EQ.0)THEN
!         CALL WMESSAGEBOX(YESNO,COMMONNO,QUESTIONICON,'iMOD cannot position MetaSWAP well appropriately for location'//CHAR(13)// &
!         'icol='//TRIM(ITOS(JCOL))//' and irow='//TRIM(ITOS(JROW)),'Error'); RETURN
!        ELSE
         WRITE(*,'(/A)') 'iMOD cannot position MetaSWAP well appropriately for location'
         WRITE(*,'(A/)') 'icol='//TRIM(ITOS(JCOL))//' and irow='//TRIM(ITOS(JROW))
!         STOP
!        ENDIF
      END SELECT
     ENDDO
     
     !## found new modellayer 
     N=N+1; IF(N.EQ.1)THEN
      WRITE(*,'(/A)') 'Re-positioning of MetaSWAP Artificial Wells' 
      WRITE(*,'(5A10)') 'Number','Old Layer','New Layer','Column','Row'
     ENDIF
     WRITE(*,'(5I10)') N,LYBE,L,JCOL,JROW

     LYBE=L
     !## store corrected layers
     IF(PBMAN%IARMWP.EQ.0)THEN
      SIMGRO(ICOL,IROW)%BER_LAAG=LYBE
     ELSE
      IPFMSP(BEREGENID)%ILAY=LYBE
     ENDIF
     
    ENDIF
   ENDDO
  ENDDO
 ENDIF
  
 IF(PBMAN%IARMWP.EQ.0)THEN

  !## turn off beregening whenever layer is zero!
  DO IROW=1,PRJIDF%NROW
   DO ICOL=1,PRJIDF%NCOL
    !## maximal artificial recharge layer is PRJNLAY
    SIMGRO(ICOL,IROW)%BER_LAAG=MIN(SIMGRO(ICOL,IROW)%BER_LAAG,PRJNLAY)
    IF(SIMGRO(ICOL,IROW)%BEREGEN.NE.0.AND.SIMGRO(ICOL,IROW)%BER_LAAG.EQ.0)SIMGRO(ICOL,IROW)%BEREGEN=0
   ENDDO
  ENDDO

 ENDIF
 
 DEALLOCATE(IERROR)
 
 PMANAGER_SAVEMF2005_MSP_CHECK=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_MSP_CHECK
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_COMBINE(DIR,DIRNAME,PCK,CB,CAUX)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRNAME,CAUX
 INTEGER,INTENT(IN) :: CB
 CHARACTER(LEN=*),INTENT(IN),DIMENSION(:) :: PCK
 INTEGER,DIMENSION(4) :: IU
 INTEGER,DIMENSION(3) :: JU,NO,NO_PREV
 CHARACTER(LEN=256),DIMENSION(3) :: FNAME,FNAME_PREV
 CHARACTER(LEN=1) :: TXT
 INTEGER :: I,J,IPER,IROW,ICOL,ILAY,INEAREST,N,DRC,MSYS,ISYS,IOS
 REAL(KIND=DP_KIND) :: XC,YC,X1,X2,X3,X4
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_COMBINE=.FALSE.
 DRC=1
 
 IU=0

! IF(PBMAN%DMMFILE.EQ.1)THEN
!  IF(TRIM(PCK(2)).EQ.'RIV')THEN
!   NDFLOWFMRIV1=0; NDFLOWFMRIV2=0
!  ENDIF
!  IF(TRIM(PCK(2)).EQ.'DRN')NDFLOWFMDRN1=0
! ENDIF
 
 !## create coupling table
 IF(PBMAN%DMMFILE.EQ.1)THEN
  !## read existing dflowfm points
  CALL PMANAGER_SAVEMF2005_READ_DFFMPOINTS(DIR(:INDEX(DIR,'\',.TRUE.)-1))
  !## for river en drain
  IF(TRIM(PCK(2)).EQ.'RIV')LINE=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MFRIV2TODFM1D_Q.DMM'
  IF(TRIM(PCK(2)).EQ.'DRN')LINE=DIR(:INDEX(DIR,'\',.TRUE.)-1)//'\MFDRNTODFM1D_Q.DMM'
  IU(4)=UTL_GETUNIT(); CALL OSD_OPEN(IU(4),FILE=LINE,STATUS='UNKNOWN',ACTION='WRITE')
  WRITE(IU(4),'(3A15)') 'FM-X','FM-Y',TRIM(PCK(2))
 ENDIF
 
 !## read from files (if existing)
 DO I=1,SIZE(PCK)
  LINE=TRIM(DIRNAME)//'.'//TRIM(PCK(I))//'7'
  IF(I.LE.2)THEN
   INQUIRE(FILE=LINE,EXIST=LEX)
   IF(TRIM(PCK(2)).EQ.'DRN')THEN
    IF(I.EQ.1.AND.TOPICS(TOLF)%IACT_MODEL.EQ.0)LEX=.FALSE.
    IF(I.EQ.2.AND.TOPICS(TDRN)%IACT_MODEL.EQ.0)LEX=.FALSE.
   ELSE
    IF(I.EQ.1.AND.TOPICS(TISG)%IACT_MODEL.EQ.0)LEX=.FALSE.
    IF(I.EQ.2.AND.TOPICS(TRIV)%IACT_MODEL.EQ.0)LEX=.FALSE.
   ENDIF
   IF(LEX)THEN
    IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='OLD',ACTION='READ')
   ENDIF
  ELSE
   !## write to file
   IF(IU(1).GT.0)THEN
    IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='UNKNOWN',ACTION='WRITE')
   ENDIF
  ENDIF
 ENDDO

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

  FNAME=''

  !## reuse previous values
  DO I=1,2
   IF(NO(I).LT.0)THEN; NO(I)=NO_PREV(I); FNAME(I)=FNAME_PREV(I); ENDIF
  ENDDO
  
!  IF(PBMAN%DMMFILE.EQ.1)THEN
!   IF(TRIM(PCK(1)).EQ.'ISG')THEN
!    NDFLOWFMRIV1=MAX(NDFLOWFMRIV1,NO(1))
!    NDFLOWFMRIV2=MAX(NDFLOWFMRIV2,NO(2))
!   ELSE
!    NDFLOWFMDRN1=MAX(NDFLOWFMDRN1,SUM(NO))
!   ENDIF
!  ENDIF

  IF(IU(3).GT.0)THEN
   LINE=TRIM(ITOS(SUM(NO)))
   WRITE(IU(3),'(A)') TRIM(LINE)
  ENDIF
  
  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
  IF(IU(3).GT.0)THEN
   FNAME(3)=TRIM(DIR)//'\'//  TRIM(PCK(2))//'7\'//TRIM(PCK(2))//'_T'//TRIM(ITOS(IPER))//'_NEW.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; FNAME(3)=TRIM(FNAME(3))//'_'; ENDIF
   CALL UTL_CREATEDIR(FNAME(3)(:INDEX(FNAME(3),'\',.TRUE.)-1))
   CALL OSD_OPEN(JU(3),FILE=FNAME(3),STATUS='UNKNOWN',ACTION='WRITE')
  ENDIF
  
  !## copy ISG / SOF part
  IF(JU(1).GT.0)THEN
   DO I=1,NO(1)
    READ(JU(1),'(A256)') LINE
    IF(JU(3).GT.0)WRITE(JU(3),'(A)') TRIM(LINE)
    IF(TRIM(PCK(2)).EQ.'DRN')READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,ISYS
    IF(TRIM(PCK(2)).EQ.'RIV')THEN
     IF(PBMAN%INFFCT.EQ.1)THEN
      READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,X3,ISYS,TXT
     ELSE
      READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,X3,X4,ISYS
     ENDIF
    ENDIF
    IF(IOS.NE.0)THEN
     WRITE(*,'(/A)') 'ERROR READING LINE '//TRIM(ITOS(I))//' OUT OF '//TRIM(ITOS(NO(2)))
     WRITE(*,'(A)') 'FROM FILE '//TRIM(FNAME(1))     
     WRITE(*,'(A)') '>>> '//TRIM(LINE)//' <<<'
     STOP
    ENDIF    
    MSYS=MAX(MSYS,ISYS)
    IF(IPER.EQ.1.AND.PBMAN%DMMFILE.EQ.1.AND.TRIM(PCK(2)).EQ.'DRN')THEN
!     READ(LINE,*) ILAY,IROW,ICOL
     CALL IDFGETLOC(PRJIDF,IROW,ICOL,XC,YC)
     INEAREST=PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,.TRUE.,DRC)
     !## write nearest coupling location
     IF(INEAREST.NE.0)THEN
      WRITE(IU(4),'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,I; N=N+1
      WRITE(*,'(3I10)') I,NO(1),DRC
     ENDIF
    ENDIF
   ENDDO
   !## remove olf/isg stuff
   CLOSE(JU(1)) !,STATUS='DELETE')
  ENDIF

  !## copy RIV / DRN part
  IF(JU(2).GT.0)THEN
   DO I=1,NO(2)
    READ(JU(2),'(A256)') LINE
    IF(TRIM(PCK(2)).EQ.'DRN')READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,ISYS
    IF(TRIM(PCK(2)).EQ.'RIV')THEN
     IF(PBMAN%INFFCT.EQ.1)THEN
      READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,X3,ISYS,TXT
     ELSE
      READ(LINE,*,IOSTAT=IOS) ILAY,IROW,ICOL,X1,X2,X3,X4,ISYS
     ENDIF
    ENDIF
    IF(IOS.NE.0)THEN
     WRITE(*,'(/A)') 'ERROR READING LINE '//TRIM(ITOS(I))//' OUT OF '//TRIM(ITOS(NO(2)))
     WRITE(*,'(A)') 'FROM FILE '//TRIM(FNAME(2))
     WRITE(*,'(A)') '>>> '//TRIM(LINE)//' <<<'
     STOP
    ENDIF
    !## increase system numbers
    ISYS=ISYS+MSYS; IF(PBMAN%SSYSTEM.EQ.1)ISYS=1
    IF(JU(3).GT.0)THEN
     IF(TRIM(PCK(2)).EQ.'DRN')WRITE(JU(3),'(3(I5,1X),2(G15.7,1X),I5)') ILAY,IROW,ICOL,X1,X2,ISYS
     IF(TRIM(PCK(2)).EQ.'RIV')THEN
      IF(PBMAN%INFFCT.EQ.1)THEN
       WRITE(JU(3),'(3(I5,1X),3(G15.7,1X),I5,1X,A)') ILAY,IROW,ICOL,X1,X2,X3,ISYS,TXT
      ELSE
       WRITE(JU(3),'(3(I5,1X),4(G15.7,1X),I5)')      ILAY,IROW,ICOL,X1,X2,X3,X4,ISYS
      ENDIF
     ENDIF
    ENDIF
    IF(IPER.EQ.1.AND.PBMAN%DMMFILE.EQ.1)THEN
     CALL IDFGETLOC(PRJIDF,IROW,ICOL,XC,YC)
     INEAREST=PMANAGER_SAVEMF2005_DMM_GETXY(XC,YC,.TRUE.,DRC)
     !## write nearest coupling location
     IF(INEAREST.GT.0)THEN
      WRITE(IU(4),'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NO(1)+I; N=N+1
     ENDIF
    ENDIF
   ENDDO
   CLOSE(JU(2))
  ENDIF

  !## add iMOD header at the bottom
  IF(PBMAN%IFORMAT.EQ.2.AND.JU(3).GT.0)CALL IDFWRITEFREE_HEADER(JU(3),BND(1))

  IF(JU(3).GT.0)THEN
   CLOSE(JU(3))
  
   J=LEN_TRIM(FNAME(3))
   IF(FNAME(3)(J:J).EQ.'_')THEN
    FNAME(3)(J:J)=' '
    INQUIRE(FILE=FNAME(3),EXIST=LEX); IF(LEX)CALL IOSDELETEFILE(FNAME(3))
    CALL IOSRENAMEFILE(TRIM(FNAME(3))//'_',FNAME(3))
   ENDIF
  ENDIF

  IF(IU(3).GT.0)THEN
   LINE=FNAME(3); DO J=1,3; LINE=LINE(:INDEX(LINE,'\',.TRUE.)-1); ENDDO
   J=LEN_TRIM(LINE); LINE='.'//FNAME(3)(J+1:)

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

 ENDDO
 
 IF(IU(3).GT.0)THEN
  IF(IU(1).GT.0)CLOSE(IU(1))
  IF(IU(2).GT.0)CLOSE(IU(2))
  CLOSE(IU(3))
  !## rename file
  FNAME(1)=TRIM(DIRNAME)//'.'//TRIM(PCK(3))//'7'
  FNAME(2)=TRIM(DIRNAME)//'.'//TRIM(PCK(2))//'7'
  INQUIRE(FILE=FNAME(2),EXIST=LEX)
  IF(LEX)CALL IOSDELETEFILE(FNAME(2))
  CALL IOSRENAMEFILE(FNAME(1),FNAME(2))
 ELSE
  IF(IU(1).GT.0)CLOSE(IU(1))
  IF(IU(2).GT.0)CLOSE(IU(2))
 ENDIF
 IF(IU(4).GT.0)THEN
  IF(N.EQ.0)THEN; CLOSE(IU(4))
  ELSE; CLOSE(IU(4)); ENDIF
 ENDIF
 
 IF(PBMAN%DMMFILE.EQ.1)THEN
  CALL PMANAGER_SAVEMF2005_DEALL_DFFMGRID() 
  DEALLOCATE(DFFM)
 ENDIF
 PMANAGER_SAVEMF2005_COMBINE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_COMBINE

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SETICELLTYPE(DIR,DIRMNAME,M,PCK)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: M
 CHARACTER(LEN=*),INTENT(IN),DIMENSION(:) :: PCK
 INTEGER :: I,II,IU,JU,KU,IOS,ILAY,JLAY,IROW,ICOL,N1,N2
 REAL(KIND=DP_KIND) :: WP,COND,BH
 CHARACTER(LEN=256) :: FNAME,MDLNAME
 CHARACTER(LEN=12) :: TXT
 
 PMANAGER_SAVEMF2005_SETICELLTYPE=.TRUE.; IF(PBMAN%IFORMAT.NE.3)RETURN
 
 DO ILAY=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE
  IF(LAYCON(ILAY).NE.1)EXIT
 ENDDO
 IF(ILAY.GT.SIZE(PBMAN%ILAY))RETURN

 PMANAGER_SAVEMF2005_SETICELLTYPE=.FALSE.

 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  IF(PEST%PE_MXITER.LT.0)THEN
   N1=-1; N2=N1
  ELSE
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  ENDIF
 ELSEIF(PBMAN%IIES.EQ.1)THEN
  N1=1; N2=PEST%NREALS
 ENDIF

 MDLNAME=DIRMNAME(INDEX(DIRMNAME,'\',.TRUE.)+1:); MDLNAME=UTL_CAP(MDLNAME,'U')    

 !## read nam-file(s)
 DO II=N1,N2
  !## skip zero
  IF(II.EQ.0)CYCLE
  KU=UTL_GETUNIT()
  IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'.NAM'
  ELSEIF(PBMAN%IPESTP.EQ.1)THEN
   IF(II.GT.0)THEN
    IF(PEST%PARAM(II)%PACT.EQ.0.OR.PEST%PARAM(II)%PIGROUP.LT.0)CYCLE
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_P#'//TRIM(ITOS(II))//'.NAM'
   ELSE
    FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_L#'//TRIM(ITOS(ABS(II)))//'.NAM'
   ENDIF
  ELSEIF(PBMAN%IIES.EQ.1)THEN
   FNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\'//TRIM(MDLNAME)//'_R#'//TRIM(ITOS(ABS(II)))//'.NAM'
  ENDIF !## read from ARR-files if existing
  KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='FORMATTED'); IF(KU.EQ.0)RETURN

  !## read arr files with icell-types
  DO ILAY=1,PRJNLAY
   IF(LAYCON(ILAY).NE.1)THEN
    IF(.NOT.IPEST_GLM_READ_ARRFILE(TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\MODELINPUT\NPF6\ICELLTYPE_L'//TRIM(ITOS(ILAY))//'.ARR',BND(ILAY)%X))RETURN
   ENDIF
  ENDDO

  DO 
   READ(KU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
   !## next line
   DO I=1,SIZE(PCK); IF(INDEX(LINE,PCK(I)).GT.0)EXIT; ENDDO; IF(I.GT.SIZE(PCK))CYCLE
   READ(LINE,*) TXT,FNAME,TXT
   FNAME=TRIM(DIR)//FNAME(2:)
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ'); IF(IU.EQ.0)RETURN

   DO
    READ(IU,'(A)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    IF(INDEX(LINE,'OPEN/CLOSE').GT.0)THEN
     READ(LINE(INDEX(LINE,'OPEN/CLOSE')+LEN('OPEN/CLOSE')+1:),*) FNAME
     !## read arr file
     FNAME=TRIM(DIR)//FNAME(2:)
     JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='OLD',ACTION='READ'); IF(JU.EQ.0)RETURN
     DO 
      IF(PCK(I).EQ.'RIV6')THEN
       READ(JU,*,IOSTAT=IOS) ILAY,IROW,ICOL,WP,COND,BH
       IF(WP.LE.BH.OR.COND.LE.0.0D0)ILAY=0
      ELSEIF(PCK(I).EQ.'GHB6'.OR.PCK(I).EQ.'DRN6')THEN
       READ(JU,*,IOSTAT=IOS) ILAY,IROW,ICOL
      ENDIF
      IF(IOS.NE.0)EXIT; IF(ILAY.EQ.0)CYCLE
      JLAY=ILAY
!      DO JLAY=ILAY,PRJNLAY
!       !## set boundary condition to confined for all subsequent layers
      IF(LAYCON(JLAY).NE.1)BND(JLAY)%X(ICOL,IROW)=0.0D0
!      ENDDO
     ENDDO
     CLOSE(JU)
    ENDIF
   ENDDO
  
   CLOSE(IU)
  ENDDO
  CLOSE(KU)
 ENDDO
 
 DO ILAY=1,PRJNLAY
  IF(LAYCON(ILAY).NE.1)THEN
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\MODELINPUT\NPF6\ICELLTYPE_L'//TRIM(ITOS(ILAY))//'.ARR', &
      BND(ILAY),1,0,ILAY,-1))RETURN
  ENDIF
 ENDDO
 
 PMANAGER_SAVEMF2005_SETICELLTYPE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_SETICELLTYPE
 
 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM(PRJNLAY,ICOL,IROW,TOP,BOT,KD,TP,BT,KH,LKHV)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: PRJNLAY,ICOL,IROW
 TYPE(IDFOBJ),INTENT(IN),DIMENSION(PRJNLAY) :: TOP,BOT,KD
 REAL(KIND=DP_KIND),INTENT(OUT),DIMENSION(PRJNLAY) :: KH,TP,BT
 LOGICAL,INTENT(IN) :: LKHV
 INTEGER :: ILAY
  
 !## get filter fractions
 DO ILAY=1,PRJNLAY
  TP(ILAY)=TOP(ILAY)%X(ICOL,IROW)
  BT(ILAY)=BOT(ILAY)%X(ICOL,IROW)
  KH(ILAY)=KD (ILAY)%X(ICOL,IROW)
 ENDDO
 DO ILAY=1,PRJNLAY
  !## put in cells with thickness only, also include inactive cells as they could be formed for mf6
  IF(TP(ILAY)-BT(ILAY).GT.0.0D0)THEN
   KH(ILAY)=KH(ILAY)/(TP(ILAY)-BT(ILAY))
   !## uniform disctribution
   IF(.NOT.LKHV)KH(ILAY)=1.0D0
  ELSE
   KH(ILAY)=0.0D0
  ENDIF
 ENDDO

 END SUBROUTINE PMANAGER_SAVEMF2005_PCK_ULSTRD_PARAM
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_PCK_U2DREL(EXFNAME,IDF,IU,IFBND,IINT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFBND,IINT
 CHARACTER(LEN=*),INTENT(IN) :: EXFNAME
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 CHARACTER(LEN=256) :: SFNAME
 INTEGER,INTENT(IN) :: IU
 INTEGER :: JU,IROW,ICOL,I
 REAL(KIND=DP_KIND) :: MINV,MAXV
 
 PMANAGER_SAVEMF2005_PCK_U2DREL=.FALSE.
 
! hoezo wordt laag 1 als bnd gebruikt voor min/max?
 IF(.NOT.PMANAGER_SAVEMF2005_PCK_GETMINMAX(IDF%X,IDF%NCOL,IDF%NROW,BND(1)%X,MINV,MAXV,IFBND))RETURN
 
 !## constant value
 IF(MAXV.EQ.MINV)THEN

  IF(IINT.EQ.0)WRITE(IU,'(A)') 'CONSTANT '//TRIM(RTOS(MAXV,'E',7))
  IF(IINT.EQ.1)THEN
   LINE='CONSTANT '//TRIM(ITOS(INT(MAXV)))
   WRITE(IU,'(A)') TRIM(LINE)
  ENDIF

 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(LFREEFORMAT)THEN
   CALL IDFWRITEFREE(JU,IDF,IINT,'B','*') 
  ELSE
   IF(IINT.EQ.1)THEN
    DO IROW=1,IDF%NROW; WRITE(JU,*) (INT(IDF%X(ICOL,IROW)),ICOL=1,IDF%NCOL); ENDDO
   ELSE
    DO IROW=1,IDF%NROW; WRITE(JU,*)     (IDF%X(ICOL,IROW) ,ICOL=1,IDF%NCOL); ENDDO
   ENDIF
  ENDIF
  
  CLOSE(JU)

 ENDIF
 
 IF(IUEXAMINE.NE.0)THEN
  IROW=INT(PBMAN%EXAMINE(1)); ICOL=INT(PBMAN%EXAMINE(2))
  IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)THEN
   WRITE(IUEXAMINE,'(A20,A15  )') TRIM(EXFNAME(INDEX(EXFNAME,'\',.TRUE.)+1:)),'NodataValue'
  ELSE
   WRITE(IUEXAMINE,'(A20,F15.7)') TRIM(EXFNAME(INDEX(EXFNAME,'\',.TRUE.)+1:)),IDF%X(ICOL,IROW)
  ENDIF
 ENDIF
 
 PMANAGER_SAVEMF2005_PCK_U2DREL=.TRUE.
   
 END FUNCTION PMANAGER_SAVEMF2005_PCK_U2DREL
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_HFB_COMPUTE(IDF,ITOPIC,IU,BND,TOP,BOT,IPRT,IBATCH,IPER)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITOPIC,IU,IPRT,IBATCH,IPER
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 TYPE(IDFOBJ),DIMENSION(PRJNLAY),INTENT(INOUT) :: TOP,BOT,BND
 REAL(KIND=DP_KIND) :: FCT,IMP,CNST
 INTEGER :: ILAY,ISYS,ICNST
 INTEGER(KIND=1),ALLOCATABLE,DIMENSION(:,:,:) :: IPC
 TYPE(IDFOBJ) :: TIDF,BIDF
 
 PMANAGER_SAVEMF2005_HFB_COMPUTE=.FALSE.
 
 CALL ASC2IDF_INT_NULLIFY(); ALLOCATE(XP(100),YP(100),ZP(100),FP(100),PP(100),WP(100))
 
 !## compute block-faces
 ALLOCATE(IPC(IDF%NCOL,IDF%NROW,2))
 CALL IDFNULLIFY(TIDF); CALL IDFNULLIFY(BIDF)
 CALL IDFCOPY(IDF,TIDF); CALL IDFCOPY(IDF,BIDF) 

 WRITE(IU,'(5A10,2A15,A10,4A15)') 'ILAY','IROW1','ICOL1','IROW2','ICOL2','RESISTANCE','FRACTION','SYSTEM', &
      'TOP_LAYER','BOT_LAYER','TOP_FAULT','BOT_FAULT'

 !## process per system
 DO ISYS=1,SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2)
   
  IPC=INT(0,1)
   
  ICNST    =TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%ICNST
  CNST     =TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%CNST
  ILAY     =TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%ILAY
  FCT      =TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%FCT
  IMP      =TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%IMP
  IDF%FNAME=TOPICS(ITOPIC)%STRESS(IPER)%FILES(1,ISYS)%FNAME

  IF(ICNST.EQ.1)THEN
   IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'HFB cannot be parameterized via a constant value.','Error')
   WRITE(*,'(A)') 'HFB cannot be parameterized via a constant value.'
   RETURN
  ENDIF
  
  WRITE(IPRT,'(1X,A,I3,A1,I1,A1,I4.3,3(A1,G15.7),A1,A)') TOPICS(ITOPIC)%TNAME(1:5)//',', &
     ISYS,',',ICNST,',',ILAY,',',FCT,',',IMP,',',CNST,',',CHAR(39)//TRIM(IDF%FNAME)//CHAR(39)

  IF(LEN_TRIM(PRJIDF%FNAME).GT.0)THEN
   !## rasterize genfile
   CALL ASC2IDF_HFB(IDF,IDF%NROW,IDF%NCOL,IPC,(/IDF%FNAME/),ILAY,TIDF,BIDF)
   !## collect all fault in a single file with resistances and layer fractions
   CALL PMANAGER_SAVEMF2005_HFB_COLLECT(IPC,IDF%NROW,IDF%NCOL,FCT*IMP,IU,BND,TOP,BOT,ILAY,TIDF,BIDF,ISYS)
  ENDIF
   
 ENDDO

 CALL ASC2IDF_INT_DEALLOCATE(); CLOSE(IU)
 DEALLOCATE(IPC); CALL IDFDEALLOCATEX(TIDF); CALL IDFDEALLOCATEX(BIDF) 

 IF(ISYS.GT.SIZE(TOPICS(ITOPIC)%STRESS(IPER)%FILES,2))PMANAGER_SAVEMF2005_HFB_COMPUTE=.TRUE.
  
 END FUNCTION PMANAGER_SAVEMF2005_HFB_COMPUTE
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_HFB_COLLECT(IPC,NROW,NCOL,HFBRESIS, &
               IU,BND,TOP,BOT,ITB,TIDF,BIDF,ISYS) 
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NROW,NCOL,IU,ITB,ISYS
 TYPE(IDFOBJ),INTENT(INOUT) :: TIDF,BIDF
 TYPE(IDFOBJ),DIMENSION(PRJNLAY),INTENT(INOUT) :: TOP,BOT,BND
 REAL(KIND=DP_KIND),INTENT(IN) :: HFBRESIS
 INTEGER(KIND=1),INTENT(IN),DIMENSION(NCOL,NROW,2) :: IPC
 INTEGER :: IROW,ICOL,IL1,IL2,ILAY 
 REAL(KIND=DP_KIND) :: NODATA,FDZ,TPV,BTV,TFV,BFV
 
 NODATA=HUGE(1.0D0)
 
 !## determine what layer(s)
 IF(ITB.EQ.0)THEN
  IL1=1; IL2=PRJNLAY
 ELSE
  IL1=ITB; IL2=IL1
 ENDIF

 DO IROW=1,NROW; DO ICOL=1,NCOL; DO ILAY=IL1,IL2

  !## place vertical wall
  IF(IPC(ICOL,IROW,1).EQ.INT(1,1))THEN
   IF(ICOL.LT.NCOL)THEN
 
    !## fraction is minus 1 for given layers
    FDZ=-1.0D0
    IF(ITB.EQ.0)FDZ=PMANAGER_SAVEMF2005_HFB_GETFDZ(BND,TOP,BOT,TIDF%X,BIDF%X,ICOL,IROW,ICOL+1,IROW,NODATA,ILAY,TFV,BFV)

    !## enter fault if occupation > 0.0D0%
    IF(ITB.EQ.0.AND.FDZ.LE.0.0D0)CYCLE
    
    IF(ITB.NE.0)THEN
     TPV=0.0D0
     BTV=0.0D0
     TFV=0.0D0
     BFV=0.0D0
    ELSE
     TPV=(TOP(ILAY)%X(ICOL,IROW)+TOP(ILAY)%X(ICOL+1,IROW))/2.0D0
     BTV=(BOT(ILAY)%X(ICOL,IROW)+BOT(ILAY)%X(ICOL+1,IROW))/2.0D0 
    ENDIF
 
    !## write fault always, as it becomes confused 
    WRITE(IU,'(5I10,2G15.7,I10,4G15.7)') ILAY,IROW,ICOL,IROW,ICOL+1,HFBRESIS,FDZ,ISYS,TPV,BTV,TFV,BFV !## x-direction
    
   ENDIF
  ENDIF

  !## place horizontal wall
  IF(IPC(ICOL,IROW,2).EQ.INT(1,1))THEN
   IF(IROW.LT.NROW)THEN
   
    !## fraction is minus 1 for given layers
    FDZ=-1.0D0
    IF(ITB.EQ.0)FDZ=PMANAGER_SAVEMF2005_HFB_GETFDZ(BND,TOP,BOT,TIDF%X,BIDF%X,ICOL,IROW,ICOL,IROW+1,NODATA,ILAY,TFV,BFV)

    !## enter fault if occupation > 0.0D0%
    IF(ITB.EQ.0.AND.FDZ.LE.0.0D0)CYCLE

    IF(ITB.NE.0)THEN
     TPV=0.0D0
     BTV=0.0D0
     TFV=0.0D0
     BFV=0.0D0
    ELSE
     TPV=(TOP(ILAY)%X(ICOL,IROW)+TOP(ILAY)%X(ICOL,IROW+1))/2.0D0
     BTV=(BOT(ILAY)%X(ICOL,IROW)+BOT(ILAY)%X(ICOL,IROW+1))/2.0D0
    ENDIF

    !## write fault always, as it becomes confused 
    WRITE(IU,'(5I10,2G15.7,I10,4G15.7)') ILAY,IROW,ICOL,IROW+1,ICOL,HFBRESIS,FDZ,ISYS,TPV,BTV,TFV,BFV !## y-direction

   ENDIF
  ENDIF
 
 ENDDO; ENDDO; ENDDO

 END SUBROUTINE PMANAGER_SAVEMF2005_HFB_COLLECT
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_HFB_EXPORT(NHFBNP,IU,JU,IUGEN,IUDAT,IDF,LTB)
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: THICKNESS=0.5D0
 LOGICAL,INTENT(IN) :: LTB
 INTEGER,INTENT(IN) :: IU,JU
 INTEGER,INTENT(IN),DIMENSION(:) :: IUGEN,IUDAT
 INTEGER,INTENT(INOUT),DIMENSION(:) :: NHFBNP
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 INTEGER :: IROW,ICOL,ILAY,IOS,JLAY,IC1,IC2,IR1,IR2,ISYS,NC,NR,KLAY
 REAL(KIND=DP_KIND) :: C,C1,C2,Z,ZZ,TPV,BTV,TFV,BFV,F
 INTEGER(KIND=1),ALLOCATABLE,DIMENSION(:,:,:) :: IPC
 INTEGER(KIND=1),ALLOCATABLE,DIMENSION(:,:) :: SYS
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: RES,FDZ,TF,BF
 LOGICAL :: LINV
 
 !## compute block-faces
 ALLOCATE(IPC(IDF%NCOL,IDF%NROW,2))
 ALLOCATE(RES(IDF%NCOL,IDF%NROW))
 ALLOCATE(FDZ(IDF%NCOL,IDF%NROW))
 ALLOCATE(SYS(IDF%NCOL,IDF%NROW))
 ALLOCATE(TF(IDF%NCOL,IDF%NROW))
 ALLOCATE(BF(IDF%NCOL,IDF%NROW))
 
 !## process each layer
 JLAY=0; DO ILAY=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(ILAY).EQ.0)CYCLE; JLAY=JLAY+1
  
  NC=BND(ILAY)%NCOL
  NR=BND(ILAY)%NROW
  
  IPC=INT(0,1)
  RES=0.0D0
  FDZ=0.0D0
  SYS=INT(0,1)
  TF=-10.0D10
  BF= 10.0D10
  LINV=.FALSE.
  
  READ(JU,*)
  DO
   !## z=fraction (-1=confined system; used as conductance), c=resistance
   READ(JU,'(5I10,2G15.7,I10,4G15.7)',IOSTAT=IOS) KLAY,IR1,IC1,IR2,IC2,C,Z,ISYS,TPV,BTV,TFV,BFV

   IF(IOS.NE.0)EXIT
   IF(KLAY.NE.ILAY)CYCLE

   !## skip c.lt.zero
   IF(C.LT.0.0D0)CYCLE
   IF(IC1.EQ.IC2)THEN
    IPC(IC1,IR1,2)=INT(1,1)
   ELSE
    IPC(IC1,IR1,1)=INT(1,1)
   ENDIF
   IF(Z.GT.0.0D0)LINV=.TRUE.
   
   !## still some space left in modellayer for an additional fault
   IF(Z.LT.0.0D0.OR.FDZ(IC1,IR1).LT.1.0D0)THEN
    !## available space
    ZZ=1.0D0-FDZ(IC1,IR1)
    !## net available space
    ZZ=MIN(ZZ,Z)
    !## confined system
    IF(Z.LT.0.0D0)ZZ=1.0D0
    !## take system number of largest contribution to c
    IF(RES(IC1,IR1).GT.0.0D0)THEN
     IF(Z.GT.0.0D0)THEN
      !## currently available resistance
      C2=1.0D0/RES(IC1,IR1)*FDZ(IC1,IR1)
      IF(C.GT.C2)SYS(IC1,IR1)=INT(ISYS,1)
     ELSE
      IF(C.GT.RES(IC1,IR1))SYS(IC1,IR1)=INT(ISYS,1)
     ENDIF
    ELSE
     SYS(IC1,IR1)=INT(ISYS,1)
    ENDIF
    !## resistance, sum conductances - ignore resistance of zero days
    IF(Z.GT.0.0D0)THEN
     !## add small fault using arithmetic mean
     IF(TPV-BTV.LE.THICKNESS)THEN
      C1=0.0D0; IF(RES(IC1,IR1).GT.0.0D0)C1=1.0D0/RES(IC1,IR1)*FDZ(IC1,IR2)
      C2=C*ZZ
      !## set conductance
      RES(IC1,IR1)=1.0D0/((C1+C2)/(ZZ+FDZ(IC1,IR2)))
     !## add large fault using harmonic mean
     ELSE
      !## set conductance
      RES(IC1,IR1)=RES(IC1,IR1)+(1.0D0/C)*ZZ
     ENDIF
    ELSE
     !## get largest resistance
     RES(IC1,IR1)=MAX(RES(IC1,IR1),C)
    ENDIF
    !## occupation fraction
    FDZ(IC1,IR1)=MIN(1.0D0,FDZ(IC1,IR1)+ABS(Z))
    
    !## maximum top fault for display
    TF(IC1,IR1)=MAX(TF(IC1,IR1),TF(IC2,IR2),TFV)
    !## minimum bot fault for display
    BF(IC1,IR1)=MIN(BF(IC1,IR1),BF(IC2,IR2),BFV)
    
   ENDIF
   
  ENDDO
  
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL

   !## place vertical wall (block in y-direction)
   IF(IPC(ICOL,IROW,1).EQ.INT(1,1))THEN
    IF(ICOL.LT.IDF%NCOL)THEN

     !## skip faults from and to inactive cell
     IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0.AND. &
        BND(ILAY)%X(ICOL+1,IROW).EQ.0.0D0)CYCLE
    
     !## transform conductances to resistance - take into account the occupation fraction
     IF(LINV)THEN
      C1=1.0D0/RES(ICOL,IROW)*FDZ(ICOL,IROW)
     ELSE
      C1=RES(ICOL,IROW)
     ENDIF

     !## get total resistance related to thickness of model layer
     IF(FDZ(ICOL,IROW).LT.1.0D0)THEN
      !## take harmonic mean in case of unsaturated thickness of fault 
      C2=1.0D0/((1.0D0/C1*FDZ(ICOL,IROW))+(1.0D0-FDZ(ICOL,IROW)))
     ELSE
      C2=C1
     ENDIF

     !## get systemnumber
     ISYS=SYS(ICOL,IROW)
     !## top fault for display purposes
     TFV=TF(ICOL,IROW)
     !## bottom fault for display purposes
     BFV=BF(ICOL,IROW)
          
     !## modflow2005
     IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN

      IF(BND(ILAY)%X(ICOL,IROW).NE.0.0D0.AND. &
         BND(ILAY)%X(ICOL+1,IROW).NE.0.0D0)THEN
       !## add fault
       NHFBNP(ILAY)=NHFBNP(ILAY)+1
       WRITE(IU,'(5(I10,1X),G15.7,1X,I10)') JLAY,IROW,ICOL,     IROW,ICOL+1,      C2,ISYS !## y-direction
      ENDIF
      
     !## modflow6
     ELSE

      IF(BND(ILAY)%X(ICOL  ,IROW).NE.0.0D0.AND. &
         BND(ILAY)%X(ICOL+1,IROW).NE.0.0D0)THEN
 
       !## add fault
       NHFBNP(ILAY)=NHFBNP(ILAY)+1

       !## get hydrch as 1/d
       IF(C2.NE.0.0D0)C2=1.0D0/C2
       F=MAX(0.0D0,C2)
       
       WRITE(IU,'(6(I10,1X),G15.7,1X,I10)') JLAY,IROW,ICOL,JLAY,IROW,ICOL+1,F,ISYS !## y-direction
      
      ENDIF
      
     ENDIF
     
     !## write line in genfile
     CALL PMANAGER_SAVEMF2005_HFB_GENFILES(IUGEN(ILAY),IUDAT(ILAY),IPC,IDF,IDF%NROW,IDF%NCOL,IROW,ICOL, &
               NHFBNP(ILAY),C1,C2,FDZ(ICOL,IROW),ISYS,1,LTB,TFV,BFV,BND(ILAY)) 

    ENDIF 
   ENDIF

   !## place horizontal wall (block in x-direction)
   IF(IPC(ICOL,IROW,2).EQ.INT(1,1))THEN
    IF(IROW.LT.IDF%NROW)THEN

     !## skip faults from and/or towards inactive cell
     IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0.AND. &
        BND(ILAY)%X(ICOL,IROW+1).EQ.0.0D0)CYCLE

     !## transform conductances to resistance
     IF(LINV)THEN
      C1=1.0D0/RES(ICOL,IROW)*FDZ(ICOL,IROW)
     ELSE
      C1=RES(ICOL,IROW)
     ENDIF

     !## get total resistance related to thickness of model layer
     IF(FDZ(ICOL,IROW).LT.1.0D0)THEN
      !## take harmonic mean in case of unsaturated thickness of fault 
      C2=1.0D0/((1.0D0/C1*FDZ(ICOL,IROW))+(1.0D0-FDZ(ICOL,IROW)))
     ELSE
      C2=C1
     ENDIF
           
     !## get systemnumber
     ISYS=SYS(ICOL,IROW)

     !## top fault for display purposes
     TFV=TF(ICOL,IROW)
     !## bottom fault for display purposes
     BFV=BF(ICOL,IROW)
     
     !## modflow2005
     IF(PBMAN%IFORMAT.EQ.2.OR.PBMAN%IFORMAT.EQ.6)THEN

      IF(BND(ILAY)%X(ICOL,IROW).NE.0.0D0.AND. &
         BND(ILAY)%X(ICOL,IROW+1).NE.0.0D0)THEN
       !## add fault
       NHFBNP(ILAY)=NHFBNP(ILAY)+1
       WRITE(IU,'(5(I10,1X),G15.7,1X,I10)') JLAY,IROW,ICOL,     IROW+1,ICOL,      C2,ISYS !## x-direction
      ENDIF
      
     !## modflow6
     ELSE

      IF(BND(ILAY)%X(ICOL,IROW)  .NE.0.0D0.AND. &
         BND(ILAY)%X(ICOL,IROW+1).NE.0.0D0)THEN
         
       !## add fault
       NHFBNP(ILAY)=NHFBNP(ILAY)+1

       IF(C2.NE.0.0D0)C2=1.0D0/C2
       F=MAX(0.0D0,C2)
       WRITE(IU,'(6(I10,1X),G15.7,1X,I10)') JLAY,IROW,ICOL,JLAY,IROW+1,ICOL,F,ISYS !## x-direction

      ENDIF
     ENDIF
     
     !## write line in genfile
     CALL PMANAGER_SAVEMF2005_HFB_GENFILES(IUGEN(ILAY),IUDAT(ILAY),IPC,IDF,IDF%NROW,IDF%NCOL,IROW,ICOL, &
               NHFBNP(ILAY),C1,C2,FDZ(ICOL,IROW),ISYS,2,LTB,TFV,BFV,BND(ILAY)) 

    ENDIF
   ENDIF
 
  ENDDO; ENDDO
  WRITE(IUGEN(ILAY),'(A)') 'END'
  REWIND(JU)
 ENDDO
 
 DEALLOCATE(IPC,RES,FDZ,SYS,TF,BF)
 
 END SUBROUTINE PMANAGER_SAVEMF2005_HFB_EXPORT
 
 !###====================================================================
 REAL(KIND=DP_KIND) FUNCTION PMANAGER_SAVEMF2005_HFB_GETFDZ(BND,TOP,BOT,TF,BF,IC1,IR1,IC2,IR2,NODATA,ILAY,TFV,BFV)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),DIMENSION(PRJNLAY),INTENT(INOUT) :: TOP,BOT,BND
 REAL(KIND=DP_KIND),INTENT(IN) :: NODATA
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(:,:) :: TF,BF
 REAL(KIND=DP_KIND),INTENT(OUT) :: TFV,BFV
 INTEGER,INTENT(IN) :: IC1,IR1,IC2,IR2,ILAY
 REAL(KIND=DP_KIND) :: TPV,BTV,FDZ 

 PMANAGER_SAVEMF2005_HFB_GETFDZ=0.0D0

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

 !## skip this fault as it enteres nodata
 IF(BND(ILAY)%X(IC1,IR1).EQ.0.OR.BND(ILAY)%X(IC2,IR2).EQ.0)RETURN

 IF(TOP(ILAY)%X(IC1,IR1).NE.TOP(ILAY)%NODATA.AND. &
    TOP(ILAY)%X(IC2,IR2).NE.TOP(ILAY)%NODATA)THEN
  TPV=(TOP(ILAY)%X(IC1,IR1)+TOP(ILAY)%X(IC2,IR2))/2.0D0
 ELSE
  TPV=-999.99D0
 ENDIF
 IF(BOT(ILAY)%X(IC1,IR1).NE.BOT(ILAY)%NODATA.AND. &
    BOT(ILAY)%X(IC1,IR1).NE.BOT(ILAY)%NODATA)THEN
  BTV=(BOT(ILAY)%X(IC1,IR1)+BOT(ILAY)%X(IC2,IR2))/2.0D0
 ELSE
  BTV=-999.99D0
 ENDIF
 
 !## nett appearance of fault in modellayer
 FDZ=MIN(TFV,TPV)-MAX(BFV,BTV)

 !## not in current modellayer
 IF(FDZ.LT.0.0D0)RETURN

 IF(TPV-BTV.GT.0.0D0)THEN
  !## fraction of fault in modellayer
  FDZ=FDZ/(TPV-BTV)
 ELSE
  !## completely filled in model layer with thickness of zero
  FDZ=1.0D0
 ENDIF

 !## fraction of layer occupation
 PMANAGER_SAVEMF2005_HFB_GETFDZ=FDZ

 END FUNCTION PMANAGER_SAVEMF2005_HFB_GETFDZ
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_HFB_GENFILES(IU,JU,IPC,IDF,NROW,NCOL,IROW,ICOL,N, &
                  C,RES,FDZ,ISYS,IT,LTB,TFV,BFV,BND)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(IN) :: IDF,BND
 REAL(KIND=DP_KIND),INTENT(IN) :: C,RES,FDZ,TFV,BFV
 LOGICAL,INTENT(IN) :: LTB
 INTEGER,INTENT(IN) :: NROW,NCOL,IROW,ICOL,IU,JU,N,ISYS,IT
 INTEGER(KIND=1),INTENT(IN),DIMENSION(NCOL,NROW,2) :: IPC 
 INTEGER :: IBND
 REAL(KIND=DP_KIND) :: T1,B1

 !## place vertical wall
 IF(IT.EQ.1)THEN
  IF(IPC(ICOL,IROW,1).EQ.INT(1,1).AND.ICOL.LT.NCOL)THEN
   IF(JU.GT.0)THEN
    IBND=0; IF(BND%X(ICOL,IROW).EQ.0.OR.BND%X(ICOL+1,IROW).EQ.0)IBND=1
    IF(LTB)THEN
     !## write location of fault for m6f and submodel
     IF(TFV.GE.BFV)WRITE(JU,'(I10,3(1X,E15.7),6I10)') N,C,RES,FDZ,ISYS,ICOL,IROW,ICOL+1,IROW,IBND
    ELSE
     !## write location of fault for m6f and submodel
     WRITE(JU,'(I10,1X  ,E15.7 ,6I10)') N,C,ISYS,ICOL,IROW,ICOL+1,IROW,IBND
    ENDIF
   ENDIF
   IF(ICOL.LT.PRJIDF%NCOL)THEN
    IF(LTB)THEN
     IF(TFV.GE.BFV)THEN
      T1=TFV; B1=BFV
      WRITE(IU,'(I10)') N 
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW-1),',',T1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW)  ,',',T1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW)  ,',',B1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW-1),',',B1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW-1),',',T1
      WRITE(IU,'(A)') 'END'
     ENDIF
    ELSE
     WRITE(IU,'(I10)') N 
     WRITE(IU,'(2(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW-1)
     WRITE(IU,'(2(F15.3,A1))') IDF%SX(ICOL),',',IDF%SY(IROW)
     WRITE(IU,'(A)') 'END'
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 
 !## place horizontal wall
 IF(IT.EQ.2)THEN
  IF(IPC(ICOL,IROW,2).EQ.INT(1,1).AND.IROW.LT.NROW)THEN
   IF(JU.GT.0)THEN
    IBND=0; IF(BND%X(ICOL,IROW).EQ.0.OR.BND%X(ICOL,IROW+1).EQ.0)IBND=1
    IF(LTB)THEN
     !## write location of fault for m6f and submodel
     IF(TFV.GE.BFV)WRITE(JU,'(I10,3(1X,E15.7),6I10)') N,C,RES,FDZ,ISYS,ICOL,IROW,ICOL,IROW+1,IBND
    ELSE
     !## write location of fault for m6f and submodel
     WRITE(JU,'(I10,1X  ,E15.7 ,6I10)') N,C,ISYS,ICOL,IROW,ICOL,IROW+1,IBND
    ENDIF
   ENDIF
   IF(IROW.LT.PRJIDF%NROW)THEN
    IF(LTB)THEN
     IF(TFV.GE.BFV)THEN
      T1=TFV; B1=BFV
      WRITE(IU,'(I10)') N  
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL-1),',',IDF%SY(IROW),',',T1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL  ),',',IDF%SY(IROW),',',T1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL  ),',',IDF%SY(IROW),',',B1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL-1),',',IDF%SY(IROW),',',B1
      WRITE(IU,'(3(F15.3,A1))') IDF%SX(ICOL-1),',',IDF%SY(IROW),',',T1
      WRITE(IU,'(A)') 'END'
     ENDIF
    ELSE
     WRITE(IU,'(I10)') N  
     WRITE(IU,'(2(F15.3,A1))') IDF%SX(ICOL-1),',',IDF%SY(IROW)
     WRITE(IU,'(2(F15.3,A1))') IDF%SX(ICOL  ),',',IDF%SY(IROW)
     WRITE(IU,'(A)') 'END'
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 
 END SUBROUTINE PMANAGER_SAVEMF2005_HFB_GENFILES
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LAK_CONFIG()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IROW,ICOL,ILAY,I,JROW,JCOL
 REAL(KIND=DP_KIND) :: C,ZT,ZB,X1,X2,Y1,Y2,L,TIB,F,KD1,KD2,OT1,OT2
 INTEGER,DIMENSION(4) :: IR,IC
 DATA IR/-1, 0,0,1/
 DATA IC/ 0,-1,1,0/
 
 PMANAGER_SAVEMF2005_LAK_CONFIG=.TRUE.
 
 IF(TOPICS(TLAK)%IACT_MODEL.EQ.0)RETURN

 PMANAGER_SAVEMF2005_LAK_CONFIG=.FALSE.
 
 !## lake numbers are integer values only
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  LAK(1)%X(ICOL,IROW)=INT(LAK(1)%X(ICOL,IROW))
 ENDDO; ENDDO
 
 !## get unique number of lakes
 ALLOCATE(DULAKES(PRJIDF%NCOL*PRJIDF%NROW))
 I=0; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; I=I+1; DULAKES(I)=INT(LAK(1)%X(ICOL,IROW)); ENDDO; ENDDO
 CALL UTL_GETUNIQUE_INT(DULAKES,PRJIDF%NROW*PRJIDF%NCOL,NLAKES,0)

 ALLOCATE(ULAKES(NLAKES)); DO I=1,NLAKES; ULAKES(I)=DULAKES(I); ENDDO; DEALLOCATE(DULAKES)

 !## reset array lbd - boundary settings, layer becomes lakes as bathymetry of over half of cell
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; LBD(ILAY)%X(ICOL,IROW)=0.0D0; ENDDO; ENDDO; ENDDO
 !## reset array lcd - sum of conductance vertically/horizontally
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL; LCD(ILAY)%X(ICOL,IROW)=0.0D0; ENDDO; ENDDO; ENDDO

 !## get lakebed leakance - combination of resistance and model resistance of depth AROUND lake
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  !## skip non lake cells
  IF(LAK(1)%X(ICOL,IROW).LE.0)CYCLE
  !## find appropriate modellayer underneath bathymetry of lake
  DO ILAY=1,PRJNLAY

   !## apply lakes only for active cells (>0)
   IF(BND(ILAY)%X(ICOL,IROW).LE.0)CYCLE

   ZT=TOP(ILAY)%X(ICOL,IROW)
   !## found appropriate modellayer
   IF(ZT.GT.LAK(2)%X(ICOL,IROW))THEN

    !## cannot have a lake in the lowest model layer
    IF(ILAY.EQ.PRJNLAY)THEN
!     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You cannot put a lake in the lowest model layer'//CHAR(13)// &
!         'Make sure the bathymetry is always higher than the top of'//CHAR(13)// &
!         'your lowest model layer in order to avoid this error message.','Error')
!     RETURN
    ENDIF

    !## lake number is equal to internal number in the sort-list
    DO I=1,NLAKES
     IF(INT(LAK(1)%X(ICOL,IROW)).EQ.ULAKES(I))THEN; LBD(ILAY)%X(ICOL,IROW)=I; EXIT; ENDIF 
    ENDDO
    
    BND(ILAY)%X(ICOL,IROW)=0.0D0

    !## modify existing aquitard due to this displacement - can be removed partly by lake
    IF(ILAY.LT.PRJNLAY)THEN
     !## bottom of current model layer
     ZB=TOP(ILAY+1)%X(ICOL,IROW) 
    ELSE
     ZB=BOT(ILAY)%X(ICOL,IROW) 
    ENDIF
    !## thickness original interbed
    TIB=BOT(ILAY)%X(ICOL,IROW)-ZB

!top =10
!lak = 4
!bot = 2
!zb  = 0
!tib = 2

    !## compute fraction for leakance in case lake bathymetry is higher
    IF(ZB.LT.LAK(2)%X(ICOL,IROW))THEN
     !## add extra resistance to leakance of part of aquifer
     IF(BOT(ILAY)%X(ICOL,IROW).LT.LAK(2)%X(ICOL,IROW))THEN
      C=(LAK(2)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW))/(KHV(ILAY)%X(ICOL,IROW)/KVA(ILAY)%X(ICOL,IROW))
     ENDIF

     OT1=0.0D0; OT2=0.0D0
     IF(ILAY.LT.PRJNLAY)THEN
      OT1=BOT(ILAY  )%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW)
      OT2=TOP(ILAY+1)%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW)
     ENDIF
     
     !## adjust bot as the LAK package uses this to create the table input
     BOT(ILAY)%X(ICOL,IROW)=LAK(2)%X(ICOL,IROW)

     !## make sure thickness of interbed remains the same
     IF(TIB.EQ.0.0D0)THEN

      !## increase permeability in ratio in case no interbed and interface is shifted upwards
      IF(ILAY.LT.PRJNLAY)THEN
       TOP(ILAY+1)%X(ICOL,IROW)=BOT(ILAY)%X(ICOL,IROW)

       KD1=KHV(ILAY  )%X(ICOL,IROW)*OT1 
       KD2=KHV(ILAY+1)%X(ICOL,IROW)*OT2 
       KD1=KD1+KD2; KD2=KD1/OT2 
       KHV(ILAY+1)%X(ICOL,IROW)=KHV(ILAY+1)%X(ICOL,IROW)*KD2
      ENDIF

     ELSE
      !## top remains the same but thickness can be enlarged of the interbed, correct with permeability
      F=(BOT(ILAY)%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW))/TIB
      KVV(ILAY)%X(ICOL,IROW)=KVV(ILAY)%X(ICOL,IROW)*F
     ENDIF
    ELSE
     C=0.0D0
    ENDIF
    
    !## lake leakance for vertical conductances - excl. the effect of vertical shift, this is taken care of by MF2005
    LCD(ILAY)%X(ICOL,IROW)=1.0D0/LAK(6)%X(ICOL,IROW) 

   ENDIF
  ENDDO
 ENDDO; ENDDO
 
 !## get lakebed lateral leakances
 DO ILAY=1,PRJNLAY; DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  !## found lake cell
  IF(LBD(ILAY)%X(ICOL,IROW).NE.0)THEN

   !## compute lateral leakances
   DO I=1,SIZE(IC)
    JROW=IR(I)+IROW; JCOL=IC(I)+ICOL
    IF(JROW.GT.PRJIDF%NROW.OR.JROW.LT.1)CYCLE
    IF(JCOL.GT.PRJIDF%NCOL.OR.JCOL.LT.1)CYCLE
    !## not equal a lake, thus next to the lake and not inactive cell
    IF(LBD(ILAY)%X(JCOL,JROW).EQ.0.AND. &
       BND(ILAY)%X(JCOL,JROW).NE.0)THEN
     CALL IDFGETEDGE(PRJIDF,JROW,JCOL,X1,Y1,X2,Y2)
     IF(JROW.EQ.IROW)THEN; L=X2-X1 ; ENDIF
     IF(JCOL.EQ.ICOL)THEN; L=Y2-Y1 ; ENDIF
     !## resistance along lake
     C=L/KHV(ILAY)%X(ICOL,IROW)

     !## lake leakance for vertical conductances - excl. the effect of vertical shift, this is taken care of by MF2005
     LCD(ILAY)%X(JCOL,JROW)=1.0D0/LAK(6)%X(ICOL,IROW)

    ENDIF
   ENDDO
 
  ENDIF
 ENDDO; ENDDO; ENDDO

 PMANAGER_SAVEMF2005_LAK_CONFIG=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_LAK_CONFIG

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE(X,Y,ULAKE,LVL,IBATCH,IOP)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:,:),INTENT(IN) :: X,Y
 INTEGER,INTENT(IN) :: ULAKE
 INTEGER,INTENT(IN) :: IBATCH,IOP
 REAL(KIND=DP_KIND),INTENT(OUT) :: LVL
 REAL(KIND=DP_KIND) :: ILVL
 INTEGER :: IROW,ICOL
 
 PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE=.FALSE.
 
 LVL=0.0D0; ILVL=0.0D0

 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(INT(X(ICOL,IROW)).EQ.ULAKE)THEN
   SELECT CASE (IOP)
    !## average/sum
    CASE (1,4); LVL=LVL+Y(ICOL,IROW); ILVL=ILVL+1.0D0
    !## min
    CASE (2); IF(ILVL.EQ.0)THEN; LVL=Y(ICOL,IROW); ELSE; LVL=MIN(LVL,Y(ICOL,IROW)); ENDIF; ILVL=ILVL+1.0D0
    !## max
    CASE (3); IF(ILVL.EQ.0)THEN; LVL=Y(ICOL,IROW); ELSE; LVL=MAX(LVL,Y(ICOL,IROW)); ENDIF; ILVL=ILVL+1.0D0
   END SELECT
  ENDIF
 ENDDO; ENDDO

 IF(ILVL.LE.0.0D0)THEN
  IF(IBATCH.EQ.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot assign a lakelevel for lake '//TRIM(ITOS(ULAKE)),'Error')
   RETURN
  ELSE
   WRITE(*,'(A)') 'iMOD cannot assign a lakelevel for lake '//TRIM(ITOS(ULAKE)); STOP
  ENDIF
 ENDIF

 IF(IOP.EQ.1)LVL=LVL/ILVL

 PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_LAKE_GETMEANVALUE

 !###======================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_BND(ISIZE,BND,IBNDVALUE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),DIMENSION(:,:) :: ISIZE
 INTEGER,INTENT(IN) :: IBNDVALUE
 TYPE(IDFOBJ),INTENT(INOUT),DIMENSION(:) :: BND
 INTEGER :: IROW,ICOL,NN,NE,NS,NW,ILAY,I,J,ISUB
 LOGICAL :: LEX
 
 ILAY=0; DO I=1,SIZE(PBMAN%ILAY)
 
  !## turn all boundaries on zero for this layer
  IF(PBMAN%ILAY(I).EQ.0)THEN
   BND(I)%X=0.0D0; CYCLE
  ENDIF

  ILAY=ILAY+1

  DO IROW=1,BND(ILAY)%NROW
   DO ICOL=1,BND(ILAY)%NCOL
    IF(BND(ILAY)%X(ICOL,IROW).EQ.HNOFLOW)BND(ILAY)%X(ICOL,IROW)=0.0D0
    !## snap to integer
    BND(ILAY)%X(ICOL,IROW)=DBLE(INT(BND(ILAY)%X(ICOL,IROW)))

    !## turn into constant head if pbman%nlayibnd.eq.1
    IF(PBMAN%NLAYIBND.EQ.1.AND.ILAY.EQ.PRJNLAY)THEN
     IF(BND(ILAY)%X(ICOL,IROW).GT.0)BND(ILAY)%X(ICOL,IROW)=IBNDVALUE 
    ENDIF
    
    !## correct for boundary values from mf6
    IF(PBMAN%IFORMAT.EQ.3)THEN
     !## assign mf6 blocking per layer
     IF(PBMAN%SMTYPE.EQ.1)THEN 
      ISUB=PBMAN%ISUBMODEL
      IF(PBMAN%SM(ISUB)%IDF(ILAY)%X(ICOL,IROW).EQ.PBMAN%SM(ISUB)%IDF(ILAY)%NODATA)BND(ILAY)%X(ICOL,IROW)=0.0D0
     ELSE
      IF(PRJIDF%X(ICOL,IROW).EQ.PRJIDF%NODATA)THEN
       BND(ILAY)%X(ICOL,IROW)=0.0D0
      ELSE
       !## set a fixed head around the border of the sub model (only for the first)
       IF(PBMAN%ISUBMODEL.EQ.1)THEN
        !## submodel is smaller than extent of ibound, change boundary
        IF(SUM(ISIZE(:,ILAY)).GT.0)THEN
         IF(BND(ILAY)%X(ICOL,IROW).GT.0.0D0.AND.PRJIDF%X(ICOL,IROW).LT.0.0D0)BND(ILAY)%X(ICOL,IROW)=PRJIDF%X(ICOL,IROW)
        ENDIF
       ENDIF
      ENDIF
     ENDIF
    ENDIF
   ENDDO
  ENDDO
 
  NN=0; NW=0; NS=0; NE=0
 
  !## only apply this to mf6
  LEX=.FALSE.
  IF(PBMAN%IFORMAT.NE.3)LEX=.TRUE.
  !## only apply to first submodel of mf6
  IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%ISUBMODEL.EQ.1)LEX=.TRUE.
  
  IF(LEX)THEN
   !## replace ibound for boundaries - ignore input for the FHB package
   DO IROW=1,BND(ILAY)%NROW
    IF(ISIZE(1,ILAY).EQ.1)THEN
     ICOL=1
     IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
      IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)THEN
       IF(BND(ILAY)%X(ICOL,IROW).NE.2)THEN; NW=NW+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE; ENDIF 
      ELSE
       NW=NW+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE 
      ENDIF
     ENDIF
    ENDIF
    IF(ISIZE(3,ILAY).EQ.1)THEN
     ICOL=BND(ILAY)%NCOL
     IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
      IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)THEN
       IF(BND(ILAY)%X(ICOL,IROW).NE.2)THEN; NE=NE+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE; ENDIF 
      ELSE
       NE=NE+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE 
      ENDIF
     ENDIF
    ENDIF
   ENDDO
   DO ICOL=1,BND(ILAY)%NCOL
    IF(ISIZE(4,ILAY).EQ.1)THEN
     IROW=1
     IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
      IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)THEN
       IF(BND(ILAY)%X(ICOL,IROW).NE.2)THEN; NN=NN+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE; ENDIF 
      ELSE
       NN=NN+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE 
      ENDIF
     ENDIF
    ENDIF
    IF(ISIZE(2,ILAY).EQ.1)THEN
     IROW=BND(ILAY)%NROW
     IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
      IF(TOPICS(TFHB)%IACT_MODEL.EQ.1)THEN
       IF(BND(ILAY)%X(ICOL,IROW).NE.2)THEN; NS=NS+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE; ENDIF 
      ELSE
       NS=NS+1; BND(ILAY)%X(ICOL,IROW)=IBNDVALUE 
      ENDIF
     ENDIF
    ENDIF
   ENDDO
   IF(NN+NS+NW+NE.GT.0)THEN
    WRITE(*,'(A)') 'Modified boundary layer '//TRIM(ITOS(ILAY))//' due to submodelling N/S/W/E: ' // &
       TRIM(ITOS(NN))//'/'//TRIM(ITOS(NS))//'/'//TRIM(ITOS(NW))//'/'//TRIM(ITOS(NE))
   ENDIF
  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,JLAY
 LOGICAL :: LEX
 CHARACTER(LEN=1) :: YESNO
 
 IF(ILAY.GT.0)THEN 
  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL

   LEX=.TRUE.
   IF(ITOPIC.NE.TFHB)THEN
    !## blank out inactive cells
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0)LEX=.FALSE. !THEN
!    IDF%X(ICOL,IROW)=IDF%NODATA
   ENDIF
   !ELSE
   IF(LEX)THEN
    IF(ITYPE.EQ.0)THEN
     !## check whether nodata for active location
     IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)THEN
      LEX=.TRUE.
      !## vcw/kvv might be inactive though boundary underneath is zero
      IF(ITOPIC.EQ.TVCW.OR.ITOPIC.EQ.TKVV)THEN
       IF(BND(ILAY+1)%X(ICOL,IROW).EQ.0)LEX=.FALSE.
      ENDIF
      IF(LEX)THEN
       IF(.NOT.LYESNO)THEN
        WRITE(*,'(/1X,A)') 'Error NodataValue found for active cell'
        WRITE(*,'(A3,3A4,3A15        )') 'VAR','COL','ROW','LAY','IBOUND','X','NODATAVALUE'
        WRITE(*,'(A3,3I4,F15.1,2E15.7)') TOPICS(ITOPIC)%CMOD,ICOL,IROW,ILAY,BND(ILAY)%X(ICOL,IROW),IDF%X(ICOL,IROW),IDF%NODATA
        WRITE(*,'(A$)') 'Continue yes (default value of 1.0D0 is set) / no ?'
        READ(*,'(A1)') YESNO
        IF(UTL_CAP(YESNO,'U').EQ.'N')STOP
        IDF%X(ICOL,IROW)=1.0D0; LYESNO=.TRUE.
       ELSE
        !## set dummy value
        IDF%X(ICOL,IROW)=1.0D0
       ENDIF
      ENDIF
     ENDIF  
    ENDIF
   ENDIF

   !## blank out layer below in case of vertical conductance
   IF(ITOPIC.EQ.TVCW.OR.ITOPIC.EQ.TKVV)THEN 
    IF(BND(ILAY+1)%X(ICOL,IROW).EQ.0)IDF%X(ICOL,IROW)=IDF%NODATA
   ENDIF
  ENDDO; ENDDO

 !## find uppermost active cell
 ELSEIF(ILAY.EQ.0)THEN

  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
   DO JLAY=1,PRJNLAY; IF(BND(JLAY)%X(ICOL,IROW).GT.0)EXIT; ENDDO
   !## skip if location is equal to nodata, completely
   IF(JLAY.GT.PRJNLAY)CYCLE

   IF(ITYPE.EQ.0)THEN
    !## check whether nodata for active location
    IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)THEN
     WRITE(*,'(/1X,A)') 'Error NodataValue found for active cell'
     WRITE(*,'(A3,3A4,3A15        )') 'VAR','COL','ROW','LAY','IBOUND','X','NODATAVALUE'
     WRITE(*,'(A3,3I4,F15.1,2E15.7)') TOPICS(ITOPIC)%CMOD,ICOL,IROW,JLAY,BND(JLAY)%X(ICOL,IROW),IDF%X(ICOL,IROW),IDF%NODATA
     PAUSE; STOP
    ENDIF  
   ENDIF

  ENDDO; ENDDO
 
 ENDIF

 !## blank out negative values for 'KDW','KHV','KVA','VCW','KVV','STO','SSC'
 SELECT CASE (ITOPIC)
  CASE (TKDW,TKHV,TKVA,TVCW,TKVV,TSTO,TSPY)
   DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
    IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)CYCLE
    IF(IDF%X(ICOL,IROW).LT.0.0D0)IDF%X(ICOL,IROW)=0.0D0 
   ENDDO; ENDDO
 END SELECT
 
! !## remove input for inactive cells
! IF(ILAY.GT.0)THEN
!  DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
!   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)IDF%X(ICOL,IROW)=IDF%NODATA
!  ENDDO; ENDDO
! ENDIF
 
 !## skip fhb(31) / chd(28) package
 IF(ITOPIC.NE.TFHB.AND.ITOPIC.NE.TCHD)THEN
  !## remove packages on constant head cells
  IF(ITYPE.EQ.1.AND.ILAY.GT.0)THEN
   DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
    !## blank out constant head cells
    IF(BND(ILAY)%X(ICOL,IROW).LT.0)IDF%X(ICOL,IROW)=IDF%NODATA
   ENDDO; ENDDO
  ENDIF
 ENDIF
  
 END SUBROUTINE PMANAGER_SAVEMF2005_CORRECT

END MODULE MOD_PMANAGER_MF2005