!!  Copyright (C) Stichting Deltares, 2005-2020.
!!
!!  This file is part of iMOD.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.Q*
!!
!!  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 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 KD_TREE

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(TREE_MASTER_RECORD),POINTER,PRIVATE :: TREE
!REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:),PRIVATE :: XY

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
 
 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))
    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-1))      //','// &
      TRIM(RTOS(PEST%PE_PADJ,'G',7))     //','//TRIM(RTOS(PEST%PE_DRES,'G',7))     //','// &
      TRIM(ITOS(PEST%PE_KTYPE))          //','//TRIM(RTOS(PEST%PE_KRANGE,'G',7))   //','// &
      TRIM(ITOS(PEST%PE_REGULARISATION))
      
 WRITE(IU,'(A)') TRIM(LINE)

 !## 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(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)    
  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
      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)') TRIM(LINE)    
     ENDIF
    ENDIF
   ELSE
    WRITE(IU,'(A)') TRIM(LINE)    
   ENDIF
   
  ENDDO
 ELSE
  WRITE(IU,'(A)') '0'
 ENDIF
 
 PMANAGER_SAVEPST=.TRUE.

 END FUNCTION PMANAGER_SAVEPST
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEPST_MF6(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=.FALSE.
 
 !## compute zone distribution
 INQUIRE(FILE=TRIM(DIR)//'\PARAM_DUMP_IPEST.DAT',EXIST=LREUSEDAT)
 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=.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=INT(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.0); IF(F.EQ.0.0)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
   
     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

    ENDDO

   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,'(/3A10)') 'NODES','PAR.-TYPE','PARAMETER'
  WRITE(JU,'(2I10,A10)') PEST%PARAM(I)%NODES,PEST%PARAM(I)%ZTYPE,PEST%PARAM(I)%PPARAM
  IF(PEST%PARAM(I)%ZTYPE.EQ.0)THEN
   WRITE(JU,'(3A10)') 'IROW','ICOL','FACTOR'
   DO J=1,PEST%PARAM(I)%NODES
    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=.TRUE.

 END FUNCTION PMANAGER_SAVEPST_MF6

 !###======================================================================
 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
 
 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))
   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; non-equistantial network
 IF(PBMAN%IWINDOW.EQ.3)THEN

  BNDFNAME=PBMAN%BNDFILE

 ELSE
 
  ALLOCATE(IDF(1)); CALL IDFNULLIFY(IDF(1))
  IF(.NOT.PMANAGER_INIT_SIMAREA(IDF(1),IBATCH))RETURN
  BNDFNAME=IDF(1)%FNAME

  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))') SUBMODEL(1),',',SUBMODEL(2),',',SUBMODEL(3),',',SUBMODEL(4),',',SUBMODEL(5),',',SUBMODEL(7),',',SUBMODEL(6)
   ELSE
    WRITE(IU,'(6(F15.3,A1))') SUBMODEL(1),',',SUBMODEL(2),',',SUBMODEL(3),',',SUBMODEL(4),',',SUBMODEL(5),',',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
 WRITE(IU,'(A)') CHAR(39)//TRIM(BNDFNAME)//CHAR(39)

 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.7,A1,A,2(A1,I1))') KPER,',',SIM(KPER)%DELT,',',TRIM(SIM(KPER)%CDATE),',',SIM(KPER)%ISAVE,',',SIM(KPER)%ISUM
  !## transient (use final date as well, used for labeling file-names!)
  ELSE
   IF(LDAYS)THEN
    WRITE(CDATE1,'(I4.4,2I2.2)') SIM(KPER)%IYR  ,SIM(KPER)%IMH  ,SIM(KPER)%IDY
   ELSE
    WRITE(CDATE1,'(I4.4,5I2.2)') SIM(KPER)%IYR  ,SIM(KPER)%IMH  ,SIM(KPER)%IDY  ,SIM(KPER)%IHR  ,SIM(KPER)%IMT  ,SIM(KPER)%ISC
   ENDIF   
   IF(LDAYS)THEN
    WRITE(CDATE2,'(I4.4,2I2.2)') SIM(KPER+1)%IYR,SIM(KPER+1)%IMH,SIM(KPER+1)%IDY
   ELSE
    WRITE(CDATE2,'(I4.4,5I2.2)') SIM(KPER+1)%IYR,SIM(KPER+1)%IMH,SIM(KPER+1)%IDY,SIM(KPER+1)%IHR,SIM(KPER+1)%IMT,SIM(KPER+1)%ISC
   ENDIF
   WRITE(IU,'(I5.5,A1,F15.7,A1,A,2(A1,I1),A)') KPER,',',SIM(KPER)%DELT,',',TRIM(CDATE1),',',SIM(KPER)%ISAVE,',',SIM(KPER)%ISUM,','//TRIM(CDATE2)
  ENDIF

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

   IPER=PMANAGER_GETCURRENTIPER(KPER,I,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
 LOGICAL :: LTB

 PMANAGER_SAVEMF2005=.FALSE.; LYESNO=.FALSE.
 
 !## 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
 
 !## 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).EQ.0)TOPICS(TPST)%IACT_MODEL=0
 IF(IBATCH.EQ.1.AND.PBMAN%IIES.EQ.0)TOPICS(TPST)%IACT_MODEL=0
 
 !## organise groups
 CALL IPEST_GLM_SETGROUPS()

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

 !##================
 !## 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
 !## read vdf
 IF(.NOT.PMANAGER_SAVEMF2005_CON_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

 !##================
 !## writing section
 !##================

 !## write pst-file
 IF(.NOT.PMANAGER_SAVEMF2005_PST_READWRITE(DIR,DIRMNAME,IBATCH,ISS))RETURN
 !## save bas file
 IF(.NOT.PMANAGER_SAVEMF2005_BAS_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 vdf file
 IF(.NOT.PMANAGER_SAVEMF2005_CON_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 pcg file
 IF(.NOT.PMANAGER_SAVEMF2005_IMS(TRIM(MAINDIR)//'\MFSIM'))RETURN
 !## save pcg file
 IF(.NOT.PMANAGER_SAVEMF2005_PCG(DIRMNAME))RETURN
 !## save pks file
 IF(.NOT.PMANAGER_SAVEMF2005_PKS(DIRMNAME))RETURN
 !## save oc file
 IF(.NOT.PMANAGER_SAVEMF2005_OCD(DIRMNAME,MAINDIR))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(.NOT.PMANAGER_SAVEMF2005_MNW(DIRMNAME,IBATCH,TOPICS(TMNW)%IACT_MODEL,TMNW,IWL2CB,'MNW',IPRT))RETURN
 !## 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.TOPICS(TRIV)%DEFINED)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,TOPICS(TISG)%IACT_MODEL,TISG,IRIVCB,'RIV',IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,TOPICS(TISG)%IACT_MODEL,TISG,IRIVCB,'ISG',IPRT))RETURN
 ENDIF
 !## save riv package
 IF(TOPICS(TCON)%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
 IF(TOPICS(TCON)%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(.NOT.TOPICS(TDRN)%DEFINED)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
 !## save chd package
 IF(TOPICS(TCON)%IACT_MODEL.EQ.1)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TCHD)%IACT_MODEL,TCHD,ICHDCB,'CHD',(/1,2/),IPRT))RETURN
 ELSE
  IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TCHD)%IACT_MODEL,TCHD,ICHDCB,'CHD',(/1/),IPRT))RETURN
 ENDIF
 !## save sfr package
 IF(.NOT.PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,TOPICS(TSFR)%IACT_MODEL,TSFR,ISFRCB,'SFR',IPRT))RETURN
 !## save fhb package
 IF(.NOT.PMANAGER_SAVEMF2005_PCK(DIR,DIRMNAME,IBATCH,TOPICS(TFHB)%IACT_MODEL,TFHB,IFHBCB,'FHB',(/1,2/),IPRT))RETURN
 IF(TOPICS(TLAK)%DEFINED)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(DIRMNAME,IBATCH,TOPICS(TOBS)%IACT_MODEL,TOBS,'OBS',1))RETURN
 ENDIF
 
 !## combine olf/drn and isg/riv
 IF(TOPICS(TOLF)%DEFINED.AND.TOPICS(TDRN)%DEFINED)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
 IF(TOPICS(TISG)%DEFINED.AND.TOPICS(TRIV)%DEFINED)THEN
  IF(.NOT.PMANAGER_SAVEMF2005_COMBINE(DIR,DIRMNAME,(/'ISG','RIV','RIV_'/),IRIVCB,'AUX RFCT AUX ISUB RFACT RFCT RSUBSYS ISUB NOPRINT'))RETURN
 ENDIF
 
 !## write metaswap at last --- uses info from river export
 IF(.NOT.PMANAGER_SAVEMF2005_MSP(DIR,DIRMNAME,IBATCH,IPRT))RETURN 

 !## 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)%DEFINED)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
  I=PBMAN%ISUBMODEL
  CALL PMANAGER_SAVEMF6_CLEANNAM(MAINDIR,DIRMNAME,I)
  
 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
 IF(.NOT.PMANAGER_SAVEMF2005_GLM_MF6_READWRITE(MAINDIR,DIRMNAME,IBATCH))RETURN
 
 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
 LOGICAL :: LEX
 DATA PCK/'CHD6','WEL6','DRN6','RCH6','RIV6','HFB6'/
 
 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
 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
       !## check whether there are packages defined
!       PCKFNAME=TRIM(DIR)//'\GWF_'//TRIM(ITOS(M))//'\MODELINPUT\'//TRIM(MDLNAME)//'.'//TRIM(PCK(J))
       KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,FILE=TRIM(DIR)//'\'//TRIM(PCKFNAME),STATUS='OLD', &
         ACTION='READ',FORM='FORMATTED'); IF(IU.EQ.0)RETURN
       LEX=.TRUE.
       DO
        READ(KU,'(A256)') STRING
        IF(INDEX(STRING,'MAXBOUND').GT.0)THEN
         READ(STRING(9:),*) N
         IF(N.GT.0)WRITE(JU,'(A)') TRIM(LINE)
         EXIT
        ENDIF
        IF(INDEX(STRING,'MAXHFB').GT.0)THEN
         READ(STRING(7:),*) 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]]'
! WRITE(IU,'(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)
       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

 !###======================================================================
 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)%DEFINED)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
 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
 
 !## 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

   SB=BOT(ILAY)%X(ICOL,IROW)
   ST=TOP(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

 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
    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
 
    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  ; 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
 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
 
 !## 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)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(OUT) :: LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL
 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')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')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
 
 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
 
 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

 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
 
 PMANAGER_SAVEMF2005_NAM=.FALSE.
 
 IF(TOPICS(TUZF)%DEFINED)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
! IF(LEN_TRIM(PBMAN%OUTPUT).EQ.0)THEN
  MAINDIR=FNAME(:INDEX(FNAME,'\',.TRUE.)-1)
! ELSE
!  MAINDIR=TRIM(PBMAN%OUTPUT)
! ENDIF
 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)
 
 !## write *.nam file for modflow 6
 IF(PBMAN%IFORMAT.EQ.3.AND.PBMAN%ISUBMODEL.EQ.1)THEN
  
  CRELDIR='.\'; IF(TOPICS(TPST)%DEFINED.OR.TOPICS(TIES)%DEFINED)CRELDIR='..\'
 
  !## write *.nam file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  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'
![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)%DEFINED)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
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  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
   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 !WRITE(IU,'(A)') ' CHD6 '//TRIM(DIRMNAME)//'.CHD6'
    DO ISYS=1,PMANAGER_GETNSYS(TCHD)
     WRITE(IU,'(A)') ' CHD6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.CHD6 CHD6_SYS'//TRIM(ITOS(ISYS))
    ENDDO
   ENDIF
   
   IF(TOPICS(TWEL)%IACT_MODEL.NE.0)THEN
    IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TWEL)
      WRITE(IU,'(A)') ' WEL6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.WEL6 WEL6_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(LWEL)THEN
      WRITE(IU,'(A)') ' WEL6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.WEL6'
     ELSE
      WRITE(IU,'(A)') ' WEL6 '//TRIM(DIRMNAME)//'.WEL6'
     ENDIF
    ENDIF
   ENDIF
    
   IF(TOPICS(TDRN)%IACT_MODEL.NE.0)THEN
    IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TDRN)
      WRITE(IU,'(A)') ' DRN6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.DRN6 DRN6_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(LDRN)THEN
      WRITE(IU,'(A)') ' DRN6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.DRN6'
     ELSE
      WRITE(IU,'(A)') ' DRN6 '//TRIM(DIRMNAME)//'.DRN6'
     ENDIF
    ENDIF
   ENDIF
   
   IF(TOPICS(TRCH)%IACT_MODEL.NE.0)THEN
    IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TRCH)
      WRITE(IU,'(A)') ' RCH6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.RCH6 RCH6_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(LRCH)THEN
      WRITE(IU,'(A)') ' RCH6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.RCH6'
     ELSE
      WRITE(IU,'(A)') ' RCH6 '//TRIM(DIRMNAME)//'.RCH6'
     ENDIF
    ENDIF
   ENDIF   

   IF(TOPICS(TRIV)%IACT_MODEL.NE.0.OR.TOPICS(TISG)%IACT_MODEL.NE.0)THEN
    IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TRIV)
      WRITE(IU,'(A)') ' RIV6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.RIV6 RIV6_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(LRIV)THEN
      WRITE(IU,'(A)') ' RIV6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.RIV6'
     ELSE
      WRITE(IU,'(A)') ' RIV6 '//TRIM(DIRMNAME)//'.RIV6'
     ENDIF
    ENDIF
   ENDIF   
   
   IF(TOPICS(TGHB)%IACT_MODEL.NE.0)THEN
    IF(PBMAN%IIES+PBMAN%IPESTP.EQ.0)THEN
     DO ISYS=1,PMANAGER_GETNSYS(TGHB)
      WRITE(IU,'(A)') ' GHB6 '//TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYS))//'.GHB6 GHB6_SYS'//TRIM(ITOS(ISYS))
     ENDDO
    ELSE
     IF(LGHB)THEN
      WRITE(IU,'(A)') ' GHB6 '//TRIM(DIRMNAME)//'_'//TRIM(CT)//'#'//TRIM(ITOS(ABS(I)))//'.GHB6'
     ELSE
      WRITE(IU,'(A)') ' GHB6 '//TRIM(DIRMNAME)//'.GHB6'
     ENDIF
    ENDIF
   ENDIF

   IF(TOPICS(THFB)%IACT_MODEL.NE.0) WRITE(IU,'(A)') ' HFB6 '//TRIM(DIRMNAME)//'.HFB6'
   IF(TOPICS(TPST)%DEFINED.OR.TOPICS(TIES)%DEFINED)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)%DEFINED.AND.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
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  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)%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)THEN
     WRITE(IU,'(A)') 'LPF  14 '//CHAR(39)//TRIM(DIRMNAME)//'.LPF7'//CHAR(39)
    ELSE
     WRITE(IU,'(A)') 'LPF  14 '//CHAR(39)//TRIM(DIRMNAME)//'_R#'//TRIM(ITOS(I))//'.LPF7'//CHAR(39)
    ENDIF
   ENDIF
   IF(TOPICS(TPCG)%IACT_MODEL.EQ.1) WRITE(IU,'(A)') 'PCG  15 '//CHAR(39)//TRIM(DIRMNAME)//'.PCG7'//CHAR(39)
   IF(LPKS) WRITE(IU,'(A)') 'PKS  15 '//CHAR(39)//TRIM(DIRMNAME)//'.PKS'//CHAR(39)
   IF(PBMAN%IPESTP.EQ.1)THEN
    IF(I.GT.0)THEN
     WRITE(IU,'(A)') 'OC   16 '//CHAR(39)//TRIM(DIRMNAME)//'_P.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(TCON)%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) 

   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)
  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')

 PMANAGER_SAVEMF2005_NAM=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_NAM

 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_SIM(IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2
 
 !## reads idf for model dimensions
 !## creates IDF objects to store parameter values
 
 PMANAGER_SAVEMF2005_SIM=.FALSE.
 
 !## read idf for dimensions
 CALL IDFNULLIFY(PRJIDF); IFULL=0
 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
  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)
  !## see what boundary (submodel?)
  IF(SUBMODEL(1).GT.PRJIDF%XMIN)IFULL(1)=1; IF(SUBMODEL(2).GT.PRJIDF%YMIN)IFULL(2)=1
  IF(SUBMODEL(3).LT.PRJIDF%XMAX)IFULL(3)=1; IF(SUBMODEL(4).LT.PRJIDF%YMAX)IFULL(4)=1
  !## 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
  IF(.NOT.IDFALLOCATEX(PRJIDF))RETURN; PRJIDF%X=0.0D0
 ENDIF
 !## fill sx/sy variable in idf
 IF(.NOT.IDFFILLSXSY(PRJIDF))RETURN
 
 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(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)%DEFINED)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)%DEFINED)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)%DEFINED)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)%DEFINED)THEN
  ALLOCATE(CON(PRJNLAY)); DO ILAY=1,SIZE(CON); CALL IDFNULLIFY(CON(ILAY)); ENDDO
 ENDIF

 !IF(TOPICS(TSFT)%DEFINED)THEN
 ALLOCATE(SFT(2)); DO ILAY=1,SIZE(SFT); CALL IDFNULLIFY(SFT(ILAY)); ENDDO
! ENDIF

 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)%DEFINED)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)%DEFINED)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)%DEFINED)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)%DEFINED)THEN
  DO ILAY=1,SIZE(SFT); CALL IDFCOPY(PRJIDF,SFT(ILAY)); ENDDO
 ENDIF
 
 IF(TOPICS(TCON)%DEFINED)THEN
  DO ILAY=1,SIZE(CON); CALL IDFCOPY(PRJIDF,CON(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(.NOT.TOPICS(TPST)%DEFINED.AND. &
    .NOT.TOPICS(TIES)%DEFINED)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
 IF(PBMAN%IFORMAT.EQ.3)THEN
 
  IF(.NOT.PMANAGER_SAVEPST_MF6(DIR,IBATCH))RETURN
  !## save obs package
  IF(TOPICS(TPST)%DEFINED)TOPICS(TOBS)%IACT_MODEL=1
  IF(.NOT.PMANAGER_SAVEMF2005_OBS(DIRMNAME,IBATCH,TOPICS(TOBS)%IACT_MODEL,TOBS,'OBS',2))RETURN
  !## do not export the obs again
  TOPICS(TOBS)%IACT_MODEL=0

 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; N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM); 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(.NOT.TOPICS(TIES)%DEFINED)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_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
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,II,J,N,IU,JU,IOS,ILAY,N1,N2,ISUB,IPER
 LOGICAL :: LNPF,LSTO,LDRN,LRIV,LGHB,LRCH,LWEL
 LOGICAL,DIMENSION(2) :: LMOD
 LOGICAL,DIMENSION(5) :: LPCK
 
 PMANAGER_SAVEMF2005_GLM_MF6_READWRITE=.TRUE.
 
 !## not modflow6
 IF(PBMAN%IFORMAT.NE.3)RETURN
 !## not ipest defined
 IF(.NOT.TOPICS(TPST)%DEFINED)RETURN
 !## not ipestp defined
 IF(PBMAN%IPESTP.EQ.0)RETURN

 PMANAGER_SAVEMF2005_GLM_MF6_READWRITE=.FALSE.

 N=0; IF(ASSOCIATED(PEST%MEASURES))THEN; N=SIZE(PEST%MEASURES); ENDIF
 
 IF(N.EQ.0)THEN !.OR.PEST%PE_MXITER.LE.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)
 LMOD(1)=LNPF; LMOD(2)=LSTO
 LPCK(1)=LDRN; LPCK(2)=LRIV; LPCK(3)=LGHB; LPCK(4)=LRCH; LPCK(5)=LWEL
 
 !## write *.nam file(s)
 N1=1; N2=1
 IF(PBMAN%IPESTP.EQ.1)THEN
  N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
 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(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')

   DO
    READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    DO II=1,SIZE(PEST%PARAM)
     ILAY=PEST%PARAM(II)%PILS
     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
    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(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'

   !## 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')

   DO
    READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    DO II=1,SIZE(PEST%PARAM)
     DO IPER=1,PRJNPER
      SELECT CASE (PEST%PARAM(II)%PPARAM)
       CASE ('DC')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\DRN_T'//TRIM(ITOS(IPER))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\DRN_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('RC')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\RIV_T'//TRIM(ITOS(IPER))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\RIV_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('GC')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\GHB_T'//TRIM(ITOS(IPER))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\GHB_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('RE')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\RCH_T'//TRIM(ITOS(IPER))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\RCH_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
       CASE ('QR')
        LINE=UTL_SUBST(LINE,TRIM(FEXT)//'\WEL_T'//TRIM(ITOS(IPER))//'.ARR',TRIM(FEXT)//'\'//TRIM(FTYPE)//'\WEL_T'//TRIM(ITOS(IPER))//'_'//TRIM(FTYPE)//'.ARR')
      END SELECT
     ENDDO
    ENDDO
    WRITE(JU,'(A)') TRIM(LINE)
   ENDDO
   CLOSE(IU); CLOSE(JU)
  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

  !## 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')
  DO
   READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
   LINE=UTL_SUBST(LINE,'\OUTPUT_OBS.TXT','\IPEST_'//TRIM(FTYPE)//'\OUTPUT_OBS_'//TRIM(FTYPE)//'.TXT')
   WRITE(JU,'(A)') TRIM(LINE)
  ENDDO
  CLOSE(IU); CLOSE(JU)
 ENDDO
 
 PMANAGER_SAVEMF2005_GLM_MF6_READWRITE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_GLM_MF6_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)

 !## 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)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
 CHARACTER(LEN=52) :: 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)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
   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)
  ENDDO
 
 ELSE
  
  WRITE(IU,'(/A/)') 'General Options'
  WRITE(IU,'(A)') 'BEGIN OPTIONS'  
  WRITE(IU,'(A)') ' LENGTH_UNITS METERS'  
  !## in case of ipestp - do not write a GRB file - mf6toidf can be performed via IDF-option
  IF(PBMAN%IPESTP.EQ.1)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

   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_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
   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.0D0' !## 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
   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
 
 PMANAGER_SAVEMF2005_LPF_READ=.TRUE.
 
 !## use lpf6
 IF(.NOT.LLPF.AND..NOT.LNPF)RETURN

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

 PMANAGER_SAVEMF2005_LPF_READ=.FALSE.

 DO ILAY=1,PRJNLAY

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

  !## 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)
  
  !## transient simulation
  IF(ISS.EQ.1)THEN

   !## 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
  ENDIF
   
  !## 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  
 
 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 
 CHARACTER(LEN=*),INTENT(IN) :: DIR,DIRMNAME
 INTEGER,INTENT(IN) :: IBATCH,ISS
 REAL(KIND=DP_KIND) :: WETFCT,T,KD,D
 INTEGER :: IU,ILAY,IFBND,IHDWET,IWETIT,IROW,ICOL
 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
 LINE=''; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//'1.0D0,'
  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)
 !## 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
  WETFCT=0.1 !## multiplication to determine head in dry cell 
  IHDWET=0   !## option to compute rewetted model layers; h = BOT + WETFCT (hn - BOT) 
  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

  !## 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).NE.1)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).NE.1.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=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,MAX(0.0,T))
     ELSE
      PRJIDF%X(ICOL,IROW)= MIN(WETDRYTHRESS,MAX(0.0,T))
     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,THICK,ROT
 INTEGER :: IU,ILAY,JLAY,IFBND,IHDWET,IWETIT,IROW,ICOL
 LOGICAL :: LEX
 
 PMANAGER_SAVEMF2005_NPF_SAVE=.TRUE.; IF(PBMAN%IFORMAT.EQ.2)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'
 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
  WRITE(IU,'(A)') ' ALTERNATIVE_CELL_AVERAGING AMT-HMK'
  WRITE(IU,'(A)') ' THICKSTRT'
 ENDIF
!THICKSTRT—indicates that cells having a negative ICELLTYPE are confined, and their cell thickness
! WRITE(IU,'(A)') ' [VARIABLECV [DEWATERED]]'
!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.1 !## 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
  IF(LAYCON(ILAY).EQ.2)EXIT
 ENDDO
 IF(ILAY.LE.PRJNLAY)THEN
  IWETIT=1
  WRITE(IU,'(A)') ' REWET WETFCT '//TRIM(RTOS(WETFCT,'F',3))// &
     ' IWETIT '//TRIM(ITOS(IWETIT))//' IHDWET '//TRIM(ITOS(IHDWET))
 ENDIF
 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
  IF(LAYCON(ILAY).EQ.2)WRITE(IU,'(A)') '  CONSTANT 1'    !## convertible head-bot
  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 storage 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
  !## 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)//'\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)=KHV(ILAY)%X(ICOL,IROW)/KVA(ILAY)%X(ICOL,IROW)
   ELSE
    PRJIDF%X(ICOL,IROW)=1.0D0
   ENDIF
  ENDDO; ENDDO
  !## 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)//'\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
   !## include a minor modification to ensure a save in ARR files
   IFBND=1; 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
   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
    IF(.NOT.PMANAGER_SAVEMF2005_MOD_U2DREL(TRIM(DIR)//'\NPF6\WETDRY_L'//TRIM(ITOS(JLAY))//'.ARR', &
        PRJIDF,0,IU,ILAY,0))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(.NOT.TOPICS(TSCR)%DEFINED)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(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(.NOT.TOPICS(TCON)%DEFINED)RETURN
 IF(PBMAN%IFORMAT.EQ.3)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
   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_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(.NOT.TOPICS(TCON)%DEFINED)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_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(PBMAN%IFORMAT.EQ.2)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'
 WRITE(IU,'(A)') ' STORAGECOEFFICIENT'  !## specific coefficient given if NOT mentioned
 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(.NOT.TOPICS(TANI)%DEFINED)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
! IF(PMANAGER_GETFNAMES(1,1,1,0,KPER).LE.0)RETURN

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

  !PRJILIST=ITOPIC; 
  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 ANI-files ('//TRIM(RTOS(REAL(100*ISYS,8)/REAL(NSYS,8),'F',2))//'%)'     

  !## number of subtopics
  DO KTOP=1,NTOP
  
   ILAY=FNAMES(KTOP)%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)

   SCL_U=7; SCL_D=0
   IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(ANA(ILAY),ITOPIC,1,SCL_D,SCL_U,IINV,IPRT))RETURN
   CALL PMANAGER_SAVEMF2005_CORRECT(ILAY,BND,ANA(ILAY),0,ITOPIC)
 
  ENDDO
 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
 CHARACTER(LEN=256) :: SFNAME,EXFNAME,ID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=30) :: FRM
 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
 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%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(TWEL)
 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%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(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,'(1X,A)') ' MAXBOUND NaN1#'
   WRITE(IU,'(A)') 'END DIMENSIONS'
  ENDIF

  !## header
  LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB WSUBSYS ISUB NOPRINT'
  IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE) 
 
  !## fill tlp for each modellayer
  ALLOCATE(TLP(PRJNLAY),KH(PRJNLAY),TP(PRJNLAY),BT(PRJNLAY))

  WRITE(FRM,'(A9,I2.2,A15)') '(3(I5,1X),',1,'(G15.7,1X),I10)'

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

  !## maximum number of well in simulation
  MP=0
  IOS=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)THEN
     IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
     ELSE; WRITE(IU,'(I10)') -1; ENDIF
    ENDIF
    !## goto next timestep
    CYCLE
   ENDIF

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

   JU=0
   !## create subfolders
   IF(PBMAN%IFORMAT.EQ.2)THEN
    CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//'7')
    EXFNAME=TRIM(DIR)//'\'//CPCK//'7'//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
   ELSE
    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'
   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%IFORMAT.EQ.3)THEN
    !## export current system only
    IS1=ISYSMF6; IS2=IS1
   ELSE
    !## export all systems
    IS1=1; IS2=NSYS
   ENDIF

   DO ISYS=IS1,IS2 !1,NSYS

    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)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=MAX(3,IEXT); IF(ILAY.EQ.0)N=MAX(5,IEXT)
    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'); EXIT
    ENDIF
    ALLOCATE(STRING(N)); STRING=''
    
    !## steady-state/transient timestep
    ISS=1; IF(SIM(IPER)%DELT.GT.0.0D0)ISS=2
    !## overrule in case of steady-state
    IF(ISS.EQ.1)IEXT=0
   
    DO I=1,NROWIPF

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

     READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,N); IF(IOS.NE.0)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

     !## 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),'(A)',IOSTAT=IOS) ID; IF(IOS.NE.0)EXIT
     ENDIF

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

      !## 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; 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(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(BND(ILAY)%X(ICOL,IROW).LE.0.0D0)TLP(ILAY)=0.0D0
      ENDDO
 !     !## normalize tlp() again
 !     IF(SUM(TLP).GT.0.0D0)TLP=(1.0D0/SUM(TLP))*TLP

      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
        WRITE(JU,FRM) JLAY,IROW,ICOL,Q*TLP(ILAY),ISYS
        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))//CHAR(13)//'iMOD Probably cannot read values for top and bot in combination with ilay=0','Error'); EXIT
    ENDIF     
   
   ENDDO

   IF(NP.GT.0)THEN
    IF(PBMAN%IFORMAT.EQ.2)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)THEN
     LINE=TRIM(ITOS(NP)); WRITE(IU,'(A)') TRIM(LINE)
    ENDIF
    IF(NP.GT.0)THEN
     SFNAME=EXFNAME
     N=3; IF(PBMAN%IFORMAT.EQ.3)N=5; 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)
     WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(A)') 'END PERIOD '//TRIM(ITOS(IPER))

   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)
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'_SYS'//TRIM(ITOS(ISYSMF6))//'.'//CPCK//VTXT//'_',(/MP/))
   ELSE
    CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/MP/))
   ENDIF
   PMANAGER_SAVEMF2005_WEL=.TRUE.
  ENDIF
 
 ENDDO
 
 END FUNCTION PMANAGER_SAVEMF2005_WEL
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_OBS(DIRMNAME,IBATCH,IACT,ITOPIC,CPCK,IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ITOPIC,IACT,IOPTION
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: X,Y,Z1,Z2,FCT,IMP,CNST,H,NCOUNT,W
 CHARACTER(LEN=256) :: SFNAME,EXFNAME,OBSNAME,CID,CDIR
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: STRING
 INTEGER :: IU,JU,KU,ILAY,IROW,ICOL,I,J,II,NROWIPF,NCOLIPF,IEXT,IOS,N,NP,MP,ICNST,ISYS,NSYS,IPER,KPER,IP, &
   IXCOL,IYCOL,ILCOL,IMCOL,IVCOL
 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.
 
 VTXT='6'

 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)RETURN

 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'
 
 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
 MP=0; IOS=0
 
 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)
 
 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
  !## 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
   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)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

  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'); EXIT
  ENDIF
  ALLOCATE(STRING(N)); STRING=''
    
  DO I=1,NROWIPF
   
   READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,N); IF(IOS.NE.0)EXIT

   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)EXIT
    ENDIF
   ELSEIF(IOPTION.EQ.2)THEN
    READ(STRING(ILCOL),*,IOSTAT=IOS) ILAY; IF(IOS.NE.0)EXIT
   ENDIF
    
   READ(STRING(IXCOL),*,IOSTAT=IOS) X; IF(IOS.NE.0)EXIT
   READ(STRING(IYCOL),*,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

   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(IOPTION.EQ.1.AND.ILAY.EQ.0)THEN

    READ(STRING(3),*,IOSTAT=IOS) Z1; IF(IOS.NE.0)EXIT
    READ(STRING(4),*,IOSTAT=IOS) Z2; IF(IOS.NE.0)EXIT

    !## 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)EXIT
   ELSEIF(IOPTION.EQ.2)THEN
    READ(STRING(ABS(IVCOL)),*,IOSTAT=IOS) W;  IF(IOS.NE.0)EXIT
    !## convert weight to stdev
    IF(IVCOL.LT.0)THEN; IF(W.LE.0.0D0)THEN; W=0.0D0; ELSE; W=SQRT(1.0D0/W); ENDIF; ENDIF
   ENDIF
   
   !## 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)EXIT
    ELSE
     !## get id number - can be any column
     READ(STRING(IEXT),'(A)',IOSTAT=IOS) CID; IF(IOS.NE.0)EXIT
    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)EXIT
    ELSE
     READ(STRING(IMCOL),*,IOSTAT=IOS) H; IF(IOS.NE.0)EXIT
    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'
   
   !## 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
    
    IF(IEXT.GT.0)THEN
     IF(.NOT.UTL_PCK_READTXT(2,ITIME,JTIME,H,TRIM(CDIR)//'\'//TRIM(CID)//'.'//TRIM(EXT),0,'',2,NCOUNT))THEN
      IOS=-1; EXIT
     ENDIF
     IF(NCOUNT.LE.0.0D0)H=HNOFLOW !0.0D0
    ENDIF
         
    !## 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(JU,'(A)') TRIM(ITOS_DBL(ITIME))//','//TRIM(RTOS(H,'G',7))//','//TRIM(RTOS(W,'F',3))//','//TRIM(ITOS(ILAY))
     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(IU,'(A)') TRIM(OBSNAME)//',HEAD,'//TRIM(ITOS(ILAY))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
     NP=NP+1
    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))//CHAR(13)//'iMOD Probably cannot read values for top and bot in combination with ilay=0','Error'); EXIT
  ENDIF     
   
 ENDDO
  
 !## store maximum number of well in simulation
 MP=MAX(MP,NP)
  
 WRITE(IU,'(A)') 'END CONTINUOUS' 

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

 CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.MES'//VTXT//'_',(/MP/))

 IF(IOS.EQ.0)PMANAGER_SAVEMF2005_OBS=.TRUE.
 
 END FUNCTION PMANAGER_SAVEMF2005_OBS
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_MNW(DIRMNAME,IBATCH,IACT,ITOPIC,ICB,CPCK,IPRT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,ICB,ITOPIC,IPRT,IACT
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME,CPCK
 REAL(KIND=DP_KIND) :: X,Y,Q,Z1,Z2,FCT,IMP,CNST,RW,RSKIN,KSKIN,NCOUNT
 CHARACTER(LEN=256) :: SFNAME,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, &
   MNWPRINT,NNODES,ILOSSTYPE,QLIMIT,PPFLAG,PUMPLOC,PUMPCAP,ILOSS,IEQUAL
 INTEGER(KIND=8) :: ITIME,JTIME
 LOGICAL :: LEX
 
 IF(IACT.EQ.0)THEN; PMANAGER_SAVEMF2005_MNW=.TRUE.; RETURN; ENDIF

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

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

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

 !## no output information, use 2 for maximal output
 MNWPRINT=0 !2
 
 !## header
 LINE='NaN1#,'//TRIM(ITOS(ICB))//','//TRIM(ITOS(MNWPRINT))//' NOPRINT'; WRITE(IU,'(A)') TRIM(LINE)
 
 !## 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
 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)THEN
    IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0
    ELSE; WRITE(IU,'(I10)') -1; ENDIF
   ENDIF
   !## goto next timestep
   CYCLE
  ENDIF  
  
  IF(IPER.GT.0)THEN; LINE='NaN'//TRIM(ITOS(IPER+1))//'#'; WRITE(IU,'(A)') TRIM(LINE); ENDIF
  
  !## get number of mnw-systems
  NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)

  DO ISYS=1,NSYS

   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(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; EXIT
   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)   
 
   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
   
   DO I=1,NROWIPF
   
    !## start with current given layer number
    ILAY=TOPICS(ITOPIC)%STRESS(KPER)%FILES(1,ISYS)%ILAY

    READ(KU,*,IOSTAT=IOS) (STRING(J),J=1,N); IF(IOS.NE.0)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

    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
     LINE='WELLID_'//TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(ITOS(NNODES))
     !## identification
     WRITE(IU,'(A)') TRIM(LINE)
     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; EXIT
!         '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; EXIT
     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
     LINE=TRIM(LOSSTYPE)//','//TRIM(ITOS(PUMPLOC))//','//TRIM(ITOS(QLIMIT))//','//TRIM(ITOS(PPFLAG))//','//TRIM(ITOS(PUMPCAP))
     WRITE(IU,'(A)') TRIM(LINE)
     SELECT CASE (ILOSSTYPE)
      !## thiem
      CASE(1)
       READ(STRING(ILOSS+1),*,IOSTAT=IOS) RW; IF(IOS.NE.0)EXIT
       LINE=TRIM(RTOS(RW,'F',2)); WRITE(IU,'(A)') TRIM(LINE)
      !## 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
       LINE=TRIM(RTOS(RW,'F',2))//','//TRIM(RTOS(RSKIN,'F',2))//','//TRIM(RTOS(KSKIN,'F',2)); WRITE(IU,'(A)') TRIM(LINE)
     END SELECT
     IF(NNODES.GT.0)THEN
      LINE=TRIM(ITOS(ILAY))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
      WRITE(IU,'(A)') TRIM(LINE)
     ELSE
      READ(STRING(4),*,IOSTAT=IOS) Z1; IF(IOS.NE.0)EXIT
      READ(STRING(5),*,IOSTAT=IOS) Z2; IF(IOS.NE.0)EXIT
      Z1=MIN(Z1,TOP(1      )%X(ICOL,IROW)-0.1D0)
      Z2=MAX(Z2,BOT(PRJNLAY)%X(ICOL,IROW)+0.1D0)
      LINE=TRIM(RTOS(Z1,'F',2))//','//TRIM(RTOS(Z2,'F',2))//','//TRIM(ITOS(IROW))//','//TRIM(ITOS(ICOL))
      WRITE(IU,'(A)') TRIM(LINE)
     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  

     LINE='WELLID_'//TRIM(ITOS(NP_IPER(IPER)))//','//TRIM(RTOS(Q,'G',7))
     WRITE(IU,'(A)') TRIM(LINE)
    
    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)),'Error'); EXIT
   ENDIF     
 
  ENDDO
 
  IF(IOS.NE.0)EXIT
 
  !## 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
  CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//'7_',NP_IPER) 
  PMANAGER_SAVEMF2005_MNW=.TRUE.
 ENDIF
  
 DEALLOCATE(NP_IPER)
 
 END FUNCTION PMANAGER_SAVEMF2005_MNW
 
 !###======================================================================
 LOGICAL FUNCTION PMANAGER_SAVEMF2005_ISG(DIR,DIRMNAME,IBATCH,IACT,ITOPIC,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,ITOPIC,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_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

 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(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing '//TRIM(DIRMNAME)//'.'//CPCK//'7...')
 !IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing '//TRIM(DIRMNAME)//'.'//CPCK//'7...'

 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,'(1X,A)') ' MAXBOUND NaN1#'
  WRITE(IU,'(A)') 'END DIMENSIONS'
 ENDIF
 
! IU=UTL_GETUNIT()
! CALL OSD_OPEN(IU,FILE=TRIM(DIRMNAME)//'.'//CPCK//'7_',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
! IF(IU.EQ.0)RETURN

 IF(PBMAN%IFORMAT.EQ.2)THEN
  SELECT CASE (ITOPIC)
   !## isg 
   CASE (TISG)
    LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX RFCT AUX ISUB RFACT RFCT RSUBSYS ISUB NOPRINT'
   !## sfr
   CASE (TSFR)
    LINE='NaN2#,NaN1#,0,0,'//TRIM(RTOS(CONST,'G',7))//','//TRIM(RTOS(DLEAK,'E',4))//','// &
         TRIM(ITOS(ICB))//','//TRIM(ITOS(ISFRCB2))//' NOPRINT'
  END SELECT
  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)

 NP=0
 
 DO IPER=1,PRJNPER
  !## reset only for isg to riv conversion
  IF(ITOPIC.EQ.TISG)NP(1)=0

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

  !## always export rivers per stress-period
  IF(ITOPIC.EQ.TISG)THEN; IF(PBMAN%DISG.EQ.1)KPER=ABS(KPER); ENDIF
  !## always export streamflow routing per stress-period
  IF(ITOPIC.EQ.TSFR)THEN; IF(PBMAN%DSFR.EQ.1)KPER=ABS(KPER); ENDIF
  
  !## 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
    IF(ITOPIC.EQ.TISG)WRITE(IU,'(A)') '-1'
    IF(ITOPIC.EQ.TSFR)WRITE(IU,'(A)') '-1,-1,0,0'
   ENDIF
   !## process next timestep
   CYCLE
  ENDIF
  
  IF(PBMAN%IFORMAT.EQ.3)WRITE(IU,'(/A)') 'BEGIN PERIOD '//TRIM(ITOS(IPER))     

  !## default isg
  IF(ITOPIC.EQ.TISG)THEN
   EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
   JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=EXFNAME,STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED'); IF(JU.EQ.0)RETURN
  !## sfr isg
  ELSE
   EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'.ARR'
   JU=IU
  ENDIF
  
  !## 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))

  GRIDISG%XMIN=BND(1)%XMIN; GRIDISG%YMIN=BND(1)%YMIN
  GRIDISG%XMAX=BND(1)%XMAX; GRIDISG%YMAX=BND(1)%YMAX
  !## transient (2) or steady-state (1)
  GRIDISG%ISTEADY=2; IF(SIM(IPER)%DELT.EQ.0.0D0)GRIDISG%ISTEADY=1
  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
  
  !## output folder
  GRIDISG%ROOT=EXFNAME(1:INDEX(EXFNAME,'\',.TRUE.)-1)  
  GRIDISG%POSTFIX=''
  GRIDISG%NODATA=-999.99D0
  GRIDISG%ISAVE=1
  GRIDISG%MAXWIDTH=1000.0D0
  GRIDISG%IAVERAGE=1

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

   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

   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(ITOPIC)%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
    SELECT CASE (ITOPIC)
     !## open isg file
     CASE (TISG)
      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)%DEFINED,JSYS,FCT,IMP))EXIT 
     !## open sfr file
     CASE (TSFR)
      IF(.NOT.ISG2SFR(BND(1)%NROW,BND(1)%NCOL,PRJNLAY,ILAY,IPER,PRJNPER,NP,JU,GRIDISG,EXFNAME,TOP,BOT,FCT,IMP))EXIT 
    END SELECT
    CALL ISGDEAL(1); CALL ISGCLOSEFILES()
   ELSE
    !## stop processing
    CLOSE(IU); CALL PMANAGER_SAVEMF2005_DEALLOCATEPCK(); RETURN
   ENDIF

  ENDDO
 
  !## error occured
  IF(ISYS.LE.NSYS)EXIT
 
  !## only for river package usage of external filename
  IF(ITOPIC.EQ.TISG)THEN
   IF(PBMAN%IFORMAT.GE.2)THEN
    IF(PBMAN%IFORMAT.EQ.2)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%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)
     WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
    ENDIF
    IF(IU.NE.JU)CLOSE(JU)
    IF(PBMAN%IFORMAT.EQ.3)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
  IF(ITOPIC.EQ.TISG)THEN
   CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP(2)/))
  ELSE
   CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',NP)
  ENDIF
  PMANAGER_SAVEMF2005_ISG=.TRUE.
 ENDIF
  
 END FUNCTION PMANAGER_SAVEMF2005_ISG
 
 !###======================================================================
 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
 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
 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
 REAL(KIND=DP_KIND) :: DDAY,DSEC
 CHARACTER(LEN=1) :: VTXT
 LOGICAL :: LCHKCHD,LEX
 
 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

 !## in case MF6 is used, apply systems per package
 IF(PBMAN%IFORMAT.EQ.3)THEN
  NSYSMF6=PMANAGER_GETNSYS(ITOPIC)
 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%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(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)') 'END OPTIONS'
   WRITE(IU,'(/A/)') '#General Dimensions'  
   WRITE(IU,'(A)') 'BEGIN DIMENSIONS'
   WRITE(IU,'(1X,A)') ' MAXBOUND NaN1#'
   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
    !## 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)WRITE(IU,'(A)') TRIM(LINE)
   
 !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
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB DSUBSYS ISUB NOPRINT'
    ELSE
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB DSUBSYS ISUB ICONCHK NOPRINT'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)

 !## AUX IC ICHONCHK IC
   !## riv
   CASE (TRIV)
    LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX RFCT'
    IF(TOPICS(TCON)%IACT_MODEL.EQ.1)LINE=TRIM(LINE)//' AUX RIVDEN'
    LINE=TRIM(LINE)//' AUX ISUB RFACT RFCT RSUBSYS ISUB NOPRINT'
    IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
 !## IFVDL SFT RCNC
   !## evt
   CASE (TEVT); NEVTOP=1; LINE='NaN1#,'//TRIM(ITOS(ICB))
   IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
 !## NEVTOP moet twee worden voor optie laag = -1
   !## ghb
   CASE (TGHB)
    LINE='NaN1#,'//TRIM(ITOS(ICB))
    IF(TOPICS(TCON)%IACT_MODEL.EQ.1)LINE=TRIM(LINE)//' AUX GHBDEN'
    LINE=TRIM(LINE)//' AUX ISUB GSUBSYS ISUB NOPRINT'
    IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
   !## rch
   CASE (TRCH); NRCHOP=1; LINE='NaN1#,'//TRIM(ITOS(ICB))
   IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
 !## NaN1 moet 3 worden voor optie laag = -1
   !## olf
   CASE (TOLF)
    CPCK='OLF'; IF(.NOT.TOPICS(TDRN)%DEFINED)CPCK='DRN';
    IF(PBMAN%ICONCHK.EQ.0)THEN
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB DSUBSYS ISUB NOPRINT'
    ELSE
     LINE='NaN1#,'//TRIM(ITOS(ICB))//' AUX ISUB DSUBSYS ISUB ICONCHK NOPRINT'
    ENDIF
    IF(PBMAN%IFORMAT.EQ.2)WRITE(IU,'(A)') TRIM(LINE)
   !## chd
   CASE (TCHD)
    LINE='NaN1#'
    IF(TOPICS(TCON)%IACT_MODEL.EQ.1)LINE=TRIM(LINE)//' AUX CHDDEN'
    LINE=TRIM(LINE)//' NOPRINT NEGBND'
    IF(PBMAN%IFORMAT.EQ.2)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

    !## look for number of stress-periods for boundary package
    ALLOCATE(FHBNBDTIM(PRJNPER)); 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
     !## get first start-date
     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 J=1,SIZE(TOPICS(ITOPIC)%STRESS)
      IF(.NOT.ASSOCIATED(TOPICS(ITOPIC)%STRESS(J)%FILES))CYCLE
      !## 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)/86400.0D0
     ENDDO
    ENDIF
     
    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,1'
    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
       DO I=1,4; WRITE(IU,'(A)') '-1';  ENDDO
      ENDIF
     !## evt 
     CASE (TEVT) 
      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
     !## rch
     CASE (TRCH) 
      IF(PBMAN%IFORMAT.EQ.2)THEN
       IF(IPER.EQ.1)THEN; WRITE(IU,'(I10)') 0; WRITE(IU,'(A)') 'CONSTANT 0.000000E+00'
       ELSE; WRITE(IU,'(I10)') -1; ENDIF
      ENDIF
     !##  wel,drn,riv,ghb,chd,olf
     CASE (TDRN,TRIV,TGHB,TCHD,TOLF,TISG)
      IF(PBMAN%IFORMAT.EQ.2)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)
  
   IF(NTOP.NE.SIZE(JTOP))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
   ENDIF
  
   !## 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 DEFAULT; N=NTOP
   END SELECT
  
   WRITE(FRM,'(A10,I2.2,A14)') '(3(I5,1X),',N,'(G15.7,1X),I5)'
  
   CALL PMANAGER_SAVEMF2005_ALLOCATEPCK(NTOP)
  
   NHED=0; NFLW=0; NBDTIM=NBDTIM+1

   IF(PBMAN%IFORMAT.EQ.3)THEN
    !## export current system only
    IS1=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
     
!      !## number of systems
!      NSYS=SIZE(TOPICS(ITOPIC)%STRESS(KPER)%FILES,2)

      DO ISYS=IS1,IS2 !1,NSYS      !## number of systems
!      DO ISYS=1,NSYS
       !## 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)THEN
         EXFNAME=TRIM(DIR)//'\'//CPCK//'7'//'\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
        ELSE
         EXFNAME=TRIM(DIR)//'\'//CPCK//'6\SYS'//TRIM(ITOS(ISYSMF6))//'\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
        ENDIF
!        EXFNAME=TRIM(DIR)//'\'//CPCK//'7\'//CPCK//'_T'//TRIM(ITOS(IIPER))//'.ARR'
        SFNAME=EXFNAME; DO I=1,3; SFNAME=SFNAME(:INDEX(SFNAME,'\',.TRUE.)-1); ENDDO
        I=LEN_TRIM(SFNAME); SFNAME='.'//EXFNAME(I+1:)
        LINE=TRIM(ITOS(NP_IPER(IIPER))); WRITE(IU,'(A)') TRIM(LINE)
        WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0D0 (FREE) -1'
        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)THEN
       CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)
       EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
      ELSE
       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'
      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
       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'
!       CALL UTL_CREATEDIR(TRIM(DIR)//'\'//CPCK//VTXT)
!       EXFNAME=TRIM(DIR)//'\'//CPCK//VTXT//'\'//CPCK//'_T'//TRIM(ITOS(IPER))//'.ARR'
       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 !1,NSYS

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

     !## ilay equal zero not possible for rch and evt
     IF(ITOPIC.EQ.TEVT.OR.ITOPIC.EQ.TRCH)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
        CASE (6);   SCL_D=0; SCL_U=2; NUZF2=IEQUAL
        CASE (7);   SCL_D=0; SCL_U=2; NUZF3=IEQUAL
        CASE (8);   SCL_D=0; SCL_U=2; NUZF4=IEQUAL
       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); INSURF=IEQUAL; SCL_U=2
        CASE (2); INEVTR=IEQUAL; SCL_U=16
        CASE (3); INEXDP=IEQUAL; SCL_U=2
       END SELECT
      !## rch
      CASE (TRCH) 
       SCL_D=1; SCL_U=16   !## average
       !## 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(KTOP.EQ.1)SCL_U=5 !## q - sum (divide if cell is smaller)
       IF(KTOP.EQ.2)SCL_U=2 !## h - average
      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.LT.0)NRCHOP=3
       !## checking for inactive cells
       ICHECK=1; IF(ILAY.GT.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
        !## 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
 !       !## 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
       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

     !## rch
     CASE (TRCH)

      IF(PBMAN%IFORMAT.EQ.2)THEN
       LINE=TRIM(ITOS(INRECH)); WRITE(IU,'(A)') TRIM(LINE); 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
      ELSEIF(PBMAN%IFORMAT.EQ.3)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
         WRITE(JU,'(3I10,G15.7,I10)') JLAY,IROW,ICOL,PCK(1)%X(ICOL,IROW),ISYS
         NP_IPER(IPER)=NP_IPER(IPER)+1
        ENDDO
       ENDDO; ENDDO
      ENDIF
     
     !## evt
     CASE (TEVT)

      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
     
     CASE DEFAULT
      
      DO IROW=1,PCK(1)%NROW; DO ICOL=1,PCK(1)%NCOL

       !## skip inactive/constant head cells
       IF(PCK(1)%ILAY.GT.0.AND.ITOPIC.NE.TCHD)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
        DO I=1,NTOP; IF(PCK(JTOP(I))%X(ICOL,IROW).NE.HNOFLOW)EXIT; ENDDO
        !## found no data in either dataset - skip data point
        IF(I.GT.NTOP)CYCLE
       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
       
       !## check bottom river if that is higher than river stage
       IF(ITOPIC.EQ.TRIV)PCK(3)%X(ICOL,IROW)=MIN(PCK(2)%X(ICOL,IROW),PCK(3)%X(ICOL,IROW))
      
       !## 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
        !## 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
      
       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
            ELSE
             WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),PCK(JTOP(1))%X(ICOL,IROW),1
            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
          ELSE
           WRITE(JU,FRM) JLAY,IROW,ICOL,PCK(JTOP(1))%X(ICOL,IROW),OLFCOND,1
          ENDIF
          NP_IPER(IPER)=NP_IPER(IPER)+1
         !## fhb
         CASE (TFHB)
          IF(BND(ILAY)%X(ICOL,IROW).EQ. 2.0)THEN; NFLW=NFLW+1; FHBFLW(NFLW,NBDTIM)=PCK(JTOP(1))%X(ICOL,IROW); ENDIF      
          IF(BND(ILAY)%X(ICOL,IROW).EQ.-2.0)THEN; NHED=NHED+1; FHBHED(NHED,NBDTIM)=PCK(JTOP(2))%X(ICOL,IROW); ENDIF
         CASE DEFAULT
          IF(PCK(JTOP(2))%X(ICOL,IROW).GT.0.0D0)THEN

           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
           WRITE(JU,FRM) JLAY,IROW,ICOL,(XTMP(JTOP(I)),I=1,NTOP),JSYS
           NP_IPER(IPER)=NP_IPER(IPER)+1
         
          ENDIF
        END SELECT

      ENDDO 

     ENDDO; ENDDO
    
    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)WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  
   !## maximum input per simulation
   MP=MAX(MP,NP_IPER(IPER))
    
   IF(PBMAN%IFORMAT.EQ.2)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(NP_IPER(IPER).GT.0)THEN
     SFNAME=EXFNAME
     N=3; IF(PBMAN%IFORMAT.EQ.3)N=5; 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
     WRITE(IU,'(A)') 'OPEN/CLOSE '//TRIM(SFNAME)//' 1.0 (FREE) -1'
    ENDIF
   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,1'; 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)THEN
      I=I+1; WRITE(IU,'(3(I10,1X),F10.1,99(1X,G15.7))') ILAY,IROW,ICOL,1.0,(FHBFLW(I,J),J=1,NBDTIM)
     ENDIF
    ENDDO; ENDDO; ENDDO
   ENDIF
   IF(ALLOCATED(FHBHED))THEN
    LINE=TRIM(ITOS(IFHBUN))//',1.0,1'; 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)THEN
     I=I+1; WRITE(IU,'(3(I10,1X),F10.1,99(1X,G15.7))') ILAY,IROW,ICOL,1.0,(FHBHED(I,J),J=1,NBDTIM)
     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); NP_IPER(0)=NUZTOP
   CASE (TEVT); NP_IPER(0)=NEVTOP
   CASE (TRCH)
    IF(PBMAN%IFORMAT.EQ.2)NP_IPER(0)=NRCHOP
    IF(PBMAN%IFORMAT.EQ.3)NP_IPER(0)=NP_IPER(1)
   CASE DEFAULT; NP_IPER(0)=MP
  END SELECT

  IF(ITOPIC.EQ.TEVT.OR.ITOPIC.EQ.TRCH)THEN
   IF(TOPICS(TLAK)%DEFINED.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)
   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
!  CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.'//CPCK//VTXT//'_',(/NP_IPER(0)/))

  IF(ALLOCATED(NP_IPER))DEALLOCATE(NP_IPER)
 
 ENDDO
 
 PMANAGER_SAVEMF2005_PCK=.TRUE.
  
 END FUNCTION PMANAGER_SAVEMF2005_PCK

 !####====================================================================
 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(.NOT.TOPICS(TLAK)%DEFINED)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(.NOT.TOPICS(TLAK)%DEFINED)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(.NOT.TOPICS(TSFT)%DEFINED)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
   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)
   
   !## most frequent occurence for angles
   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

 PMANAGER_SAVEMF2005_TDIS=.TRUE.; IF(PBMAN%IFORMAT.EQ.2)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
   LINE=TRIM(RTOS(SIM(KPER)%DELT,'G',7))//','// &
        TRIM(ITOS(SIM(KPER)%NSTP))      //','// &
        TRIM(RTOS(SIM(KPER)%TMULT,'G',7))
  ENDIF
  LINE=TRIM(LINE)//' ['//TRIM(SIM(KPER)%CDATE)//']'
  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
 
 !DIR=DIRIN; IF(PBMAN%OUTPUT.NE.'')DIR=PBMAN%OUTPUT
 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
  N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
 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(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
   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
  IF(PBMAN%IPESTP+PBMAN%IIES.EQ.0)THEN
   LINE='RESULTDIR "'//TRIM(DIR)//'"'; WRITE(IU,'(A)') TRIM(LINE)
  ELSEIF(PBMAN%IPESTP.EQ.1)THEN
   IF(I.GT.0)THEN
    LINE='RESULTDIR "'//TRIM(DIR)//'\IPEST_P#'//TRIM(ITOS(I))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ELSE
    LINE='RESULTDIR "'//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='RESULTDIR "'//TRIM(DIR)//'\IIES_R#'//TRIM(ITOS(I))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ELSE
    LINE='RESULTDIR "'//TRIM(DIR)//'\IIES_L#'//TRIM(ITOS(ABS(I)))//'"'; WRITE(IU,'(A)') TRIM(LINE)
   ENDIF
  ENDIF
  IF(PBMAN%IPEST+PBMAN%IPESTP.GT.0)THEN
   LINE='IPESTPDIR "'//TRIM(DIR)//'"'; WRITE(IU,'(A)') TRIM(LINE)
  ENDIF
  LINE='SAVEDOUBLE '//TRIM(ITOS(PBMAN%IDOUBLE)); WRITE(IU,'(A)') TRIM(LINE)
  LINE='SAVEDATE 1'; WRITE(IU,'(A)') TRIM(LINE)
  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
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IUGEN,IUDAT,NHFBNP
 CHARACTER(LEN=1) :: VTXT
 
 PMANAGER_SAVEMF2005_HFB=.TRUE.

 IF(.NOT.TOPICS(THFB)%DEFINED)RETURN

 PMANAGER_SAVEMF2005_HFB=.FALSE.

 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//'...'

 !## creating and collect all faults
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(DIRMNAME)//'_HFB.TXT',STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
 ITOPIC=THFB; IF(.NOT.PMANAGER_SAVEMF2005_HFB_COMPUTE(PRJIDF,ITOPIC,JU,BND,TOP,BOT,IPRT,IBATCH))RETURN

 !## 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'
  WRITE(IU,'(/A)') 'BEGIN PERIOD 1'
 ENDIF

 !## 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)); NHFBNP=0
 
 !## apply resistances
 IF(PBMAN%IFORMAT.EQ.2)THEN
  IF(LTB)THEN
   WRITE(IU,'(2I10,A)') NPHFB,MXFB,',NaN1# NOPRINT HFBRESIS SYSTEM'
  ELSE
   WRITE(IU,'(2I10,A)') NPHFB,MXFB,',NaN1# NOPRINT HFBFACT SYSTEM' 
  ENDIF
 ENDIF
 
 ALLOCATE(IUGEN(PRJNLAY),IUDAT(PRJNLAY)); IUGEN=0; IUDAT=0
 DO ILAY=1,PRJNLAY
  IUGEN(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(IUGEN(ILAY),FILE=TRIM(DIRMNAME)//'_HFB_L'//TRIM(ITOS(ILAY))//'.GEN', &
    STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')
  IF(IUGEN(ILAY).EQ.0)RETURN
  IUDAT(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(IUDAT(ILAY),FILE=TRIM(DIRMNAME)//'_HFB_L'//TRIM(ITOS(ILAY))//'.DAT', &
    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
 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=TRIM(DIRMNAME)//'_HFB.TXT',STATUS='OLD',ACTION='READ',FORM='FORMATTED')
 CALL PMANAGER_SAVEMF2005_HFB_EXPORT(NHFBNP,IU,JU,IUGEN,IUDAT,PRJIDF,LTB) 

 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 hfb file
 CLOSE(IU); CLOSE(JU,STATUS='DELETE')

 CALL UTL_MF2005_MAXNO(TRIM(DIRMNAME)//'.HFB'//VTXT//'_',(/SUM(NHFBNP)/)) 
 
 DEALLOCATE(NHFBNP)
 
 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

 PMANAGER_SAVEMF2005_OCD=.FALSE.
  
 JU=0
 
 IF(PBMAN%IFORMAT.EQ.2)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
  
  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
  
  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)
   IF(PBMAN%IPESTP.EQ.1)THEN
    LINE='SAVE HEAD'; DO ILAY=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(ILAY)); ENDDO; 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(TUZF)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TUZF)%ILAY,'BUDGET',IUZFCB1,IU)
   IF(TOPICS(TSFR)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TSFR)%ILAY,'BUDGET',ISFRCB,IU)
   IF(TOPICS(TFHB)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TFHB)%ILAY,'BUDGET',IFHBCB,IU)

   IF(TOPICS(TDRN)%DEFINED)THEN
    CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TDRN)%ILAY,'BUDGET',IDRNCB,IU)
   ELSE
    IF(TOPICS(TOLF)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TOLF)%ILAY,'BUDGET',IDRNCB,IU)
   ENDIF
   IF(TOPICS(TRIV)%DEFINED)THEN
    CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TRIV)%ILAY,'BUDGET',IRIVCB,IU)
   ELSE
    IF(TOPICS(TISG)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TISG)%ILAY,'BUDGET',IRIVCB,IU)
   ENDIF
   IF(TOPICS(TGHB)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TGHB)%ILAY,'BUDGET',IGHBCB,IU)
   IF(TOPICS(TWEL)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TWEL)%ILAY,'BUDGET',IWELCB,IU)
   IF(TOPICS(TRCH)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TRCH)%ILAY,'BUDGET',IRCHCB,IU)
   IF(TOPICS(TEVT)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TEVT)%ILAY,'BUDGET',IEVTCB,IU)
   IF(TOPICS(TMNW)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TMNW)%ILAY,'BUDGET',IWL2CB,IU)
   IF(TOPICS(TLAK)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TLAK)%ILAY,'BUDGET',ILAKCB,IU) 
   IF(TOPICS(TSCR)%DEFINED)CALL PMANAGER_SAVEMF2005_OCD_ISAVE(PBMAN%ISAVE(TSCR)%ILAY,'SUBCR',ISCRCB,IU) 
   
  ENDDO
 
 ELSEIF(PBMAN%IFORMAT.EQ.3)THEN
 
 !## write *.ocd file(s)
  N1=1; N2=1
  IF(PBMAN%IPESTP.EQ.1)THEN
   N1=-PBMAN%NLAMBDASEARCH; N2=SIZE(PEST%PARAM)
  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
  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
   LINE='SAVE '//TRIM(SWHAT)//' '//TRIM(ITOS(ID)); DO I=1,PRJNLAY; LINE=TRIM(LINE)//' '//TRIM(ITOS(I)); ENDDO
  ELSE
   LINE='SAVE '//TRIM(SWHAT)//' '//TRIM(ITOS(ID)); DO I=1,SIZE(ISAVE); LINE=TRIM(LINE)//' '//TRIM(ITOS(ISAVE(I))); ENDDO
  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(.NOT.TOPICS(TPCG)%DEFINED)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_IMS(DIRMNAME)
 !####====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: DIRMNAME
 INTEGER :: IU

 PMANAGER_SAVEMF2005_IMS=.TRUE.; IF(PBMAN%IFORMAT.EQ.2)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'
! WRITE(IU,'(A)') ' COMPLEXITY '//TRIM(PBMAN%TCOMPLEX) !MODERATE'  !## simple complex
 IF(TOPICS(TANI)%IACT_MODEL.EQ.1)THEN
  WRITE(IU,'(A)') ' COMPLEXITY COMPLEX'  !## complex
 ELSE
  WRITE(IU,'(A)') ' COMPLEXITY MODERATE' !## moderate
 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
! 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

 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)
 WRITE(IU,'(A)') 'END'

 CLOSE(IU)
 
 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
 INTEGER :: I,J,NIDF
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: NODATA
 CHARACTER(LEN=256) :: FFNAME,DIRMSP,FNNAME

 PMANAGER_SAVEMF2005_MSP=.TRUE.
 
 IF(.NOT.TOPICS(TCAP)%DEFINED)RETURN
 
 PMANAGER_SAVEMF2005_MSP=.FALSE.

 IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Writing MetaSwap files ...')
 IF(IBATCH.EQ.1)WRITE(*,'(/1X,A)') 'Writing MetaSwap files ...'
  
 NIDF=22; ALLOCATE(NODATA(NIDF))

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

 DIRMSP=DIR(:INDEX(DIR,'\',.TRUE.)-1)
 IF(PBMAN%IFORMAT.EQ.3)THEN
  !## OPEN USCL_SVAT.INP
  FFNAME=TRIM(DIRMSP)//'\NODENR2SVAT.DXC'; IUNOD=UTL_GETUNIT(); CALL OSD_OPEN(IUNOD,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE') 
  !## OPEN WELLINDEX2SVAT.DXC
  FFNAME=TRIM(DIRMSP)//'\WELLINDEX2SVAT.DXC'; WINDEX_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(WINDEX_MSWP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
  !## OPEN RCHINDEX2SVAT.DXC
  FFNAME=TRIM(DIRMSP)//'\RCHINDEX2SVAT.DXC'; RINDEX_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(RINDEX_MSWP,FILE=FFNAME,STATUS='UNKNOWN',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='UNKNOWN',ACTION='WRITE')
  !## OPEN MSW.RCH6
  FFNAME=TRIM(DIRMSP)//'\MSW.RCH6_'; RMF6_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(RMF6_MSWP,FILE=FFNAME,STATUS='UNKNOWN',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='UNKNOWN',ACTION='WRITE')
 !## OPEN IAREA
 FFNAME=TRIM(DIRMSP)//'\AREA_SVAT.INP'; IAREA=UTL_GETUNIT(); CALL OSD_OPEN(IAREA,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## OPEN ISCAP
 FFNAME=TRIM(DIRMSP)//'\SCAP_SVAT.INP'; ISCAP=UTL_GETUNIT(); CALL OSD_OPEN(ISCAP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## OPEN IGWMP
 FFNAME=TRIM(DIRMSP)//'\MOD2SVAT.INP'; IGWMP=UTL_GETUNIT(); CALL OSD_OPEN(IGWMP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## open MODFLOW dxc file (not for MF6)
 IF(PBMAN%IFORMAT.NE.3)THEN
  FFNAME=TRIM(DIRMNAME)//'.DXC'; IDXC=UTL_GETUNIT(); CALL OSD_OPEN(IDXC,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 ENDIF
 !## OPEN MOD-SIM.TXT
 FFNAME=TRIM(DIRMSP)//'\MOD-SIM.TXT'; IMODSIM=UTL_GETUNIT(); CALL OSD_OPEN(IMODSIM,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## OPEN ISELSVAT
 FFNAME=TRIM(DIRMSP)//'\SEL_SVAT_BDA.INP'; ISELSVAT=UTL_GETUNIT(); CALL OSD_OPEN(ISELSVAT,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## OPEN INFI_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\INFI_SVAT.INP'; IINFI=UTL_GETUNIT(); OPEN(IINFI,FILE=FFNAME,STATUS='UNKNOWN',CARRIAGECONTROL='LIST',ACTION='WRITE')
 !## OPEN IDF_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\IDF_SVAT.INP'; IIDF=UTL_GETUNIT(); CALL OSD_OPEN(IIDF,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 !## OPEN USCL_SVAT.INP
 FFNAME=TRIM(DIRMSP)//'\USCL_SVAT.INP'; IUSCL=UTL_GETUNIT(); CALL OSD_OPEN(IUSCL,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 IF(PBMAN%DMMFILE.EQ.1)THEN
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=TRIM(DIRMSP)//'\DFM2DWATLEVTOMSW_H.DMM'; IDFM_MSWP=UTL_GETUNIT(); CALL OSD_OPEN(IDFM_MSWP,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=TRIM(DIRMSP)//'\MSWPONDINGTODFM2D_DV.DMM'; IMSWP_PDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_PDFM,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=TRIM(DIRMSP)//'\MSWSPRINKTODFM1D_Q.DMM'; IMSWP_SDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_SDFM,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
  !## OPEN DFM2DTOMSW_WL.DMM
  FFNAME=TRIM(DIRMSP)//'\MSWRUNOFFTODFM1D_Q.DMM'; IMSWP_RDFM=UTL_GETUNIT(); CALL OSD_OPEN(IMSWP_RDFM,FILE=FFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 ENDIF

!d:\IMOD-LUMBRICUS\lumbricustests\t-model\MswSprinkToDfm1D_Q.dmm
!d:\IMOD-LUMBRICUS\lumbricustests\t-model\MswRunoffToDfm1D_Q.dmm
  
 !## 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
  
  SELECT CASE (ISYS)
   !## bnd
   CASE (1);          NODATA(ISYS)=-999.99D0; SCL_U=1; SCL_D=0
   !## lgn,root,soil,meteo
   CASE (2:5,7:9);    NODATA(ISYS)=-999.99D0; SCL_U=7; SCL_D=0
   !## surf,ponding,ponding,pwtlevel
   CASE (6,12,13,20); 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 !6; SCL_D=0
   !## runoff,runoff,runon,runon
   CASE (14:17);      NODATA(ISYS)=-999.99D0; SCL_U=7; SCL_D=0 !6; SCL_D=0
   !## wetted area/urban area
   CASE (10,11);      NODATA(ISYS)=-999.99D0; SCL_U=5; SCL_D=0
  END SELECT

  !## read in data
  IF(.NOT.PMANAGER_SAVEMF2005_MOD_READ(PRJIDF,ITOPIC,ISYS,SCL_D,SCL_U,IINV,IPRT))RETURN

  SELECT CASE (ISYS)
   CASE (1);  SIMGRO%IBOUND=INT(PRJIDF%X)
   CASE (2);  SIMGRO%LGN=INT(PRJIDF%X)
   CASE (3);  SIMGRO%RZ=PRJIDF%X
   CASE (4);  SIMGRO%BODEM=INT(PRJIDF%X)
   CASE (5);  SIMGRO%METEO=INT(PRJIDF%X)
   CASE (6);  SIMGRO%MV=PRJIDF%X
   CASE (7);  SIMGRO%BEREGEN=INT(PRJIDF%X)
   CASE (8);  SIMGRO%BER_LAAG=INT(PRJIDF%X)
   CASE (9);  SIMGRO%BEREGEN_Q=PRJIDF%X
   CASE (10); SIMGRO%NOPP=PRJIDF%X
   CASE (11); SIMGRO%SOPP=PRJIDF%X
   CASE (12); SIMGRO%VXMU_SOPP=PRJIDF%X 
   CASE (13); SIMGRO%VXMU_ROPP=PRJIDF%X 
   CASE (14); SIMGRO%CRUNOFF_SOPP=PRJIDF%X
   CASE (15); SIMGRO%CRUNOFF_ROPP=PRJIDF%X
   CASE (16); SIMGRO%CRUNON_SOPP=PRJIDF%X
   CASE (17); SIMGRO%CRUNON_ROPP=PRJIDF%X
   CASE (18); SIMGRO%QINFBASIC_SOPP=PRJIDF%X
   CASE (19); SIMGRO%QINFBASIC_ROPP=PRJIDF%X
   CASE (20); SIMGRO%PWT_LEVEL=PRJIDF%X
   CASE (21); SIMGRO%MOISTURE=PRJIDF%X
   CASE (22); SIMGRO%COND=PRJIDF%X
  END SELECT

 ENDDO

 IF(.NOT.TOPICS(TPWT)%DEFINED)SIMGRO%PWT_LEVEL=NODATA(20) 
 
 !## check input parameters
 CALL PMANAGER_SAVEMF2005_MSP_CHECK(NODATA) 
  
 ISYS=8
 CALL PMANAGER_SAVEMF2005_MSP_INPFILES(NODATA(20),TOPICS(ITOPIC)%STRESS(IPER)%FILES(ISYS,ILAY)%FNAME,TOPICS(TPWT)%DEFINED,DIRMSP) 
   
 !## 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
 REAL(KIND=DP_KIND) :: X1,Y1,TINY
 CHARACTER(LEN=256) :: S,S1,S2,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')
 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)WRITE(JU,'(A)') TRIM(LINE)
 ENDDO

 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)

 CLOSE(JU)

 END SUBROUTINE PMANAGER_SAVEMF2005_MSP_PARASIM
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MSP_INPFILES(NODATA_PWT,IPFFILE,LPWT,DIRMSP) 
 !###====================================================================
 IMPLICIT NONE
 LOGICAL :: LPWT
 REAL(KIND=DP_KIND),INTENT(IN) :: NODATA_PWT
 CHARACTER(LEN=*),INTENT(IN) :: IPFFILE,DIRMSP
 CHARACTER(LEN=256) :: DIR
 INTEGER,PARAMETER :: AEND=0 !## no surfacewater units
 INTEGER :: NUND,MDND,IROW,ICOL,LYBE,TYBE,BEREGENID,JROW,JCOL,N,M,I,J,JU,IC1,IC2,IR1,IR2,IOS,INEAREST
 REAL(KIND=DP_KIND) :: XC,YC,ARND,QBER,FLBE,TINY
 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
 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: DXCID

 IF (ALLOCATED(DXCID)) DEALLOCATE(DXCID)
 ALLOCATE(DXCID(PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY))
 DXCID = 0
 NDXC = 0
 
 IF(PBMAN%IARMWP.EQ.1)THEN
  JU=UTL_GETUNIT(); MDND=0
  DO J=1,2
   CALL OSD_OPEN(JU,FILE=IPFFILE,ACTION='READ',STATUS='OLD') 
   READ(JU,*) N; READ(JU,*) M
   IF(M.LT.5)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(IPF(MDND)); IPF%ILAY=0; IPF%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; IPF(NUND)%X=XC; IPF(NUND)%Y=YC; IPF(NUND)%ILAY=LYBE; IPF(NUND)%CAP=QBER; ENDIF   
   ENDDO
   CLOSE(JU)
  ENDDO
 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
 
 !## get window of interest
 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)
 
 IF(PBMAN%DMMFILE.EQ.1)THEN
  DIR=DIRMSP(:INDEX(DIRMSP,'\',.TRUE.)-1)//'\MODELINPUT'
  CALL PMANAGER_SAVEMF2005_READ_DFFMPOINTS(DIR)
  WRITE(IDFM_MSWP,'(4A15)')  'SVAT','FM-X','FM-Y','WEIGHT'
  WRITE(IMSWP_PDFM,'(3A15)') 'FM-X','FM-Y','SVAT'
  WRITE(IMSWP_RDFM,'(3A15)') 'FM-X','FM-Y','SVAT'
  WRITE(IMSWP_SDFM,'(3A15)') 'FM-X','FM-Y','SVAT'
  !## read afwatidf 
  IF(PBMAN%AFWATIDF%FNAME.NE.'')THEN
   CALL IDFCOPY(BND(1),PBMAN%AFWATIDF)
   IF(.NOT.IDFREADSCALE(PBMAN%AFWATIDF%FNAME,PBMAN%AFWATIDF,7,0,0.0D0,0))THEN
    WRITE(*,'(/1X,A/)') 'CANNOT READ '//TRIM(PBMAN%AFWATIDF%FNAME); STOP
   ENDIF
  ENDIF
 ENDIF
 
 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
   
    MDND=(IROW-1)*PRJIDF%NCOL+ICOL
    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)

     !## write idf_svat.inp - inside area of interest
     IF(ICOL.GE.IC1.AND.ICOL.LE.IC2.AND.IROW.GE.IR1.AND.IROW.LE.IR2)THEN
      IF(IACT.EQ.2)WRITE(IIDF,'(3I10,2F15.3)') NUND,IROW-IR1+1,ICOL-IC1+1,XC,YC
     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
       !## coupling for ponding
       WRITE(IMSWP_PDFM,'(2F15.3,I15)') XC,YC,NUND
       !## coupling for runoff - nearest DFMFM-point in same afwat-unit
       INEAREST=PMANAGER_SAVEMF2005_MSP_INPFILES_GETXY(XC,YC,.TRUE.)
       IF(INEAREST.GT.0)WRITE(IMSWP_RDFM,'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NUND
      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,1,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)')  1,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 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(IPF))THEN
       QBER=IPF(BEREGENID)%CAP
       LYBE=IPF(BEREGENID)%ILAY
       TYBE=1 !## groundwater
       CALL IDFIROWICOL(PRJIDF,JROW,JCOL,IPF(BEREGENID)%X,IPF(BEREGENID)%Y)
      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
    
      !## sprinkling from other than modellayer 1 or other location
      IF(TYBE.EQ.1.AND.LYBE.GT.1)THEN
 
       !## add couple location modflow
       CALL STOREDXC(DXCID,PRJIDF%NCOL,PRJIDF%NROW,PRJNLAY,LYBE,JROW,JCOL,UNID,IACT)
 
       IF(IACT.EQ.2)THEN
        WRITE(IGWMP,'(I10,2X,I10,I5)')   UNID,NUND,LYBE
        WRITE(IMODSIM,'(I10,2X,I10,I5)') UNID,NUND,LYBE
        IF(PBMAN%IFORMAT.EQ.3)THEN
         NWEL=NWEL+1
         WRITE(WMF6_MSWP,'(3I10,F10.2)')  LYBE,JROW,JCOL,0.0D0
         !## search for correct layer, if this one is removed due to zero thickness
         IF(BND(LYBE)%X(JCOL,JROW).EQ.0)THEN
          !## skip permeability < 0.1
          DO LYBE=1,PRJNLAY
           IF(BND(LYBE)%X(JCOL,JROW).NE.0.0D0.AND.KHV(LYBE)%X(JCOL,JROW).GT.0.1D0)EXIT
          ENDDO
         ENDIF
         WRITE(WINDEX_MSWP,'(3I10)')  NWEL,NUND,LYBE
        ENDIF
        
       ENDIF
      
      ENDIF 
     ENDIF

     !## END scap_svat.inp - grondwater + ow

     !## BEGIN mod2svat.inp; NB: als opp. water of glas dan laag = 0
    
     IF(.NOT.LPWT)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_PWT)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 - inside area of interest
     IF(ICOL.GE.IC1.AND.ICOL.LE.IC2.AND.IROW.GE.IR1.AND.IROW.LE.IR2) THEN
      IF(IACT.EQ.2)WRITE(IIDF,'(3I10,2F15.3)') NUND,IROW-IR1+1,ICOL-IC1+1,XC,YC
     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
       WRITE(IMSWP_PDFM,'(2F15.3,I15)') XC,YC,NUND
       !## coupling for runoff - nearest DFMFM-point discarding afwatunit
       INEAREST=PMANAGER_SAVEMF2005_MSP_INPFILES_GETXY(XC,YC,.FALSE.)
       IF(INEAREST.GT.0)WRITE(IMSWP_SDFM,'(2F15.3,I15)') DFFM(INEAREST)%X,DFFM(INEAREST)%Y,NUND       
      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,1,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)')  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(.NOT.LPWT)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_PWT)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

 !## 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 1'
  WRITE(RMF6_MSWP,'(A)') 'END PERIOD 1'
 ENDIF
 
 IF(PBMAN%IARMWP.EQ.1)DEALLOCATE(IPF)
 
 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(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(PBMAN%DMMFILE.EQ.1)THEN
  IF(IDFM_MSWP.GT.0)CLOSE(IDFM_MSWP)
  IF(IMSWP_PDFM.GT.0)CLOSE(IMSWP_PDFM)
  IF(IMSWP_SDFM.GT.0)CLOSE(IMSWP_SDFM)
  IF(IMSWP_RDFM.GT.0)CLOSE(IMSWP_RDFM)
  !## 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
  ENDIF
!  CALL DESTROY_TREE(TREE)
!  CALL UTL_MF2005_MAXNO(TRIM(DIRMSP)//'\DFM2DTOMSW_WL.DMM_',(/NUND/))
!  CALL UTL_MF2005_MAXNO(TRIM(DIRMSP)//'\MSWTODFM2D_DPV.DMM_',(/NUND/))
 ENDIF

 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_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)//'\RIV7\DFLOWFM_POINTS.DAT',EXIST=LEX)
 IF(LEX)THEN
  CALL OSD_OPEN(JU,FILE=TRIM(DIR)//'\RIV7\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
 
! 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_MSP_INPFILES_GETXY(XC,YC,LZONE)
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 LOGICAL,INTENT(IN) :: LZONE
 INTEGER :: I,II,J,N,IZONE,ICOL,IROW,DRC,JROW,JCOL
 REAL(KIND=DP_KIND) :: D,TD
 LOGICAL :: LEX
 INTEGER,DIMENSION(1) :: INDEXES
 REAL(KIND=DP_KIND),DIMENSION(1) :: DISTANCES
 
 PMANAGER_SAVEMF2005_MSP_INPFILES_GETXY=0
 
 !## get zone  number for dfflow-fm node
 IZONE=0; IF(PBMAN%AFWATIDF%FNAME.NE.''.AND.LZONE)THEN
  CALL IDFIROWICOL(PBMAN%AFWATIDF,IROW,ICOL,XC,YC)
  IZONE=PBMAN%AFWATIDF%X(ICOL,IROW)
 ENDIF

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

 TD=HUGE(1.0); J=0; DRC=0; DO
  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
     LEX=.TRUE.; IF(IZONE.NE.0)THEN
      IF(IZONE.NE.DFFM(I)%IZONE)LEX=.FALSE.
     ENDIF
     IF(LEX)THEN
      I=DFFMGRID(JCOL,JROW)%ID(II)
      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
 
 PMANAGER_SAVEMF2005_MSP_INPFILES_GETXY=J
 
 END FUNCTION PMANAGER_SAVEMF2005_MSP_INPFILES_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
   IF(BND(1)%X(ICOL,IROW).NE.0)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 :: LUNCB,ICOL,IROW,ILAY,ID

 LUNCB=0
               
 WRITE(IDXC,'(2I10)') NDXC,LUNCB
 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(NDFLOWFM))
 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 
 
 !###====================================================================
 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
 
 !###====================================================================
 SUBROUTINE PMANAGER_SAVEMF2005_MSP_CHECK(NODATA) 
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:),INTENT(IN) :: NODATA
 INTEGER,DIMENSION(:),ALLOCATABLE :: IERROR
 INTEGER :: IROW,ICOL,STRLEN
 REAL(KIND=DP_KIND) :: DXY,ARND
 CHARACTER(LEN=:),ALLOCATABLE :: STR

 !## inactivate constant head boundaries and inactive nodes
 DO IROW=1,PRJIDF%NROW; DO ICOL=1,PRJIDF%NCOL
  IF(BND(1)%X(ICOL,IROW).LE.0.0D0)SIMGRO(ICOL,IROW)%IBOUND=0
 ENDDO; ENDDO
 
! !## skip corners irt anisotropy package
! SIMGRO(1       ,1             )%IBOUND=0
! SIMGRO(1       ,PRJIDF%NROW   )%IBOUND=0
! SIMGRO(PRJIDF%NCOL,1          )%IBOUND=0
! SIMGRO(PRJIDF%NCOL,PRJIDF%NROW)%IBOUND=0
 
 !## 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(22)); 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)%DEFINED)THEN
!    IF(SIMGRO(ICOL,IROW)%PWT_LEVEL.EQ.NODATA(20))  IERROR(20)=IERROR(20)+1 <--- nodata is niet erg, is er geen PWT aanwezig
   ENDIF
   IF(SIMGRO(ICOL,IROW)%MOISTURE.EQ.NODATA(21))      IERROR(21)=IERROR(21)+1
   IF(SIMGRO(ICOL,IROW)%COND.EQ.NODATA(22))          IERROR(22)=IERROR(22)+1
  ENDIF
 ENDDO; ENDDO

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

 !## change surface water into gras; change urban into gras
 DO IROW=1,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%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)
 
 END SUBROUTINE 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
 INTEGER :: I,J,IPER
 LOGICAL :: LEX
 TYPE DFFMOBJ
  INTEGER :: ID
  REAL(KIND=DP_KIND) :: X,Y
 END TYPE DFFMOBJ
 TYPE(DFFMOBJ),ALLOCATABLE,DIMENSION(:) :: DFFM
 
 PMANAGER_SAVEMF2005_COMBINE=.FALSE.

 IF(PCK(1).EQ.'ISG')THEN
  NDFLOWFM=0
 
  !## create coupling table
  IF(PBMAN%DMMFILE.EQ.1)THEN
   !## read dflow-elements
   LINE=TRIM(DIR)//'\MODELINPUT\ISG7\MFRIVTODFM1D_Q.DMM'
   IU(1)=UTL_GETUNIT(); CALL OSD_OPEN(IU(1),FILE=LINE,STATUS='OLD',ACTION='READ')
   READ(IU(1),*) N
   ALLOCATE(DFFM(N))
   DO I=1,N
    !## read x,y of dflow-fm and id of river element assigned to it
    READ(IU(1),*) DFFM(I)%X,DFFM(I)%Y,DFFM(I)%ID
   ENDDO
   CLOSE(IU(1))
   !## for river en drain
   LINE=TRIM(DIR)//'\MODELINPUT\RIV7\MFRIVTODFM1D_Q.DMM'
   LINE=TRIM(DIR)//'\MODELINPUT\DRN7\MFDRNTODFM1D_Q.DMM'
   IU(4)=UTL_GETUNIT(); CALL OSD_OPEN(IU(4),FILE=LINE,STATUS='OLD',ACTION='WRITE')
  ENDIF
 ENDIF
 
 !## read from files (if existing)
 IU=0
 DO I=1,SIZE(PCK)
  LINE=TRIM(DIRNAME)//'.'//TRIM(PCK(I))//'7'
  IF(I.LE.2)THEN
   IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='OLD',ACTION='READ')
  ELSE
   !## write to file
   IU(I)=UTL_GETUNIT(); CALL OSD_OPEN(IU(I),FILE=LINE,STATUS='UNKNOWN',ACTION='WRITE')
  ENDIF
 ENDDO
 IF(MINVAL(IU).EQ.0)RETURN

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

  FNAME=''

  !## 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
  
  LINE=TRIM(ITOS(SUM(NO)))
  WRITE(IU(3),'(A)') TRIM(LINE)
  IF(PCK(1).EQ.'ISG'.AND.PBMAN%DMMFILE.EQ.1)THEN
!   IF(NDFLOWFM.EQ.0)THEN
   NDFLOWFM=MAX(NDFLOWFM,SUM(NO))
!   ELSEIF(NDFLOWFM.NE.SUM(NO))THEN
!    STOP 'DFLOWFM IS NOT EQUAL TO ALL STRESS-PERIODS WHICH SHOULD BE'
!   ENDIF
  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
  FNAME(3)=TRIM(DIR)//'\'//  TRIM(PCK(2))//'7\'//TRIM(PCK(2))//'_T'//TRIM(ITOS(IPER))//'.ARR'
  FNAME(3)=UTL_CAP(FNAME(3),'U')

  !## append to existing file, create new file otherwise
  JU(3)=UTL_GETUNIT()
  IF(FNAME(3).EQ.FNAME(2))THEN; FNAME(3)=TRIM(FNAME(3))//'_'; ENDIF
  CALL OSD_OPEN(JU(3),FILE=FNAME(3),STATUS='UNKNOWN',ACTION='WRITE')

  IF(JU(1).GT.0)THEN; DO I=1,NO(1); READ(JU(1),'(A256)') LINE; WRITE(JU(3),'(A)') TRIM(LINE); ENDDO; CLOSE(JU(1)); ENDIF
  IF(JU(2).GT.0)THEN; DO I=1,NO(2); READ(JU(2),'(A256)') LINE; WRITE(JU(3),'(A)') TRIM(LINE); ENDDO; CLOSE(JU(2)); ENDIF

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

  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
  
  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'
    
  DO I=1,2; NO_PREV(I)=NO(I); FNAME_PREV(I)=FNAME(I); ENDDO

 ENDDO
 
 CLOSE(IU(1),STATUS='DELETE'); CLOSE(IU(2),STATUS='DELETE'); CLOSE(IU(3))
 
 !## rename file
 FNAME(1)=TRIM(DIRNAME)//'.'//TRIM(PCK(3))//'7'
 FNAME(2)=TRIM(DIRNAME)//'.'//TRIM(PCK(2))//'7'
 CALL IOSRENAMEFILE(FNAME(1),FNAME(2))
  
 PMANAGER_SAVEMF2005_COMBINE=.TRUE.

 END FUNCTION PMANAGER_SAVEMF2005_COMBINE

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

 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.0D0 (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
 
 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)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITOPIC,IU,IPRT,IBATCH
 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(1)%FILES,2)
   
  IPC=INT(0,1)
   
  ICNST    =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ICNST
  CNST     =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%CNST
  ILAY     =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%ILAY
  FCT      =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FCT
  IMP      =TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%IMP
  IDF%FNAME=TOPICS(ITOPIC)%STRESS(1)%FILES(1,ISYS)%FNAME

  IF(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.'
   EXIT
  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(1)%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)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)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(.NOT.TOPICS(TLAK)%DEFINED)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)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),DIMENSION(:,:) :: ISIZE
 INTEGER :: IROW,ICOL,NN,NE,NS,NW,ILAY,I,J,ISUB
 
 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)))
    !## 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 mf2005
  IF(PBMAN%IFORMAT.NE.3)THEN
   !## replace ibound for boundaries
   DO IROW=1,BND(ILAY)%NROW
!    IF(ISIZE(1,ILAY).EQ.1)THEN; ICOL=1;              IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NW=NW+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
!    IF(ISIZE(3,ILAY).EQ.1)THEN; ICOL=BND(ILAY)%NCOL; IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NE=NE+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
    IF(IFULL(1).EQ.1)THEN; ICOL=1;              IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NW=NW+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
    IF(IFULL(3).EQ.1)THEN; ICOL=BND(ILAY)%NCOL; IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NE=NE+1; BND(ILAY)%X(ICOL,IROW)=-1; 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; NN=NN+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
!    IF(ISIZE(2,ILAY).EQ.1)THEN; IROW=BND(ILAY)%NROW; IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NS=NS+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
    IF(IFULL(4).EQ.1)THEN; IROW=1;              IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NN=NN+1; BND(ILAY)%X(ICOL,IROW)=-1; ENDIF; ENDIF
    IF(IFULL(2).EQ.1)THEN; IROW=BND(ILAY)%NROW; IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN; NS=NS+1; BND(ILAY)%X(ICOL,IROW)=-1; 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

 !## turn off isolated cells (constant heads)
 ILAY=0; DO I=1,SIZE(PBMAN%ILAY)
  IF(PBMAN%ILAY(I).EQ.0)CYCLE; ILAY=ILAY+1

  DO IROW=1,BND(ILAY)%NROW
   DO ICOL=1,BND(ILAY)%NCOL
    !## check if constant head connected to active node
    IF(BND(ILAY)%X(ICOL,IROW).LT.0)THEN
     !## inactive unless proves otherwise
     J=0
     IF(ILAY.GT.1)THEN;              IF(BND(ILAY-1)%X(ICOL  ,IROW  ).GT.0)J=-1; ENDIF
     IF(ILAY.LT.PRJNLAY)THEN;        IF(BND(ILAY+1)%X(ICOL  ,IROW  ).GT.0)J=-1; ENDIF
     IF(ICOL.GT.1)THEN;              IF(BND(ILAY  )%X(ICOL-1,IROW  ).GT.0)J=-1; ENDIF
     IF(ICOL.LT.BND(ILAY)%NCOL)THEN; IF(BND(ILAY  )%X(ICOL+1,IROW  ).GT.0)J=-1; ENDIF
     IF(IROW.GT.1)THEN;              IF(BND(ILAY  )%X(ICOL  ,IROW-1).GT.0)J=-1; ENDIF
     IF(IROW.LT.BND(ILAY)%NROW)THEN; IF(BND(ILAY  )%X(ICOL  ,IROW+1).GT.0)J=-1; ENDIF
     BND(ILAY)%X(ICOL,IROW)=J
    ENDIF
   ENDDO
  ENDDO
  
 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

   !## blank out inactive cells
   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)THEN
!    IDF%X(ICOL,IROW)=IDF%NODATA
   ELSE
    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
        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