!!  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/>.
!!
!!  Contact: imod.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands.
!!
MODULE MOD_BATCH

USE WINTERACTER
USE RESOURCE
USE MOD_DBL
USE DATEVAR
USE MOD_BATCH_PAR
USE MOD_IDFPLOT
USE MOD_OSD, ONLY : OSD_GETARG,OSD_GETNARG,OSD_OPEN
USE MOD_UTL,ONLY : UTL_CAP,UTL_GETUNIT,UTL_READINITFILE,ITOS,RTOS,UTL_IDATETOJDATE,UTL_DIRINFO,UTL_CREATEDIR, &
  UTL_SUBST,UTL_DIRINFO_POINTER,UTL_IDFGETDATE,UTL_FIT_REGRESSION,UTL_IDFSNAPTOGRID,UTL_READARRAY, &
  UTL_GETUNIQUE,UTL_GETIDPROC,UTL_WSELECTFILE,PROCOBJ,UTL_GDATE,NV,NL,UTL_GENLABELSREAD,UTL_IMODVERSION, &
  IDATETOGDATE,VAR,UTL_IDFSNAPTOGRID_LLC,UTL_EQUALS_REAL,UTL_IMODFILLMENU,UTL_READPOINTER,UTL_READPOINTER_REAL, &
  UTL_MINTHICKNESS,UTL_GETHELP,UTL_STDEF,UTL_GETGAMMA
USE MODPLOT, ONLY : MPW,MP,MXMPLOT
USE IMODVAR, ONLY : DP_KIND,SP_KIND,IBACKSLASH,ILABELNAME,EXENAME,LBETA
USE MOD_PREF, ONLY : PREFCOLOURSINIT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_IDF, ONLY : IDFREAD,IDFNULLIFY,IDFWRITE,IDFDEALLOCATE,IDFREADSCALE,IDFCOPY,IDFGETXYVAL,IDFIROWICOL, &
  IDFGETLOC,IDFGETVAL,IDFEQUAL,IDF_EXTENT,IDFALLOCATEX,IDFDEALLOCATEX,IDFFILLSXSY
USE MOD_LEGEND, ONLY : LEG_INIT
USE MOD_MANAGER_UTL
USE MOD_LEGPLOT, ONLY : LEGPLOT_PLOT
USE IMODVAR, ONLY : DP_KIND,SP_KIND,BVERSION
USE MOD_POLYGON_PAR
USE MOD_POLYGON_UTL, ONLY : POLYGON1INIT,POLYGON1CLOSE
USE MOD_COLOURS
USE MOD_SOBEK, ONLY : SOBEK1CALC,DFLOWFM1CALC
USE MOD_IPF, ONLY : IPFSAMPLE,IPFDEALLOCATE,IPFREAD2,IPFSPOTIFY,IPFASSIGNWELL,IPFEVALUATE
USE MOD_PLINES_TRACE, ONLY : TRACEMAIN,TRACEPOSTPROCESSING,TRACECONVERTTOGEN,TRACEDEALLOCATE,TRACE_INIT_SP,TRACE_AL_SP,TRACE_BRING_IN_DATA
USE MOD_PLINES_PAR, ONLY : SPFNAME,NSPFNAME,SP,ISPFNAME
USE MOD_PLINES_SP, ONLY : TRACEPREPARESP,TRACEREADSP
USE MOD_TSTAT, ONLY : TSTATRESIDUAL
USE MOD_GENPLOT, ONLY : GEN_INIT
USE MOD_GXG_CLC, ONLY : GXG1_COMPUTEGXG,GXG1_ABORT,GXG_COMPUTE_SERIE
USE MOD_ASC2IDF
USE MOD_INFO, ONLY : INFOSTAT
USE MOD_AHNFILTER, ONLY : AHNFILTER_MAIN
USE MOD_MATH_CALC, ONLY :  MATH1CALC ,MATH1CALCCLOSE,MATH1_PWTCOUNT,MATH1GETFUNC
USE MOD_MATH_SCALE, ONLY : MATH1SCALE,MATH1SCALECLOSE
USE MOD_MATH_MERGE, ONLY : MATH1MERGE,MATH1MERGECLOSE
USE MOD_MEAN_CLC, ONLY : MEAN1COMPUTE,MEAN1ABORT
USE MOD_IMPORT_CALC, ONLY : IMPORT_CALC,IMPORT_MF2005_MAIN
USE MOD_MODEL, ONLY : MODEL1COPYRUNFILE
USE MOD_WBAL_CLC, ONLY : WBALCOMPUTE,WBALABORT
USE MOD_WBAL_ANALYSE, ONLY : WBAL_ANALYSE_INIT,WBAL_ANALYSE_PLOT
USE MOD_WBAL_UTL, ONLY : WBAL_ANALYSE_READCONFIG
USE MOD_ISG_ADJ, ONLY : ISGADJUSTAPPLY
USE MOD_ISG_GRID, ONLY : ISG_SIMPLIFYMAIN,ISG_ADDCROSSSECTION,ISG2GRIDMAIN,ISG_ADDSTAGES,ISG_EXPORT,ISG_IMPORT
USE MOD_ISG_STRUCTURES, ONLY : ISG_ADDSTRUCTURES
USE MOD_ISG_UTL, ONLY : ISGSAVE,ISGDEAL,ISGREAD
USE MOD_ISG_PAR, ONLY : NISG,ISG,ISD,DATISD,ISFR
USE MOD_DINO_IPF, ONLY : IMOD_DINO_MAIN,IMOD_DINO_DEALLOCATE
USE MOD_TS_CLC, ONLY : TS1COMPUTE,TS_END
USE MOD_SOLID, ONLY : SOLID_NEWMASKS,SOLID_CALC_KDC,SOLID_CALC_KDC_DEALLOCATE,SOLID_INITSLDPOINTER,SOLID_INITSLD, &
    SOLID_WVP,SOLID_GEOTOP,SOLID_GEOTOP_DEALLOCATE
USE MOD_SOLID_PCG, ONLY : SOLID_CALC_HYPO,SOLID_TRACE_3D
USE MOD_SOF, ONLY : SOF_MAIN,SOF_TRACE,SOF_CATCHMENTS,SOF_EXPORT
USE MOD_CUS, ONLY : CUS_MAIN,CUS_DEALLOCATE
USE MOD_CREATEIZONE, ONLY : CREATEIZONE_MAIN
USE MOD_GEF2IPF, ONLY : GEF2IPF_MAIN
USE MOD_UTM, ONLY : UTM_IDF2LATLONG
USE MOD_TB_READCONF, ONLY : TB_MAIN
USE MOD_ABOUT, ONLY : IMOD_AGREEMENT
USE MOD_PMANAGER, ONLY : PMANAGERPRJ,PMANAGERRUN,PMANAGER_UTL_INIT,PMANAGER_SAVEMF2005_HFB_GENFILES,PMANAGER_LOADPRJ,PMANAGER_GETFNAMES
USE MOD_PMANAGER_UTL, ONLY : PMANAGER_SAVEMF2005_MOD_READ
USE MOD_PMANAGER_PAR, ONLY : PBMAN,PEST,PRJILIST,FNAMES,TKHV,TKDW,TKVV,TVCW,TRIV,TDRN,TRCH
USE MOD_BATCH_UTL, ONLY : IMODBATCH_RUNFILE_READ,IMODBATCH_CREATEENSEMBLES_CHOLESKY
USE MOD_PMANAGER_MF6NETWORK, ONLY : PMANAGER_GENERATEMFNETWORKS,PMANAGER_GENERATEMFNETWORKS_WRITEXY
USE MOD_IPFANALYSE, ONLY : IPFANALYSE_INIT_GRAPHVARIABLES
USE MOD_DEVWEL, ONLY : DEVWELL_IMPORT
USE MOD_STOMP_PAR
USE MOD_STOMP, ONLY : STOMP_INIT,STOMP_READ,STOMP_CLOSE,STOMP_SAVEINPUT
USE MOD_MAIN
USE MOD_IPFASSFILE, ONLY : IPFOPENASSFILE,IPFREADASSFILELABEL,IPFREADASSFILE,IPFDRAWITOPIC2_ICLR, &
            IPFINITASSFILE
USE MOD_IPFASSFILE_UTL
USE MOD_IPF_PAR, ONLY : ASSF,IPF,NIPF
USE MOD_IPF, ONLY : IPFINIT,IPFREAD,IPFDEALLOCATE,IPFALLOCATE,IPFWRITE
USE MOD_IFF_PAR 
USE MOD_MSPNETRCH, ONLY : MSPNETRCHCOMPUTE
USE MOD_AGGREGATE
USE MOD_LUDCMP, ONLY : LUDCMP_GETLU 
INTEGER,PARAMETER,PRIVATE :: MAXFUNC=90
CHARACTER(LEN=50),DIMENSION(MAXFUNC),PRIVATE :: CFUNC
CHARACTER(LEN=50),DIMENSION(:),ALLOCATABLE,PRIVATE :: CKEY
CHARACTER(LEN=3*256),PRIVATE :: LINE
CHARACTER(LEN=256),PRIVATE :: ARGSTRING
INTEGER,PRIVATE :: NKEY,IU,IFN
CHARACTER(LEN=256),PRIVATE,DIMENSION(4) :: FIG
TYPE PARAMOBJ
 INTEGER :: ILS,IZONE,IGROUP
 CHARACTER(LEN=15) :: ACRONYM
 CHARACTER(LEN=2) :: PTYPE
END TYPE PARAMOBJ
DATA CFUNC/'PLOT','GXG','AHNFILTER','IDFSCALE','IDFCALC','IDFMERGE','CREATEIDF','IMPORTMODFLOW',&
  'IDFSTAT','IPFSTAT','MODELCOPY','IMODPATH','IPFSAMPLE','XYZTOIDF','IMPORTSOBEK','MKWELLIPF', &
  'IDFMEAN','WBALANCE','ISGADJUST','DINO2IPF','CREATELAYERS','IDFTIMESERIE','BMPTILING','IPFRESIDUAL', &
  'SOLID','GEN2ISG','IDFINSERT','CREATESOF','ISGSIMPLIFY','ISGADDCROSSSECTION','CREATEASC', &
  'RESAMPLELAYERS','WVP','CUS','GEOTOP','ISGADDSTRUCTURES','PWTCOUNT','IDFCONSISTENCY','GEN2GEN3D', &
  'CREATEIBOUND','CREATESUBMODEL','CREATEEVT','DRNSURF','ISGGRID','IPFSPOTIFY','ASSIGNWELL', &
  'CREATEIZONE','GEF2IPF','UTM2LATLONG','ISGADDSTAGES','VOLUME','TESTBANK','ISGEXPORT', &
  'CLIPVOXELS','FAULTS3D','RUNFILE','FLUMY','GEOCONNECT','IPFSUM','VOXELVOLUME','PLOTRESIDUAL', &
  'IPF2ISG','SFRTOISG','ISGTOSFR','IDFTRACE','UZFTOCSV','GENSNAPTOGRID','DEVWELLTOIPF', &
  'ADJUSTVOXELIDF','MFTOIMOD','KDC','IMODTOSTOMP','XYZTOVOXEL','REGRESSION','MF6TOIDF','ISGIMPORT', &
  'FOSM','IPFEDIT','MSPNETRCH','MF6NETWORKS','CREATEPILOTPOINTS','IPFEDITWEIGHT','AGGREGATE', &
  'CREATEWELBORELOG','CREATEENSEMBLES','IPFEVALUATE','LAYERFROMTHICKNESS','MODPATH7','IPESTTOPARAM','IFFCROSSSECTION'/

CONTAINS

 !###======================================================================
 LOGICAL FUNCTION IMODBATCH()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IERROR
 INTEGER,DIMENSION(:),ALLOCATABLE :: ITMP1,ITMP2

 IMODBATCH=.FALSE.

 IF(.NOT.IMODBATCH_FUNC())RETURN
 
 !## get username and status and initialise window
 CALL WINDOWOPEN(FLAGS=SYSMENUON+HIDEWINDOW+STATUSBAR)
 ALLOCATE(ITMP1(4),ITMP2(4)); ITMP1=[2000,2000,750,-1]; ITMP2=[1,1,1,1]
 CALL WINDOWSTATUSBARPARTS(4,ITMP1,ITMP2) !(/2000,2000,750,-1/),(/1,1,1,1/))
 DEALLOCATE(ITMP1,ITMP2)
! CALL WINDOWSTATUSBARPARTS(4,(/2000,2000,750,-1/),(/1,1,1,1/))

 !## initialize preferences user FOR IMOD Batch only
 PREFVAL='' !(1)='.\'
 CALL IOSDIRNAME(PREFVAL(1))
 IERROR=0; CALL IMOD_AGREEMENT(IERROR)
 IF(IERROR.NE.1)THEN
  IF(LBETA)THEN 
   CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Cannot start Beta-iMOD because you are not authorized in writing for Beta-iMOD','Error')
  ELSE
   CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Cannot start iMOD unless you accept the iMOD Software License Agreement','Error')
  ENDIF
  CALL WINDOWCLOSE(); STOP
 ENDIF
 CALL WINDOWCLOSE()
 
 !## open Unit for Same Line Printing of echo (is equal to screen or '*')
 OPEN(UNIT=6,CARRIAGECONTROL='fortran')    

 CALL UTL_CREATEDIR(TRIM(PREFVAL(1))//'\tmp')
 !## initialize polygons
 MAXSHAPES=500  
 CALL POLYGON1INIT()

 SELECT CASE (IFN)
  CASE (1) !## plot-function
   CALL IMODBATCH_PLOT_MAIN()
  CASE (2) !## gxg-function
   CALL IMODBATCH_GXG_MAIN()
  CASE (3) !## ahnfilter
   CALL IMODBATCH_AHNFILTER_MAIN()
  CASE (4) !## scale
   CALL IMODBATCH_SCALE_MAIN()
  CASE (5) !## math
   CALL IMODBATCH_CALC_MAIN()
  CASE (6) !## merge
   CALL IMODBATCH_MERGE_MAIN()
  CASE (7) !## createidf
   CALL IMODBATCH_CREATEIDF_MAIN()
  CASE (8) !## importmodflow
   CALL IMODBATCH_IMPORTMODFLOW_MAIN()
  CASE (9) !## idfstat
   CALL IMODBATCH_IDFSTAT_MAIN()
  CASE (10)!## ipfstat
   CALL IMODBATCH_IPFSTAT_MAIN()
  CASE (11)!## model copy
   CALL IMODBATCH_MODELCOPY_MAIN()
  CASE (12)!## imodpath
   CALL IMODBATCH_IMODPATH_MAIN()
  CASE (13)!## idfsample
   IF(IMODBATCH_IPFSAMPLE_MAIN())THEN; ENDIF
  CASE (14)!## xyztoidf
   CALL IMODBATCH_XYZTOIDF_MAIN()
  CASE (15)!## importsobek
   CALL IMODBATCH_IMPORTSOBEK_MAIN()
  CASE (16)!## makewellipf
   CALL IMODBATCH_MKWELLIPF_MAIN()
  CASE (17)!## idfmean
   CALL IMODBATCH_IDFMEAN_MAIN()
  CASE (18)!## wbalance
   CALL IMODBATCH_WBALANCE_MAIN()
  CASE (19)!## wbalance
   CALL IMODBATCH_ISGADJUST_MAIN()
  CASE (20)!## csv2ipf
   CALL IMODBATCH_DINO2IPF_MAIN()
  CASE (21)!## createlayers
   CALL IMODBATCH_CREATELAYERS_MAIN()
  CASE (22)!## idftimeserie
   CALL IMODBATCH_TSERIES()
  CASE (23)!## bitmaptiling
   CALL IMODBATCH_BITMAPTILING()
  CASE (24)!## ipfresidual
   CALL IMODBATCH_IPFRESIDUAL()
  CASE (25)!## solid
   CALL IMODBATCH_SOLID()
  CASE (26)!## gen2isg
   CALL IMODBATCH_GEN2ISG()
  CASE (27)!## idfinsert
   CALL IMODBATCH_IDFINSERT()
  CASE (28)!## createsof
   CALL IMODBATCH_CREATESOF()
  CASE (29)!## simplify isg
   CALL IMODBATCH_ISGSIMPLIFY_MAIN()
  CASE (30)!## add cross-sections
   CALL IMODBATCH_ISGADDCROSSSECTION()
  CASE (31)!## create ASC file from IDF
   CALL IMODBATCH_CREATEASC_MAIN()
  CASE (32)!## resample layers
   CALL IMODBATCH_RESAMPLELAYERS()
  CASE (33)!## wvp
   CALL IMODBATCH_WVP()
  CASE (34)!## cus
   CALL IMODBATCH_CUS()
  CASE (35)!##  geotop
   CALL IMODBATCH_GEOTOP()
  CASE (36) !## add structures
   CALL IMODBATCH_ISGADDSTRUCTURES()
  CASE (37) !## pwtcount
   CALL IMODBATCH_PWTCOUNT()
  CASE (38) !## consistency
   CALL IMODBATCH_IDFCONSISTENCY()
  CASE (39) !## gen2gen3d
   CALL IMODBATCH_IDFGEN2GEN3D()
  CASE (40) !## createibound
   CALL IMODBATCH_CREATEIBOUND()
  CASE (41)
   CALL IMODBATCH_CREATESUBMODELS()
  CASE (42)
   CALL IMODBATCH_CREATEEVT()
  CASE (43)
   CALL IMODBATCH_DRNSURF()
  CASE (44) !## gridding isg-files
   CALL IMODBATCH_ISGGRID()
  CASE (45)
   CALL IMODBATCH_IPFSPOTIFY()
  CASE (46) !## adjust filters such that they position filter is proper geological layer
   CALL IMODBATCH_ASSIGNWELL()
  CASE (47) !## create izones for iPEST
   CALL IMODBATCH_CREATEIZONE()
  CASE (48)!## gef2ipf
   CALL IMODBATCH_GEF2IPF_MAIN()
  CASE (49)!## utm2latlong
   CALL IMODBATCH_UTM2LATLONG_MAIN()
!  CASE (49)!## createvoxel
!   CALL IMODBATCH_CREATEVOXEL_MAIN()
  CASE (50)!## add cross-sections
   CALL IMODBATCH_ISGADDSTAGES()
  CASE (51)!## volume
   CALL IMODBATCH_VOLUME()
  CASE (52)!## testbank
   CALL IMODBATCH_TESTBANK()
  CASE (53)!## export isg
   CALL IMODBATCH_ISGEXPORT()
  CASE (54)!## clip voxels
   CALL IMODBATCH_CLIPVOXELS()
  CASE (55)!## faults to 3d conversion
   CALL IMODBATCH_FAULTS3D()
  CASE (56)!## create runfile
   CALL IMODBATCH_RUNFILE()
  CASE (57)!## make flumy-files
   CALL IMODBATCH_FLUMY()
  CASE (58)!## geoConnect
   CALL IMODBATCH_GEOCONNECT()
  CASE (59) !## summarizes ipf extraction per layer
   CALL IMODBATCH_IPFSUM()
  CASE (60)!## volume 3d
   CALL IMODBATCH_VOXELVOLUME()
  CASE (61) !## plot residual (scatter or histogram)
   CALL IMODBATCH_PLOTRESIDUAL()
  CASE (62) !## ipf2isg
   CALL IMODBATCH_IPF2ISG()
  CASE (63) !## sfrtoisg
   CALL IMODBATCH_SFRTOISG_MAIN()
  CASE (64) !## isgtosfr
   CALL IMODBATCH_ISGTOSFR_MAIN()
  CASE (65) !## idftrace
   CALL IMODBATCH_IDFTRACE_MAIN()
  CASE (66) !## uzftocsv
   CALL IMODBATCH_UZFTOCSV()
  CASE (67) !## gensnaptogrid
   CALL IMODBATCH_GENSNAPTOGRID()
  CASE (68) !## convert csv to ipf for deviated wells
   CALL IMODBATCH_DEVWELLTOIPF()
  CASE (69)
   CALL IMODBATCH_ADJUSTVOXELIDF()
  CASE (70)
   CALL IMODBATCH_MFTOIMOD()
  CASE (71)
   CALL IMODBATCH_KDC()
  CASE (72)
   CALL IMODTOSTOMP()
  CASE (73)
   CALL IMODBATCH_XYZTOVOXEL()
  CASE (74)
   CALL IMODBATCH_REGRESSIONTXT()
  CASE (75)
   CALL IMODBATCH_MF6TOIDF()
  CASE (76)
   CALL IMODBATCH_ISGIMPORT()
  CASE (77)
   CALL IMODBATCH_FOSM()
  CASE (78)
   CALL IMODBATCH_IPFEDIT()
  CASE (79)  !## Calculate net recharge based on MetaSwap modelresults
   CALL IMODBATCH_MSPNETRCH()
  CASE (80)  !## generate networks for MF6
   CALL IMODBATCH_MF6NETWORKS()
  CASE (81)  !## create a set of pilot points
   CALL IMODBATH_CREATEPILOTPOINTS()
  CASE (82)  !## adjust weight value in ipf-file based on pointer grid and given factor
   CALL IMODBATCH_IPFEDITWEIGHT()
  CASE (83)  !## aggregate
   CALL IMODBATCH_AGGREGATE()
  CASE (84)  !## createwelborelog
   CALL IMODBATCH_CREATEWELBORELOG()
  CASE (85)  !## ensembles
   CALL IMODBATCH_CREATEENSEMBLES()
  CASE (86)  !## evaluate timeseries if measurements are placed in correct modellayer
   CALL IMODBATCH_IPFEVALUATE()   
  CASE (87)  !## construct layers from thicknesses
   CALL IMODBATCH_LAYERFROMTHICKNESS()
  CASE (88)!## imodpath7
   CALL IMODBATCH_IMODPATH7_MAIN()
  CASE (89)!## ipesttoparam
   CALL IMODBATCH_IPESTTOPARAM()
  CASE (90)!## iffcrosssection
   CALL IMODBATCH_IFFCROSSSECTION()
 END SELECT

 CLOSE(IU)

 CALL POLYGON1CLOSE()

 IMODBATCH=.TRUE.

 END FUNCTION IMODBATCH

 !###======================================================================
 LOGICAL FUNCTION IMODBATCH_FUNC()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=50) :: CF
 INTEGER :: NARG,IOS

 IMODBATCH_FUNC=.FALSE.

 CALL OSD_GETNARG(NARG)
 IF(NARG.LE.0.OR.NARG.GT.1)RETURN

 CALL OSD_GETARG(1,ARGSTRING)
 IF(INDEX(UTL_CAP(ARGSTRING,'U'),'INI').EQ.0)RETURN

 IMODBATCH_FUNC=.TRUE.

 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=ARGSTRING,STATUS='OLD',ACTION='READ',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open file:'//CHAR(13)//TRIM(ARGSTRING),'Error')
  RETURN
 ENDIF

 !## read function
 IF(.NOT.UTL_READINITFILE('FUNCTION',LINE,IU,0))RETURN
 READ(LINE,*) CF

 !## search for recognizable functions
 DO IFN=1,SIZE(CFUNC)
  IF(TRIM(UTL_CAP(CFUNC(IFN),'U')).EQ.TRIM(UTL_CAP(CF,'U')))EXIT
 ENDDO

 IF(IFN.GT.SIZE(CFUNC))THEN
  CLOSE(IU)
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot recognize function:'//CHAR(13)//'FUNCTION='//TRIM(CF),'Error')
  RETURN
 ENDIF

 WRITE(*,'(/A/)') 'EXECUTING FUNCTION >>> '//TRIM(CF)//' <<<'

 END FUNCTION IMODBATCH_FUNC

 !###======================================================================
 SUBROUTINE IMODBATCH_TESTBANK()
 !###======================================================================
 USE MOD_TB_PAR, ONLY : CONFNAME
 IMPLICIT NONE
 
 IF(.NOT.UTL_READINITFILE('CONFNAME',LINE,IU,0))RETURN
 READ(LINE,'(A)') CONFNAME; WRITE(*,'(A)') 'CONFNAME='//TRIM(CONFNAME)

 CALL TB_MAIN()
 
 END SUBROUTINE IMODBATCH_TESTBANK
 
  !###======================================================================
 SUBROUTINE IMODBATCH_VOXELVOLUME()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: LISTNAME
 CHARACTER(LEN=256) :: DIRNAME,FNAME
 CHARACTER(LEN=52) :: WC
 INTEGER :: I,II,J,JU,MAXTHREAD,MAXN,NPOCKETS,ILAY,IROW,ICOL,IP,NXOFFSET
 INTEGER(KIND=1),DIMENSION(:,:,:),ALLOCATABLE :: Y
 INTEGER,DIMENSION(:,:,:),ALLOCATABLE :: IBND
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XTOP
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XOFFSET 
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ITOP
 TYPE POCKETOBJ
  INTEGER :: SIZE
  INTEGER :: COUNT
  REAL(KIND=DP_KIND) :: VOLUME
 END TYPE POCKETOBJ
 TYPE(POCKETOBJ),ALLOCATABLE,DIMENSION(:,:) :: POCKET
     
 !## get number of files to be imported
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)
 IF(.NOT.UTL_READINITFILE('WILDCARD',LINE,IU,0))RETURN
 READ(LINE,*) WC; WRITE(*,'(A)') 'WILDCARD='//TRIM(WC)
 IF(.NOT.UTL_READINITFILE('FNAME',LINE,IU,0))RETURN
 READ(LINE,*) FNAME; WRITE(*,'(A)') 'FNAME='//TRIM(FNAME)

 IF(.NOT.UTL_READINITFILE('NXOFFSET',LINE,IU,0))RETURN
 READ(LINE,*) NXOFFSET; LINE='NXOFFSET='//TRIM(ITOS(NXOFFSET)); WRITE(*,'(A)') TRIM(LINE)
 ALLOCATE(XOFFSET(NXOFFSET))
 DO I=1,NXOFFSET
  IF(.NOT.UTL_READINITFILE('XOFFSET'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) XOFFSET(I); LINE='XOFFSET'//TRIM(ITOS(I))//'='//TRIM(RTOS(XOFFSET(I),'F',7)); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 IF(.NOT.UTL_READINITFILE('NPOCKETS',LINE,IU,0))RETURN
 READ(LINE,*) NPOCKETS; LINE='NPOCKETS='//TRIM(ITOS(NPOCKETS)); WRITE(*,'(A)') TRIM(LINE)
 ALLOCATE(POCKET(NPOCKETS,NXOFFSET)); POCKET%SIZE=0; POCKET%COUNT=0
 DO I=1,NPOCKETS
  IF(.NOT.UTL_READINITFILE('POCKET'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) POCKET(I,1)%SIZE; LINE='POCKET'//TRIM(ITOS(I))//'='//TRIM(ITOS(POCKET(I,1)%SIZE)); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

! IF(.NOT.UTL_READINITFILE('XOFFSET',LINE,IU,0))RETURN
! READ(LINE,*) XOFFSET; LINE='XOFFSET='//TRIM(RTOS(XOFFSET,'E',7)); WRITE(*,'(A)') TRIM(LINE)
 
 IF(.NOT.UTL_DIRINFO_POINTER(DIRNAME,WC,LISTNAME,'F'))THEN; STOP 'No files found'; ENDIF

 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')

 ALLOCATE(XTOP(SIZE(LISTNAME)),ITOP(SIZE(LISTNAME))); XTOP=10.0D10; ITOP=0
 DO I=1,SIZE(LISTNAME)
  LISTNAME(I)=TRIM(DIRNAME)//'\'//TRIM(LISTNAME(I))
  IF(.NOT.IDFREAD(IDF,LISTNAME(I),0))THEN; WRITE(*,'(A)') 'Cannot read '//TRIM(LISTNAME(I)); STOP; ENDIF
  IF(IDF%ITB.EQ.0)THEN; WRITE(*,'(A)') TRIM(LISTNAME(I))//' is not a voxel IDF'; STOP; ENDIF
  XTOP(I)=IDF%TOP
  ITOP(I)=I  ! initialize
  CLOSE(IDF%IU)
 ENDDO
 CALL UTL_WSORT(XTOP,1,SIZE(LISTNAME),1,IORDER=ITOP) 

 ALLOCATE(IBND(IDF%NCOL,IDF%NROW,SIZE(LISTNAME)))

 DO II=1,NXOFFSET
  
  DO I=1,NPOCKETS
   POCKET(I,II)%SIZE =POCKET(I,1)%SIZE
   POCKET(I,II)%COUNT=0
  ENDDO

  IBND=0
  DO I=1,SIZE(LISTNAME)
   J=ITOP(I)
   WRITE(*,'(2I10,A)') I,J,TRIM(LISTNAME(J))
   IF(.NOT.IDFREAD(IDF,LISTNAME(J),1))THEN; WRITE(*,'(A)') 'Cannot read '//TRIM(LISTNAME(I)); STOP; ENDIF
   DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL 
    IF(IDF%X(ICOL,IROW).GE.XOFFSET(II))IBND(ICOL,IROW,I)=1
   ENDDO; ENDDO
   CALL IDFDEALLOCATEX(IDF)
  ENDDO

  !## find active cells not in direct (2d/3d) relation to constant head cell!
  IF(ALLOCATED(Y))DEALLOCATE(Y); ALLOCATE(Y(IDF%NCOL,IDF%NROW,SIZE(LISTNAME)))

  IP=0
  Y =0
  DO ILAY=1,SIZE(LISTNAME)
   DO IROW=1,IDF%NROW
    DO ICOL=1,IDF%NCOL
     IF(Y(ICOL,IROW,ILAY).EQ.0.AND.IBND(ICOL,IROW,ILAY).GT.0)THEN
      IP=1
      MAXTHREAD=1000; MAXN=MAXTHREAD
      CALL SOLID_TRACE_3D(ILAY,IROW,ICOL,IBND,Y,SIZE(LISTNAME),IDF%NROW,IDF%NCOL,IP,MAXTHREAD,MAXN,POCKET(:,II)%COUNT,POCKET(:,II)%SIZE)
     ENDIF
    ENDDO
   ENDDO
   WRITE(6,'(A,F10.2)') '+Progress ',REAL(ILAY*100)/REAL(SIZE(LISTNAME))
  END DO
 
 ENDDO
 
 WRITE(JU,'(A15)') 'COUNT'
 WRITE(JU,'(2A15,99F15.7)') 'ipocket','size',(XOFFSET(I)*86400.0D0,I=1,NXOFFSET)

 DO I=1,NPOCKETS
  WRITE(JU,'(99I15)') I,POCKET(I,1)%SIZE,(POCKET(I,J)%COUNT,J=1,NXOFFSET) 
 ENDDO
   
 WRITE(JU,'(A15)') 'VOLUME'
 WRITE(JU,'(2A15,99F15.7)') 'ipocket','size',(XOFFSET(I)*86400.0D0,I=1,NXOFFSET)

 DO I=1,NPOCKETS
  DO J=1,NXOFFSET
   POCKET(I,J)%VOLUME=POCKET(I,J)%SIZE*POCKET(I,J)%COUNT
   POCKET(I,J)%VOLUME=POCKET(I,J)%VOLUME*((IDF%DX*IDF%DY*5.0)/1.0E6)
  ENDDO
  WRITE(JU,'(2I15,99F15.7)') I,POCKET(I,1)%SIZE,(POCKET(I,J)%VOLUME,J=1,NXOFFSET) 
 ENDDO

 DEALLOCATE(Y,IBND,XTOP,ITOP)

 CLOSE(JU); DEALLOCATE(LISTNAME)
 
 END SUBROUTINE IMODBATCH_VOXELVOLUME

 !###======================================================================
 SUBROUTINE IMODBATCH_VOLUME()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: LISTNAME
 CHARACTER(LEN=256) :: DIRNAME,FNAME
 CHARACTER(LEN=52) :: WC
 REAL(KIND=DP_KIND),DIMENSION(2) :: XSUM
 INTEGER :: I,J,IROW,ICOL,JU
    
 !## get number of files to be imported
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)
 IF(.NOT.UTL_READINITFILE('WILDCARD',LINE,IU,0))RETURN
 READ(LINE,*) WC; WRITE(*,'(A)') 'WILDCARD='//TRIM(WC)
 IF(.NOT.UTL_READINITFILE('FNAME',LINE,IU,0))RETURN
 READ(LINE,*) FNAME; WRITE(*,'(A)') 'FNAME='//TRIM(FNAME)

 IF(.NOT.UTL_DIRINFO_POINTER(DIRNAME,WC,LISTNAME,'F'))THEN; STOP 'No files found'; ENDIF

 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
 
 DO I=1,SIZE(LISTNAME)
  LISTNAME(I)=TRIM(DIRNAME)//'\'//TRIM(LISTNAME(I))
  IF(.NOT.IDFREAD(IDF,LISTNAME(I),1))THEN; WRITE(*,'(A)') 'Cannot read '//TRIM(LISTNAME(I)); STOP; ENDIF
  XSUM=0.0D0; DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
   IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)THEN
    J=1; IF(IDF%X(ICOL,IROW).LT.0.0D0)J=2
    XSUM(J)=XSUM(J)+IDF%X(ICOL,IROW) 
   ENDIF   
  ENDDO; ENDDO
  WRITE(*,'(2I10,A,3F15.7)')  I,SIZE(LISTNAME),TRIM(LISTNAME(I)(INDEX(LISTNAME(I),'\',.TRUE.)+1:)),XSUM(1),XSUM(2),SUM(XSUM)
  WRITE(JU,'(A,3F15.7)') TRIM(LISTNAME(I)(INDEX(LISTNAME(I),'\',.TRUE.)+1:)),XSUM(1),XSUM(2),SUM(XSUM)
 ENDDO
 
 CLOSE(JU); DEALLOCATE(LISTNAME)
 
 END SUBROUTINE IMODBATCH_VOLUME

 !###======================================================================
 SUBROUTINE IMODBATCH_VOLUME_SALT()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 INTEGER :: I,IROW,ICOL
 REAL(KIND=DP_KIND) :: T,B,DENSITY_FRESH,DENSITY_SALT,R,DRNLEVEL,POR,TV
  
 ALLOCATE(IDF(3)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 DENSITY_FRESH=0.0D0; DENSITY_SALT=0.0D0
 
 IF(.NOT.UTL_READINITFILE('TOPIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(1)%FNAME; WRITE(*,'(A)') 'TOPIDF='//TRIM(IDF(1)%FNAME)
 IF(.NOT.UTL_READINITFILE('BOTIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(2)%FNAME; WRITE(*,'(A)') 'BOTIDF='//TRIM(IDF(2)%FNAME)
 IF(.NOT.UTL_READINITFILE('VOLIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(3)%FNAME; WRITE(*,'(A)') 'VOLIDF='//TRIM(IDF(3)%FNAME)
 IF(UTL_READINITFILE('DENSITY_FRESH',LINE,IU,1))READ(LINE,*) DENSITY_FRESH
 WRITE(*,'(A,F10.2)') 'DENSITY_FRESH=',DENSITY_FRESH
 IF(UTL_READINITFILE('DENSITY_SALT',LINE,IU,1))READ(LINE,*) DENSITY_SALT
 WRITE(*,'(A,F10.2)') 'DENSITY_SALT=',DENSITY_SALT
 
 !## Ghyben-Herzberg 
 R=DENSITY_FRESH/(DENSITY_SALT-DENSITY_FRESH)
 DRNLEVEL=0.0D0
 POR=0.35
  
 IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,0))STOP 'Cannot read data for IDF(1)'
 IF(.NOT.IDFREAD(IDF(2),IDF(2)%FNAME,0))STOP 'Cannot read data for IDF(2)'
 CLOSE(IDF(1)%IU); CLOSE(IDF(2)%IU)
    
 IF(.NOT.IDF_EXTENT(2,IDF,IDF(3),2))STOP 'Cannot determing minimal overlapping size.'
 IF(.NOT.IDFALLOCATEX(IDF(3)))STOP ' Cannot allocate memory for IDF(3)'
 CALL IDFCOPY(IDF(3),IDF(1)); CALL IDFCOPY(IDF(3),IDF(2))
 IF(.NOT.IDFREADSCALE(IDF(1)%FNAME,IDF(1),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'
 IF(.NOT.IDFREADSCALE(IDF(2)%FNAME,IDF(2),2,1,0.0D0,0))STOP 'Cannot read data for IDF(2)'
 TV=0.0D0
 DO IROW=1,IDF(1)%NROW
  DO ICOL=1,IDF(1)%NCOL
   T=IDF(1)%X(ICOL,IROW)
   B=IDF(2)%X(ICOL,IROW)
   IF(T.NE.IDF(1)%NODATA.AND.B.NE.IDF(2)%NODATA)THEN
    IF(T.GT.DRNLEVEL.AND.T.GT.B)THEN
     !## base if salt-water boundary
     IF(DENSITY_FRESH.GT.0.0D0.AND.DENSITY_SALT.GT.0.0D0)B=MAX(B,DRNLEVEL-T*R)
     IDF(3)%X(ICOL,IROW)=T-B
     TV=TV+(IDF(3)%X(ICOL,IROW)*POR*IDF(3)%DX*IDF(3)%DY)
    ELSE
     IDF(3)%X(ICOL,IROW)=0.0D0
    ENDIF
   ELSE
    IDF(3)%X(ICOL,IROW)=IDF(3)%NODATA
   ENDIF
  ENDDO
 ENDDO
 IF(.NOT.IDFWRITE(IDF(3),IDF(3)%FNAME,1))STOP 'Cannot write result IDF(3)'
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 
 WRITE(*,'(A,F17.5)') 'Total volume = ',TV
 
 END SUBROUTINE IMODBATCH_VOLUME_SALT

 !###======================================================================
 SUBROUTINE IMODBATCH_CLIPVOXELS()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 CHARACTER(LEN=256) :: DIRNAME,OUTPUTNAME
 CHARACTER(LEN=52) :: WC
 INTEGER :: I,J,IROW,ICOL,ISCALE,NZ
 REAL(KIND=DP_KIND) :: DZ,MINZ,MAXZ,Z1,Z2
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: ZT,ZB
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IORDER
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: LISTNAME
   
 ISCALE=3; IF(UTL_READINITFILE('ISCALE',LINE,IU,1))READ(LINE,*) ISCALE
 WRITE(*,'(A,I5)') 'ISCALE=',ISCALE
 DZ=1.0D0; IF(UTL_READINITFILE('DZ',LINE,IU,1))READ(LINE,*) DZ
 WRITE(*,'(A,F15.7)') 'DZ=',DZ

 ALLOCATE(IDF(5)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 
 IF(.NOT.UTL_READINITFILE('TOPIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(1)%FNAME; WRITE(*,'(A)') 'TOPIDF='//TRIM(IDF(1)%FNAME)
 IF(.NOT.UTL_READINITFILE('BOTIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(2)%FNAME; WRITE(*,'(A)') 'BOTIDF='//TRIM(IDF(2)%FNAME)
 IF(.NOT.UTL_READINITFILE('OUTPUTNAME',LINE,IU,0))RETURN
 READ(LINE,'(A)') OUTPUTNAME; WRITE(*,'(A)') 'OUTPUTNAME='//TRIM(OUTPUTNAME)

 !## get number of files to be imported
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)
 WC=DIRNAME(INDEX(DIRNAME,'\',.TRUE.)+1:); DIRNAME=DIRNAME(:INDEX(DIRNAME,'\',.TRUE.)-1)
 
 IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,0))STOP 'Cannot read data for IDF(1)'
 IF(.NOT.IDFREAD(IDF(2),IDF(2)%FNAME,0))STOP 'Cannot read data for IDF(2)'
 CLOSE(IDF(1)%IU); CLOSE(IDF(2)%IU)
    
 IF(.NOT.IDF_EXTENT(2,IDF,IDF(3),2))STOP 'Cannot determing minimal overlapping size.'
 IF(.NOT.IDFALLOCATEX(IDF(3)))STOP ' Cannot allocate memory for IDF(3)'
 CALL IDFCOPY(IDF(3),IDF(1)); CALL IDFCOPY(IDF(3),IDF(2))

 IF(.NOT.IDFREADSCALE(IDF(1)%FNAME,IDF(1),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'
 IF(.NOT.IDFREADSCALE(IDF(2)%FNAME,IDF(2),2,1,0.0D0,0))STOP 'Cannot read data for IDF(2)'

 IF(.NOT.UTL_DIRINFO_POINTER(DIRNAME,WC,LISTNAME,'F'))RETURN
 DO I=1,SIZE(LISTNAME); LISTNAME(I)=TRIM(DIRNAME)//'\'//TRIM(LISTNAME(I)); ENDDO
 
 ALLOCATE(ZT(SIZE(LISTNAME)),ZB(SIZE(LISTNAME)),IORDER(SIZE(LISTNAME)))

 !## determine what we have ...
 DO I=1,SIZE(LISTNAME)
  IORDER(I)=I  ! initialize
  IF(.NOT.IDFREAD(IDF(4),LISTNAME(I),0))THEN; WRITE(*,'(A)') 'Cannot read file '//TRIM(LISTNAME(I)); STOP; ENDIF
  ZT(I)=IDF(4)%TOP; ZB(I)=IDF(4)%BOT
 ENDDO
 CALL UTL_WSORT(ZT,1,SIZE(ZT),IFLAGS=SORTDESCEND,IORDER=IORDER)
 
 !## get minimal/maximal value
 MINZ=MINVAL(ZB); MAXZ=MAXVAL(ZT)
 
 !## make intervals
 NZ=(MAXZ-MINZ)/DZ

 CALL IDFCOPY(IDF(1),IDF(4)); CALL IDFCOPY(IDF(1),IDF(5))

 Z1=MAXZ
 
 DO I=1,NZ

  Z2=Z1-DZ; IDF(4)%X=0.0D0; IDF(5)%X=0.0D0
  
  WRITE(*,'(A,2F15.7)') 'Interval ',Z1,Z2
    
  DO J=1,SIZE(LISTNAME)

   !## see whether current IDF fits within bandwidth of thickness (dz)
   IF(ZT(J).LE.Z1.AND.ZB(IORDER(J)).GE.Z2)THEN

    WRITE(*,'(1X,A)') TRIM(LISTNAME(IORDER(J)))

    IF(.NOT.IDFREADSCALE(LISTNAME(IORDER(J)),IDF(3),ISCALE,1,0.0D0,0))STOP 'Cannot read data for IDF(3)'

    DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
     IF(IDF(3)%X(ICOL,IROW).NE.IDF(3)%NODATA)THEN
      IDF(4)%X(ICOL,IROW)=IDF(4)%X(ICOL,IROW)+1.0D0
      IDF(5)%X(ICOL,IROW)=IDF(5)%X(ICOL,IROW)+LOG(IDF(3)%X(ICOL,IROW))
     ENDIF
    ENDDO; ENDDO

   ENDIF
  ENDDO

  !## compute upscaled values
  DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
   IF(Z1.LE.IDF(1)%X(ICOL,IROW).AND.Z2.GT.IDF(2)%X(ICOL,IROW))THEN
    IF(IDF(4)%X(ICOL,IROW).GT.0.0D0)THEN
     IDF(5)%X(ICOL,IROW)=EXP(IDF(5)%X(ICOL,IROW)/IDF(4)%X(ICOL,IROW))
    ELSE
     IDF(5)%X(ICOL,IROW)=IDF(5)%NODATA
    ENDIF
   ELSE
    IDF(5)%X(ICOL,IROW)=IDF(5)%NODATA
   ENDIF
  ENDDO; ENDDO

  IDF(5)%FNAME=TRIM(OUTPUTNAME)//TRIM(RTOS(Z1,'F',3))//'_'//TRIM(RTOS(Z2,'F',3))//'.IDF'
  IDF(5)%ITB=INT(1,1); IDF(5)%TOP=Z1; IDF(5)%BOT=Z2
  IF(.NOT.IDFWRITE(IDF(5),IDF(5)%FNAME,1))STOP 'Cannot write result IDF(5)'
  
  Z1=Z2
  
 ENDDO
 
 DEALLOCATE(IORDER,ZT)
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
  
 END SUBROUTINE IMODBATCH_CLIPVOXELS
 
 !###======================================================================
 SUBROUTINE IMODBATCH_DRNSURF()
 !###======================================================================
 USE MOD_DRNSURF
 IMPLICIT NONE
 
 ALLOCATE(IDF(4)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 
 IF(.NOT.UTL_READINITFILE('SURFIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(1)%FNAME; WRITE(*,'(A)') 'SURFIDF='//TRIM(IDF(1)%FNAME)
 IF(.NOT.UTL_READINITFILE('PNTRIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(2)%FNAME; WRITE(*,'(A)') 'PNTRIDF='//TRIM(IDF(2)%FNAME)
 IF(.NOT.UTL_READINITFILE('LUSEIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(3)%FNAME; WRITE(*,'(A)') 'LUSEIDF='//TRIM(IDF(3)%FNAME)
 IF(.NOT.UTL_READINITFILE('NLUSE',LINE,IU,0))RETURN
 READ(LINE,*) NLGN; WRITE(*,'(A,I10)') 'NLUSE=',NLGN
 
 !## landuse code to be drainage potentially
 ALLOCATE(ILGN(NLGN))
 DO I=1,NLGN
  IF(.NOT.UTL_READINITFILE('ILUSE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) ILGN(I)
  LINE='ILUSE'//TRIM(ITOS(I))//'='//TRIM(ITOS(ILGN(I))); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 !## percentage to become drainage (0-100%)
 IF(.NOT.UTL_READINITFILE('TDRAINAGE',LINE,IU,0))RETURN
 READ(LINE,*) CLB; WRITE(*,'(A,F10.2)') 'TDRAINAGE=',CLB

 !## Give Absolute AHN-Threshold for determining zones'
 IF(.NOT.UTL_READINITFILE('TSURFLEVEL',LINE,IU,0))RETURN
 READ(LINE,*) CRITAHN; WRITE(*,'(A,F10.2)') 'TSURFLEVEL=',CRITAHN

 !## Give Percentile for determining drainage level within each zone, Percentile (0-100, 50=median)'
 IF(.NOT.UTL_READINITFILE('PERCENTILE',LINE,IU,0))RETURN
 READ(LINE,*) SFCT; WRITE(*,'(A,F10.2)') 'PERCENTILE=',SFCT

 MPW%XMIN=0.0D0; MPW%YMIN=0.0D0; MPW%XMAX=0.0D0; MPW%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) CS; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',CS
 ENDIF

 IF(.NOT.UTL_READINITFILE('OUTIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(4)%FNAME; WRITE(*,'(A)') 'OUTIDF='//TRIM(IDF(4)%FNAME)

 CALL DRNSURF_MAIN()
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 
 END SUBROUTINE IMODBATCH_DRNSURF
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEEVT()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: HIDF,FIDF
 CHARACTER(LEN=52) :: WC
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: HLISTNAME,FLISTNAME
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: F,H
 INTEGER :: II,I,J,JD1,JD2,IROW,ICOL,MWT
 REAL(KIND=DP_KIND) :: FV,HV,A,B,SIGA,SIGB,CHI2,Q
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IP
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: HC,FC,SIG
 
 IF(.NOT.UTL_READINITFILE('FIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') FIDF; WRITE(*,'(A)') 'FIDF='//TRIM(FIDF)
 IF(.NOT.UTL_READINITFILE('HIDF',LINE,IU,0))RETURN
 READ(LINE,'(A)') HIDF; WRITE(*,'(A)') 'HIDF='//TRIM(HIDF)
 IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
 READ(LINE,*) JD1; LINE=TRIM(ITOS(JD1)); WRITE(*,'(A)') 'SDATE='//TRIM(LINE)
 IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
 READ(LINE,*) JD2; LINE=TRIM(ITOS(JD2)); WRITE(*,'(A)') 'EDATE='//TRIM(LINE)
 JD1=UTL_IDATETOJDATE(JD1); JD2=UTL_IDATETOJDATE(JD2)
 
 WC=TRIM(FIDF(INDEX(FIDF,'\',.TRUE.)+1:)); FIDF=FIDF(:INDEX(FIDF,'\',.TRUE.)-1)
 IF(.NOT.UTL_DIRINFO_POINTER(FIDF,WC,FLISTNAME,'F'))STOP
 WC=TRIM(HIDF(INDEX(HIDF,'\',.TRUE.)+1:)); HIDF=HIDF(:INDEX(HIDF,'\',.TRUE.)-1)
 IF(.NOT.UTL_DIRINFO_POINTER(HIDF,WC,HLISTNAME,'F'))STOP
 ALLOCATE(F(SIZE(FLISTNAME)),H(SIZE(HLISTNAME)))
 DO I=1,SIZE(F); CALL IDFNULLIFY(F(I)); ENDDO; DO I=1,SIZE(H); CALL IDFNULLIFY(H(I)); ENDDO
 DO I=1,SIZE(FLISTNAME); F(I)%JD=UTL_IDFGETDATE(FLISTNAME(I)); IF(F(I)%JD.NE.0)F(I)%JD=UTL_IDATETOJDATE(F(I)%JD); ENDDO
 DO I=1,SIZE(HLISTNAME); H(I)%JD=UTL_IDFGETDATE(HLISTNAME(I)); IF(H(I)%JD.NE.0)H(I)%JD=UTL_IDATETOJDATE(H(I)%JD); ENDDO

 DO I=1,SIZE(FLISTNAME)
  IF(F(I)%JD.LT.JD1.OR.F(I)%JD.GT.JD2)THEN; F(I)%JD=0; CYCLE; ENDIF
 ENDDO

 !## search for overlapping files
 ALLOCATE(IP(SIZE(FLISTNAME))); IP=0
 DO I=1,SIZE(FLISTNAME)
  IF(F(I)%JD.GT.0)THEN
   DO J=1,SIZE(HLISTNAME); IF(H(J)%JD.EQ.F(I)%JD)IP(I)=J; ENDDO
  ENDIF
 ENDDO

 !## open files - that overlap
 DO I=1,SIZE(FLISTNAME)
  J=IP(I); IF(J.GT.0)THEN
   IF(.NOT.IDFREAD(F(I),TRIM(FIDF)//'\'//TRIM(FLISTNAME(I)),0))STOP
   IF(.NOT.IDFREAD(H(J),TRIM(HIDF)//'\'//TRIM(HLISTNAME(J)),0))STOP
  ENDIF
 ENDDO
  
 ALLOCATE(HC(SIZE(FLISTNAME)),FC(SIZE(FLISTNAME)),SIG(SIZE(FLISTNAME)))
 SIG=0.0D0; MWT=0

 OPEN(10,FILE='D:\DUMP\REGRESSION.TXT',STATUS='UNKNOWN')

 DO IROW=1,F(1)%NROW; DO ICOL=1,F(1)%NCOL
  
  II=0; DO I=1,SIZE(FLISTNAME)
   J=IP(I); IF(J.GT.0)THEN
    FV=IDFGETVAL(F(I),IROW,ICOL)
    HV=IDFGETVAL(H(J),IROW,ICOL) 
    IF(FV.NE.F(I)%NODATA.AND.HV.NE.H(J)%NODATA)THEN
     II=II+1; HC(II)=HV; FC(II)=MAX(0.0D0,MIN(1.0D0,FV))
    ENDIF  
   ENDIF 
  ENDDO
  IF(II.GT.0)THEN
   CALL UTL_FIT_REGRESSION(HC,FC,II,SIG,MWT,B,A,SIGA,SIGB,CHI2,Q)
   WRITE(10,'(2I10)') ICOL,IROW
   DO I=1,II; WRITE(10,'(I10,2F10.2)') I,HC(I),FC(I); ENDDO
   WRITE(10,'(6F10.2)') A,B,SIGA,SIGB,CHI2,Q
!## y=ax+b
  ENDIF
  
 ENDDO; ENDDO
 
 CLOSE(10)

! DO I=1,SIZE(HLISTNAME); IF(.NOT.IDFREAD(H(I),TRIM(HIDF)//'\'//TRIM(HLISTNAME(I)),0))STOP; ENDDO
 
! IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,1))RETURN

 END SUBROUTINE IMODBATCH_CREATEEVT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATESUBMODELS()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 CHARACTER(LEN=256) :: SUBMODELFILE
 CHARACTER(LEN=256) :: STRING
 REAL(KIND=DP_KIND) :: DSIZE,X1,Y1,X,Y,F
 REAL(KIND=DP_KIND) :: CSIZE,DX,DY,MAXS
 REAL(KIND=DP_KIND),DIMENSION(4) :: BOXS
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: IDLIST
 LOGICAL :: LCLICK
 LOGICAL,DIMENSION(4) :: LTRB
 INTEGER :: II,I,JJ,J,IX,IY,JU,KU,LU,MU,IROW,ICOL,IR1,IR2,IC1,IC2,NID
 INTEGER :: MAXDEELMOD
 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: DEELMOD
 
 TYPE POLOBJ
   REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2,CS,XMIN,YMIN,XMAX,YMAX
   INTEGER :: ILOAD
   INTEGER :: ID   ! FR
   CHARACTER(LEN=52) :: NAME
 END TYPE POLOBJ
 TYPE(POLOBJ),ALLOCATABLE,DIMENSION(:,:) :: POL

 !## FR 20131016: add IDF with "deelmodel" numbers 
 !## FR 20131016: add TXT with list of "deelmodellen" for each unique value in given SOURCEDIR

 !## smaller than to be possible to be added to another one
 F=0.25
 
 IF(.NOT.UTL_READINITFILE('DSIZE',LINE,IU,0))RETURN
 READ(LINE,*) DSIZE; WRITE(*,'(A,F10.2)') 'DSIZE=',DSIZE
 IF(.NOT.UTL_READINITFILE('CSIZE',LINE,IU,0))RETURN
 READ(LINE,*) CSIZE; WRITE(*,'(A,F10.2)') 'CSIZE=',CSIZE
 
 ALLOCATE(IDF(2)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO   ! FR 20131016

 IF(.NOT.UTL_READINITFILE('IBOUND',LINE,IU,0))RETURN
 READ(LINE,'(A)') IDF(1)%FNAME; LINE='IBOUND='; WRITE(*,'(A)') TRIM(LINE)//TRIM(IDF(1)%FNAME)
 IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,1))RETURN        ! FR 20131016
 CALL IDFCOPY(IDF(1),IDF(2)); IDF(2)%X=IDF(2)%NODATA  ! FR 20131016
 IF(.NOT.UTL_READINITFILE('SUBMODELFILE',LINE,IU,0))RETURN
 READ(LINE,'(A)') SUBMODELFILE; LINE='SUBMODELFILE='; WRITE(*,'(A)') TRIM(LINE)//TRIM(SUBMODELFILE)
 
 I=INDEX(SUBMODELFILE,'.',.TRUE.); IF(I.GT.0)SUBMODELFILE=SUBMODELFILE(:I-1)
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(SUBMODELFILE)//'.RUN',STATUS='UNKNOWN',ACTION='WRITE')
 KU=UTL_GETUNIT(); OPEN(KU,FILE=TRIM(SUBMODELFILE)//'.GEN',STATUS='UNKNOWN',ACTION='WRITE')
 LU=UTL_GETUNIT(); OPEN(LU,FILE=TRIM(SUBMODELFILE)//'.IPF',STATUS='UNKNOWN',ACTION='WRITE')
 IDF(2)%FNAME=TRIM(SUBMODELFILE)//'.IDF'           ! FR 20131016
 MU=UTL_GETUNIT(); OPEN(MU,FILE=TRIM(SUBMODELFILE)//'.TXT',STATUS='UNKNOWN',ACTION='WRITE')  ! FR 20131016
 
 IX=(IDF(1)%XMAX-IDF(1)%XMIN)/DSIZE; IX=IX+1
 IY=(IDF(1)%YMAX-IDF(1)%YMIN)/DSIZE; IY=IY+1

 ALLOCATE(POL(IX,IY))
 
 !## fill polygons 
 II=0; Y1=IDF(1)%YMAX+DSIZE
 DO J=1,IY; Y1=Y1-DSIZE; X1=IDF(1)%XMIN; DO I=1,IX  
  II=II+1 
  POL(I,J)%NAME='SUBMODEL'//TRIM(ITOS(POL(I,J)%ID))
  POL(I,J)%X1=X1;       POL(I,J)%Y2=Y1
  POL(I,J)%X2=MIN(IDF(1)%XMAX,X1+DSIZE); POL(I,J)%Y1=MAX(IDF(1)%YMIN,Y1-DSIZE)
  POL(I,J)%CS=CSIZE
  CALL IDFIROWICOL(IDF(1),IR1,IC1,POL(I,J)%X1,POL(I,J)%Y2)
  CALL IDFIROWICOL(IDF(1),IR2,IC2,POL(I,J)%X2,POL(I,J)%Y1)
  IF(IC2.EQ.0)IC2=IDF(1)%NCOL; IF(IR2.EQ.0)IR2=IDF(1)%NROW   
  IC1=MAX(1,IC1); IC2=MIN(IC2,IDF(1)%NCOL)
  IR1=MAX(1,IR1); IR2=MIN(IR2,IDF(1)%NROW)
  POL(I,J)%ILOAD=0
  DO IROW=IR1,IR2; DO ICOL=IC1,IC2
   IF(IDF(1)%X(ICOL,IROW).GT.0)POL(I,J)%ILOAD=POL(I,J)%ILOAD+1   
!   IF(IDF(1)%X(ICOL,IROW).NE.0)POL(I,J)%ILOAD=POL(I,J)%ILOAD+1   
  ENDDO; ENDDO
  !## adjust boxsize to NODATA value
  POL(I,J)%XMIN=POL(I,J)%X2; POL(I,J)%YMIN=POL(I,J)%Y2; POL(I,J)%XMAX=POL(I,J)%X1; POL(I,J)%YMAX=POL(I,J)%Y1
  DO IROW=IR1,IR2
   DO ICOL=IC1,IC2
    CALL IDFGETLOC(IDF(1),IROW,ICOL,X,Y); X=X-(IDF(1)%DX/2.0); Y=Y+(IDF(1)%DX/2.0)
    IF(X.GE.POL(I,J)%X2)EXIT; IF(Y.LE.POL(I,J)%Y1)EXIT
!    IF(IDF(1)%X(ICOL,IROW).NE.0)THEN
    IF(IDF(1)%X(ICOL,IROW).GT.0)THEN
     POL(I,J)%XMIN=MIN(POL(I,J)%XMIN,X)
     POL(I,J)%XMAX=MAX(POL(I,J)%XMAX,X+IDF(1)%DX)
     POL(I,J)%YMIN=MIN(POL(I,J)%YMIN,Y-IDF(1)%DX)
     POL(I,J)%YMAX=MAX(POL(I,J)%YMAX,Y)
    ENDIF
   ENDDO
  ENDDO 
  X1=POL(I,J)%X2
  POL(I,J)%X1=POL(I,J)%XMIN; POL(I,J)%Y1=POL(I,J)%YMIN
  POL(I,J)%X2=POL(I,J)%XMAX; POL(I,J)%Y2=POL(I,J)%YMAX
  IF(X1.GE.IDF(1)%XMAX)EXIT
 ENDDO; ENDDO
 
!GOTO 10

 DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2)
  IF(POL(I,J)%ILOAD.GT.0)THEN
   DX=POL(I,J)%X2-POL(I,J)%X1; DY=POL(I,J)%Y2-POL(I,J)%Y1
   !## see whether submodel need to be added to another one
   IF(DX.LT.F*DSIZE.OR.DY.LT.F*DSIZE)THEN

    LTRB=.FALSE.
    IF(I.GT.1)THEN
     IF(POL(I-1,J)%X2.EQ.POL(I,J)%X1)THEN
      DX=POL(I-1,J)%X2-POL(I-1,J)%X1; DY=POL(I-1,J)%Y2-POL(I-1,J)%Y1
      BOXS(1)=DX*DY
      IF(POL(I-1,J)%ILOAD.GT.0)LTRB(1)=.TRUE.
     ENDIF
    ENDIF
    IF(I.LT.SIZE(POL,1))THEN
     IF(POL(I+1,J)%X1.EQ.POL(I,J)%X2)THEN
      DX=POL(I+1,J)%X2-POL(I+1,J)%X1; DY=POL(I+1,J)%Y2-POL(I+1,J)%Y1
      BOXS(3)=DX*DY
      IF(POL(I+1,J)%ILOAD.GT.0)LTRB(3)=.TRUE.
     ENDIF
    ENDIF
    IF(J.GT.1)THEN
     IF(POL(I,J-1)%Y1.EQ.POL(I,J)%Y2)THEN
      DX=POL(I,J-1)%X2-POL(I,J-1)%X1; DY=POL(I,J-1)%Y2-POL(I,J-1)%Y1
      BOXS(2)=DX*DY
      IF(POL(I,J-1)%ILOAD.GT.0)LTRB(2)=.TRUE.
     ENDIF
    ENDIF
    IF(J.LT.SIZE(POL,2))THEN
     IF(POL(I,J+1)%Y2.EQ.POL(I,J)%Y1)THEN
      DX=POL(I,J+1)%X2-POL(I,J+1)%X1; DY=POL(I,J+1)%Y2-POL(I,J+1)%Y1
      BOXS(4)=DX*DY
      IF(POL(I,J+1)%ILOAD.GT.0)LTRB(4)=.TRUE.
     ENDIF
    ENDIF

    !## find most appropriate submodel
    JJ=0; MAXS=0; DO II=1,4
     IF(LTRB(II))THEN
      IF(BOXS(II).GT.MAXS)THEN; MAXS=BOXS(II); JJ=II; ENDIF
     ENDIF
    ENDDO

    !## extent submodel jj
    LCLICK=.FALSE.
    SELECT CASE (JJ)
     CASE (0)
      !WRITE(*,*) 
     CASE (1) !## left
      IF(POL(I,J)%X2-POL(I-1,J)%X1.LT.DSIZE*(1.0D0+F))THEN; POL(I-1,J)%X2=POL(I,J)%X2; LCLICK=.TRUE.; ENDIF
     CASE (2) !## top
      IF(POL(I,J-1)%Y2-POL(I,J)%Y1.LT.DSIZE*(1.0D0+F))THEN; POL(I,J-1)%Y1=POL(I,J)%Y1; LCLICK=.TRUE.; ENDIF
     CASE (3) !## right
      IF(POL(I+1,J)%X2-POL(I,J)%X1.LT.DSIZE*(1.0D0+F))THEN; POL(I+1,J)%X1=POL(I,J)%X1; LCLICK=.TRUE.; ENDIF
     CASE (4) !## bottom
      IF(POL(I,J)%Y2-POL(I,J+1)%Y1.LT.DSIZE*(1.0D0+F))THEN; POL(I,J+1)%Y2=POL(I,J)%Y2; LCLICK=.TRUE.; ENDIF
    END SELECT
    
    IF(LCLICK)POL(I,J)%ILOAD=0
    
   ENDIF   
  ENDIF
 ENDDO; ENDDO
 
!10 CONTINUE

 !## Update Object POL metadata before writing data  
  MAXDEELMOD=0
  II=0 
  DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2) ; IF(POL(I,J)%ILOAD.GT.0)THEN
     POL(I,J)%XMIN=MIN(POL(I,J)%X1,POL(I,J)%X2)
     POL(I,J)%XMAX=MAX(POL(I,J)%X1,POL(I,J)%X2)
     POL(I,J)%YMIN=MIN(POL(I,J)%Y1,POL(I,J)%Y2)
     POL(I,J)%YMAX=MAX(POL(I,J)%Y1,POL(I,J)%Y2)

     CALL IDFIROWICOL(IDF(2),IR1,IC1,POL(I,J)%XMIN,POL(I,J)%YMAX)
     CALL IDFIROWICOL(IDF(2),IR2,IC2,POL(I,J)%XMAX,POL(I,J)%YMIN)
     IF(IC2.EQ.0)IC2=IDF(1)%NCOL ; IF(IR2.EQ.0)IR2=IDF(1)%NROW   
     IC1=MAX(1,IC1); IC2=MIN(IC2,IDF(1)%NCOL) ; IR1=MAX(1,IR1); IR2=MIN(IR2,IDF(1)%NROW)
     POL(I,J)%ILOAD=0
     DO IROW = IR1,IR2-1 ;  DO ICOL = IC1,IC2-1
        IF(IDF(1)%X(ICOL,IROW).GT.0) POL(I,J)%ILOAD=POL(I,J)%ILOAD+1   
     ENDDO ; ENDDO

     POL(I,J)%ID=0
     POL(I,J)%NAME=''
     IF(POL(I,J)%ILOAD.GT.0) THEN
        II=II+1 
        POL(I,J)%ID=II
        POL(I,J)%NAME='SUBMODEL'//TRIM(ITOS(POL(I,J)%ID))
        MAXDEELMOD=MAX(MAXDEELMOD,POL(I,J)%ID)
     ENDIF
  ENDIF ;ENDDO ; ENDDO

!## Write GEN and RUN file  ! FR 20131016
 DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2)
  IF(POL(I,J)%ILOAD.GT.0)THEN
   WRITE(JU,'(I1,6(1X,F10.2),A)') 1,MIN(POL(I,J)%X1,POL(I,J)%X2),MIN(POL(I,J)%Y1,POL(I,J)%Y2), &
                                    MAX(POL(I,J)%X1,POL(I,J)%X2),MAX(POL(I,J)%Y1,POL(I,J)%Y2),POL(I,J)%CS,3000.0D0,','//TRIM(POL(I,J)%NAME)
   WRITE(KU,'(2I10)') POL(I,J)%ID,POL(I,J)%ILOAD
   WRITE(KU,'(2(F10.2,A))') POL(I,J)%X1,',',POL(I,J)%Y2
   WRITE(KU,'(2(F10.2,A))') POL(I,J)%X2,',',POL(I,J)%Y2
   WRITE(KU,'(2(F10.2,A))') POL(I,J)%X2,',',POL(I,J)%Y1
   WRITE(KU,'(2(F10.2,A))') POL(I,J)%X1,',',POL(I,J)%Y1
   WRITE(KU,'(2(F10.2,A))') POL(I,J)%X1,',',POL(I,J)%Y2
   WRITE(KU,'(A)') 'END' 
  ENDIF
 ENDDO; ENDDO
 WRITE(KU,'(A)') 'END' 

 !## write IDF file 
 ! ID of Deelmodel as IDF   ! FR 20131016
 DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2)
  IF(POL(I,J)%ILOAD.GT.0) THEN 
    CALL IDFIROWICOL(IDF(2),IR1,IC1,POL(I,J)%XMIN,POL(I,J)%YMAX)
    CALL IDFIROWICOL(IDF(2),IR2,IC2,POL(I,J)%XMAX,POL(I,J)%YMIN)
    IF(IC2.EQ.0)IC2=IDF(1)%NCOL ; IF(IR2.EQ.0)IR2=IDF(1)%NROW   
    IC1=MAX(1,IC1); IC2=MIN(IC2,IDF(1)%NCOL) ; IR1=MAX(1,IR1); IR2=MIN(IR2,IDF(1)%NROW)
    DO IROW = IR1,IR2-1 ;  DO ICOL = IC1,IC2-1
       IDF(2)%X(ICOL,IROW)=POL(I,J)%ID    
    ENDDO ; ENDDO
  ENDIF
 ENDDO; ENDDO
 IF(.NOT.IDFWRITE(IDF(2),IDF(2)%FNAME,1))RETURN  
 
 !## Write IPF file
 WRITE(LU,*) MAXDEELMOD
 WRITE(LU,*) 4
 WRITE(LU,*) 'X'
 WRITE(LU,*) 'Y'
 WRITE(LU,*) 'ID'
 WRITE(LU,*) 'LOAD'
 WRITE(LU,*) '0,TXT'
 DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2)
  IF(POL(I,J)%ILOAD.GT.0)THEN
   WRITE(LU,*) 0.5*(POL(I,J)%X1+POL(I,J)%X2), 0.5*(POL(I,J)%Y1+POL(I,J)%Y2), POL(I,J)%ID, POL(I,J)%ILOAD
  ENDIF
 ENDDO; ENDDO
 
 !## write TXT file 
 !## Make list of Deelmodellen for each unique value in pointer IDF  ! FR 20131016
 ALLOCATE(IDLIST(IDF(2)%NCOL*IDF(2)%NROW))  !for 1D sort action
 IDLIST=0
 DO IROW = 1,IDF(2)%NROW ;  DO ICOL = 1,IDF(2)%NCOL
     IDLIST((IROW-1)*IDF(2)%NCOL+ICOL) = IDF(1)%X(ICOL,IROW)
 ENDDO ; ENDDO
 CALL UTL_GETUNIQUE(IDLIST,IDF(2)%NCOL*IDF(2)%NROW,NID,IDF(2)%NODATA)
 ALLOCATE(DEELMOD(NID,MAXDEELMOD))
 DEELMOD=0
 DO IROW = 1,IDF(2)%NROW ;  DO ICOL = 1,IDF(2)%NCOL
    IF(IDF(2)%X(ICOL,IROW).GT.0)THEN
      DO I=1,NID
        IF(IDF(1)%X(ICOL,IROW).EQ.IDLIST(I)) DEELMOD(I,REAL(IDF(2)%X(ICOL,IROW)))= 1
      ENDDO
    ENDIF
 ENDDO ; ENDDO

 DO II=1,NID
    WRITE(MU,*) '-----------------------------'
    WRITE(MU,*) 'unique pointer ID:,',IDLIST(II)
    WRITE(MU,*) 'covered by deelmodellen:'
    STRING=' '
    DO JJ=1,MAXDEELMOD
       IF(DEELMOD(II,JJ).EQ.1) WRITE(STRING,'(A,I4,A)') TRIM(ADJUSTL(STRING)),JJ,','
       IF(LEN(TRIM(STRING)).GT.100.OR.JJ.EQ.MAXDEELMOD)THEN ; WRITE(MU,'(A256)') ADJUSTL(STRING) ; STRING=' ' ; ENDIF   
    ENDDO
    DO JJ=1,MAXDEELMOD
       IF(DEELMOD(II,JJ).EQ.1)THEN
          DO I=1,SIZE(POL,1); DO J=1,SIZE(POL,2)
             IF(POL(I,J)%ID.EQ.JJ) THEN
                WRITE(MU,'(I1,6(1X,F10.2),A)') 1, & 
                          MIN(POL(I,J)%X1,POL(I,J)%X2),MIN(POL(I,J)%Y1,POL(I,J)%Y2), &
                          MAX(POL(I,J)%X1,POL(I,J)%X2),MAX(POL(I,J)%Y1,POL(I,J)%Y2),POL(I,J)%CS,3000.0D0,','//TRIM(POL(I,J)%NAME)
                EXIT
             ENDIF
          ENDDO ; ENDDO
       ENDIF
    ENDDO
 ENDDO
 
 CLOSE(JU); CLOSE(KU); CLOSE(LU) ; CLOSE(MU)            
  
 END SUBROUTINE IMODBATCH_CREATESUBMODELS

 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEIBOUND()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: NLAY,I,J,IROW,ICOL
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:,:) :: IDF
 CHARACTER(LEN=256) :: RESULTDIR
 REAL(KIND=DP_KIND) :: T,B
 
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 IF(.NOT.UTL_READINITFILE('RESULTDIR',LINE,IU,0))RETURN
 READ(LINE,*) RESULTDIR; WRITE(*,'(A)') 'RESULTDIR='//RESULTDIR

 ALLOCATE(IDF(NLAY,2)); DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2); CALL IDFNULLIFY(IDF(I,J)); ENDDO; ENDDO

 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IDF(I,1)%FNAME; LINE='TOP_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(IDF(I,1)%FNAME)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IDF(I,2)%FNAME; LINE='BOT_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(IDF(I,2)%FNAME)
 ENDDO

 DO I=1,NLAY
  IF(.NOT.IDFREAD(IDF(I,1),IDF(I,1)%FNAME,1))RETURN
  IF(.NOT.IDFREAD(IDF(I,2),IDF(I,2)%FNAME,1))RETURN 
 ENDDO
 
 DO IROW=1,IDF(1,1)%NROW; DO ICOL=1,IDF(1,1)%NCOL
  DO I=NLAY,1,-1
   T=IDF(I,1)%X(ICOL,IROW); B=IDF(I,2)%X(ICOL,IROW)
   IF(T-B.GT.0.0D0)EXIT
   IDF(I,1)%X(ICOL,IROW)=0.0D0
  ENDDO
  DO J=I,1,-1; IDF(J,1)%X(ICOL,IROW)=1.0D0; ENDDO
 ENDDO; ENDDO
 
 CALL UTL_CREATEDIR(RESULTDIR)
 DO I=1,NLAY
  IDF(I,1)%FNAME=TRIM(RESULTDIR)//'\IBOUND_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(IDF(I,1),IDF(I,1)%FNAME,1))RETURN
 ENDDO
 
 END SUBROUTINE IMODBATCH_CREATEIBOUND

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFGEN2GEN3D()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: GENFILE_IN,GENFILE_OUT
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 INTEGER :: I,IOS,ID
 REAL(KIND=DP_KIND) :: XSAMPLING
 INTEGER,DIMENSION(2) :: JU
 REAL(KIND=DP_KIND),DIMENSION(2) :: X,Y
 
 ALLOCATE(IDF(2)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 IF(.NOT.UTL_READINITFILE('GENFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) GENFILE_IN; WRITE(*,'(A)') 'GENFILE_IN='//TRIM(GENFILE_IN)
 IF(.NOT.UTL_READINITFILE('IDF_TOP',LINE,IU,0))RETURN
 READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'IDF_TOP='//TRIM(IDF(1)%FNAME)
 IF(.NOT.UTL_READINITFILE('IDF_BOT',LINE,IU,0))RETURN
 READ(LINE,*) IDF(2)%FNAME; WRITE(*,'(A)') 'IDF_BOT='//TRIM(IDF(2)%FNAME)
 IF(.NOT.UTL_READINITFILE('GENFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) GENFILE_OUT; WRITE(*,'(A)') 'GENFILE_OUT='//TRIM(GENFILE_OUT)
 XSAMPLING=0.0D0; IF(UTL_READINITFILE('XSAMPLING',LINE,IU,1))READ(LINE,*) XSAMPLING
 
 JU(1)=UTL_GETUNIT(); OPEN(JU(1),FILE=GENFILE_IN ,STATUS='OLD'    ,ACTION='READ')
 CALL UTL_CREATEDIR(GENFILE_OUT(:INDEX(GENFILE_OUT,'\',.TRUE.)-1))
 JU(2)=UTL_GETUNIT(); OPEN(JU(2),FILE=GENFILE_OUT,STATUS='UNKNOWN',ACTION='WRITE')
 DO I=1,SIZE(IDF); IF(.NOT.IDFREAD(IDF(I),IDF(I)%FNAME,0))RETURN; ENDDO
 IF(XSAMPLING.EQ.0.0D0)XSAMPLING=IDF(1)%DX
 WRITE(*,'(A,F10.2)') 'XSAMPLING=',XSAMPLING
 
 DO
  READ(JU(1),*,IOSTAT=IOS) ID
  IF(IOS.NE.0)EXIT
  I=0; DO
   I=I+1; READ(JU(1),*,IOSTAT=IOS) X(2),Y(2)
   IF(IOS.NE.0)EXIT
   IF(I.GT.1)CALL IMODBATCH_SAMPLEPOINTS(ID,JU(2),IDF,X,Y,XSAMPLING)
   X(1)=X(2); Y(1)=Y(2)
  ENDDO
 ENDDO
 WRITE(JU(2),*) 'END'
 
 DO I=1,2; CLOSE(JU(I)); ENDDO 
 
 END SUBROUTINE IMODBATCH_IDFGEN2GEN3D
 
 !###======================================================================
 SUBROUTINE IMODBATCH_RUNFILE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER,DIMENSION(4) :: TMPINT1,TMPINT2

 CALL PMANAGER_UTL_INIT()

 IF(UTL_READINITFILE('RUNFILE_IN',LINE,IU,1))THEN

  READ(LINE,*) PBMAN%RUNFILE; WRITE(*,'(A,A)') 'RUNFILE_IN=',TRIM(PBMAN%RUNFILE)
  IF(.NOT.UTL_READINITFILE('PRJFILE_OUT',LINE,IU,0))RETURN
  READ(LINE,*) PBMAN%PRJFILE; WRITE(*,'(A,A)') 'PRJFILE_OUT=',TRIM(PBMAN%PRJFILE)
 
  IF(.NOT.PMANAGERRUN(ID_OPENRUN,PBMAN%RUNFILE,1)  )THEN; WRITE(*,'(/A/)') 'Error reading runfile '//TRIM(PBMAN%RUNFILE); STOP; ENDIF
  IF(.NOT.PMANAGERPRJ(ID_SAVE   ,PBMAN%PRJFILE,1,0))THEN; WRITE(*,'(/A/)') 'Error writing project file '//TRIM(PBMAN%PRJFILE); STOP; ENDIF

 ELSEIF(UTL_READINITFILE('PRJFILE_IN',LINE,IU,1))THEN
 
  READ(LINE,*) PBMAN%PRJFILE; WRITE(*,'(2A)')  'PRJFILE_IN='//TRIM(PBMAN%PRJFILE)
  
  !## read parameters
  IF(.NOT.IMODBATCH_RUNFILE_READ(IU,1))STOP

  CALL WINDOWOPEN(FLAGS=SYSMENUON+HIDEWINDOW+STATUSBAR)
  TMPINT1=[2000,2000,750,-1]; TMPINT2=[1,1,1,1]
  CALL WINDOWSTATUSBARPARTS(4,TMPINT1,TMPINT2)

  IF(.NOT.PMANAGERPRJ(ID_OPEN   ,PBMAN%PRJFILE,1,0))THEN; WRITE(*,'(/A/)') 'Error reading project file '//TRIM(PBMAN%PRJFILE); STOP; ENDIF
  IF(.NOT.PMANAGERRUN(ID_SAVERUN,PBMAN%RUNFILE,1)  )THEN; WRITE(*,'(/A/)') 'Error writing runfile '//TRIM(PBMAN%RUNFILE); STOP; ENDIF

 ELSE

  WRITE(*,'(/A/)') 'Stop not appropriate conversion mode found'; STOP

 ENDIF
 CALL WINDOWCLOSE()

 END SUBROUTINE IMODBATCH_RUNFILE
 
 !###======================================================================
 SUBROUTINE IMODBATCH_FAULTS3D()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: PI=3.1415
 REAL(KIND=DP_KIND),PARAMETER :: RAD=360.0D0/(2.0D0*3.1415D0)
 CHARACTER(LEN=256) :: CSVFILE,GENFILE
 INTEGER :: I,ID,IOS
 REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2,XN1,XN2,YN1,YN2,Z1,Z2,DIPANGLE,DZ,DX,DY,TNG,DIPDIRECTION
 INTEGER,DIMENSION(2) :: JU
 
 IF(.NOT.UTL_READINITFILE('CSVFILE',LINE,IU,0))RETURN
 READ(LINE,*) CSVFILE; WRITE(*,'(A)') 'CSVFILE='//TRIM(CSVFILE)
 IF(.NOT.UTL_READINITFILE('GENFILE',LINE,IU,0))RETURN
 READ(LINE,*) GENFILE; WRITE(*,'(A)') 'GENFILE='//TRIM(GENFILE)

 JU(1)=UTL_GETUNIT(); OPEN(JU(1),FILE=CSVFILE ,STATUS='OLD'    ,ACTION='READ')
 JU(2)=UTL_GETUNIT(); OPEN(JU(2),FILE=GENFILE,STATUS='UNKNOWN',ACTION='WRITE')
 
 READ(JU(1),*)

 ID=0;
 DO
  READ(JU(1),*,IOSTAT=IOS) X1,Y1,X2,Y2,Z1,Z2,DIPDIRECTION,DIPANGLE
  IF(IOS.NE.0)EXIT

  ID=ID+1
  WRITE(JU(2),*) ID
  WRITE(JU(2),'(3F15.7)') X1,Y1,Z1
  WRITE(JU(2),'(3F15.7)') X2,Y2,Z1

  !## get dipangle into radians  
  DIPANGLE=DIPANGLE/RAD
  DIPDIRECTION=DIPDIRECTION/RAD

  !## compute angle of line
  DX=X2-X1; DY=Y2-Y1; IF(DY.EQ.0.0D0)TNG=0.0D0; IF(ABS(DY).GT.0.0D0)TNG=ATAN2(DY,DX)
  TNG=DIPDIRECTION 
  
  !## compute bottom equivalents
  DZ=Z1-Z2
  
  !## get projected distance of fault
  DX=COS(DIPANGLE)*DZ

  !## use this new length to reduced new coordinates perpendicular to line
  XN1=X1+COS(TNG)*DZ; YN1=Y1+SIN(TNG)*DZ
  XN2=X2+COS(TNG)*DZ; YN2=Y2+SIN(TNG)*DZ

  WRITE(JU(2),'(3F15.7)') XN2,YN2,Z2
  WRITE(JU(2),'(3F15.7)') XN1,YN1,Z2
  WRITE(JU(2),*) 'END'
  
 ENDDO
 WRITE(JU(2),*) 'END'
 
 DO I=1,2; CLOSE(JU(I)); ENDDO 
 
 END SUBROUTINE IMODBATCH_FAULTS3D
 
 !###======================================================================
 SUBROUTINE IMODBATCH_SAMPLEPOINTS(ID,JU,IDF,X,Y,XSAMPLING)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: JU,ID
 TYPE(IDFOBJ),DIMENSION(2),INTENT(INOUT) :: IDF
 REAL(KIND=DP_KIND),DIMENSION(2),INTENT(IN) :: X,Y
 REAL(KIND=DP_KIND) :: TD,D,X1,X2,Y1,Y2,DM
 REAL(KIND=DP_KIND),DIMENSION(2) :: Z1,Z2
 REAL(KIND=DP_KIND),INTENT(IN) :: XSAMPLING
 REAL(KIND=DP_KIND) :: DX,DY,OR
 INTEGER :: I
  
 DX=X(2)-X(1); DY=Y(2)-Y(1); DM=0.0D0; IF(DX.NE.0.0D0.OR.DY.NE.0.0D0)DM=SQRT(DX**2.0D0+DY**2.0D0); TD=0.0D0
 X1=X(1); Y1=Y(1); OR=ATAN2(DY,DX)
 I=0; DO
  X2=X1+XSAMPLING*COS(OR); Y2=Y1+XSAMPLING*SIN(OR); D=SQRT((X2-X1)**2.0D0+(Y2-Y1)**2.0D0); TD=TD+D
  IF(TD.GT.DM)THEN; X2=X(2); Y2=Y(2); ENDIF
  Z1(1)=IDFGETXYVAL(IDF(1),X1,Y1); Z2(1)=IDFGETXYVAL(IDF(1),X2,Y2); 
  Z1(2)=IDFGETXYVAL(IDF(2),X1,Y1); Z2(2)=IDFGETXYVAL(IDF(2),X2,Y2); 
  IF(Z1(1).NE.IDF(1)%NODATA.AND.Z2(1).NE.IDF(1)%NODATA.AND. &
     Z1(2).NE.IDF(2)%NODATA.AND.Z2(2).NE.IDF(2)%NODATA)THEN
   I=I+1; WRITE(JU,'(I5.5,A1,I5.5)') ID,'-',I
   WRITE(JU,*) X1,Y1,Z1(1); WRITE(JU,*) X1,Y1,Z2(2)
   WRITE(JU,*) X2,Y2,Z1(2); WRITE(JU,*) X2,Y2,Z2(1)
   WRITE(JU,*) X1,Y1,Z1(1)
   WRITE(JU,*) 'END'
  ENDIF
  IF(TD.GT.DM)EXIT
  X1=X2; Y1=Y2
 ENDDO

 END SUBROUTINE IMODBATCH_SAMPLEPOINTS

 !###======================================================================
 SUBROUTINE IMODBATCH_ISGEXPORT()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE,EXPORTFNAME,LINE
 INTEGER :: IEXPORT

 EXPORTFNAME=''

 IF(.NOT.UTL_READINITFILE('ISGFILE',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE='//TRIM(ISGFILE)

 IF(.NOT.UTL_READINITFILE('IEXPORT',LINE,IU,0))RETURN
 READ(LINE,*) IEXPORT
 SELECT CASE (IEXPORT)
  CASE (1)
   LINE='IEXPORT='//TRIM(ITOS(IEXPORT))//' exporting stages'
   WRITE(*,'(A)') TRIM(LINE)
  CASE (2)
   LINE='IEXPORT='//TRIM(ITOS(IEXPORT))//' exporting cross-sections'
   WRITE(*,'(A)') TRIM(LINE)
  CASE (0)
   LINE='IEXPORT='//TRIM(ITOS(IEXPORT))//' exporting all'
   WRITE(*,'(A)') TRIM(LINE)
  CASE DEFAULT
   STOP 'No proper value for IEXPORT given'
 END SELECT
 
 IF(IEXPORT.NE.0)THEN
  IF(.NOT.UTL_READINITFILE('EXPORTFNAME',LINE,IU,0))RETURN
  READ(LINE,*) EXPORTFNAME; WRITE(*,'(A)') 'EXPORTFNAME='//TRIM(EXPORTFNAME)
 ELSE
  IF(.NOT.UTL_READINITFILE('EXPORTMAP',LINE,IU,0))RETURN
  READ(LINE,*) EXPORTFNAME; WRITE(*,'(A)') 'EXPORTMAP='//TRIM(EXPORTFNAME)
  CALL UTL_CREATEDIR(EXPORTFNAME)
 ENDIF
 
 CALL ISG_EXPORT(ISGFILE,EXPORTFNAME,IEXPORT,1)
  
 END SUBROUTINE IMODBATCH_ISGEXPORT
   
 !###======================================================================
 SUBROUTINE IMODBATCH_ISGIMPORT()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE,EXPORTFNAME,LINE

 ISGDOUBLE=0
 
 IF(.NOT.UTL_READINITFILE('ISGEXPORT',LINE,IU,0))RETURN
 READ(LINE,*) EXPORTFNAME; WRITE(*,'(A)') 'ISGEXPORT='//TRIM(EXPORTFNAME)
 IF(.NOT.UTL_READINITFILE('ISGFILE',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE='//TRIM(ISGFILE)
 IF(UTL_READINITFILE('ISGDOUBLE',LINE,IU,1))READ(LINE,*) ISGDOUBLE
 WRITE(*,'(A)') 'ISGDOUBLE='//TRIM(ITOS(ISGDOUBLE))

 ISGDOUBLE=(ISGDOUBLE+1)*4

 CALL ISG_IMPORT(ISGFILE,EXPORTFNAME) !,1)
  
 END SUBROUTINE IMODBATCH_ISGIMPORT

 !###======================================================================
 SUBROUTINE IMODBATCH_ISGADDSTAGES()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IPFFILE,ISGFILE
 INTEGER :: STAGETYPE,ICLEAN
 
 IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IPFFILE; WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFILE)

 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)
 
 STAGETYPE=0; IF(UTL_READINITFILE('STAGETYPE',LINE,IU,1))READ(LINE,*) STAGETYPE
 LINE='STAGETYPE='//TRIM(ITOS(STAGETYPE)); WRITE(*,'(A)') TRIM(LINE)

 ICLEAN=0; IF(UTL_READINITFILE('ICLEAN',LINE,IU,1))READ(LINE,*) ICLEAN
 LINE='ICLEAN='//TRIM(ITOS(ICLEAN)); WRITE(*,'(A)') TRIM(LINE)

 IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN

 CALL ISG_ADDSTAGES(ISGFILE,IPFFILE,1,STAGETYPE,ICLEAN)

 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A/)') 'Writing updated ISG file ...'
 CALL ISGSAVE(ISGFILE,2) !- saving ONLY *.ISG, *.isp, *.isd
 
 END SUBROUTINE IMODBATCH_ISGADDSTAGES
  
 !###======================================================================
 SUBROUTINE IMODBATCH_ISGADDCROSSSECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE,FNAME,WIDTHFNAME,CROSS_PNTR,CROSS_BATH,CROSS_ZCHK,CROSS_CVAL
 REAL(KIND=DP_KIND) :: MAXDIST
 INTEGER :: ICLEAN

 MAXDIST=0.0D0; ICLEAN=1; CROSS_PNTR=''; CROSS_BATH=''; WIDTHFNAME=''
 IF(UTL_READINITFILE('CROSSSECTION_IN',LINE,IU,1))THEN
  READ(LINE,*) FNAME; WRITE(*,'(A)') 'CROSSSECTION_IN='//TRIM(FNAME)
  IF(UTL_READINITFILE('ICLEAN',LINE,IU,0))READ(LINE,*) ICLEAN
  WRITE(*,'(A,I1)') 'ICLEAN=',ICLEAN
  IF(ICLEAN.LT.1.OR.ICLEAN.GT.2)STOP 'ICLEAN NEED TO BE 1 OR 2'
  IF(ICLEAN.EQ.1)THEN
   IF(.NOT.UTL_READINITFILE('WIDTH_IDF',LINE,IU,0))RETURN
   READ(LINE,*) WIDTHFNAME; WRITE(*,'(A)') 'WIDTH_IDF='//TRIM(WIDTHFNAME)
  ENDIF
  IF(UTL_READINITFILE('MAXDIST',LINE,IU,1))READ(LINE,*) MAXDIST
  WRITE(*,'(A,F10.2)') 'MAXDIST=',MAXDIST
 ELSE
  IF(.NOT.UTL_READINITFILE('CROSS_PNTR',LINE,IU,0))RETURN
  READ(LINE,*) CROSS_PNTR; WRITE(*,'(A)') 'CROSS_PNTR='//TRIM(CROSS_PNTR)
  IF(.NOT.UTL_READINITFILE('CROSS_BATH',LINE,IU,0))RETURN
  READ(LINE,*) CROSS_BATH; WRITE(*,'(A)') 'CROSS_BATH='//TRIM(CROSS_BATH)
  CROSS_ZCHK=''; IF(UTL_READINITFILE('CROSS_ZCHK',LINE,IU,1))THEN
   READ(LINE,*) CROSS_ZCHK; WRITE(*,'(A)') 'CROSS_ZCHK='//TRIM(CROSS_ZCHK)
  ENDIF
  CROSS_CVAL=''; IF(UTL_READINITFILE('CROSS_CVAL',LINE,IU,1))THEN
   READ(LINE,*) CROSS_CVAL; WRITE(*,'(A)') 'CROSS_CVAL='//TRIM(CROSS_CVAL)
  ENDIF
 ENDIF

 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)

 IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN

 CALL ISG_ADDCROSSSECTION(ISGFILE,FNAME,WIDTHFNAME,MAXDIST,CROSS_PNTR,CROSS_BATH,CROSS_ZCHK,CROSS_CVAL,1,ICLEAN)
 
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A/)') 'Writing updated ISG file ...'
 CALL ISGSAVE(ISGFILE,2) !- saving ONLY *.ISG, *.isp, *.isd
 
 END SUBROUTINE IMODBATCH_ISGADDCROSSSECTION
 
 !###======================================================================
 SUBROUTINE IMODBATCH_ISGADDSTRUCTURES()
 !###======================================================================
 USE MOD_ISG_STRUCTURES
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE
   
 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) STRUCIPFFNAME; WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(STRUCIPFFNAME)

 IX=1; IY=2; ID=3; IO=4; IS=5; IW=6; MAXDIST=1000.0D0; SY=1980; EY=2012
 CSPS='01-04'; CEPS='30-09'; CSPW='01-10'; CEPW='31-03'; CMD='0-0-0'; LOGFNAME='log.ipf'; ICORDIR=0
 
 !## x coordinate
 IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IX; WRITE(*,'(A,I2)') 'IXCOL=',IX
 !## y coordinate
 IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IY; WRITE(*,'(A,I2)') 'IYCOL=',IY
 !## identification
 IF(UTL_READINITFILE('IDCOL',LINE,IU,1))READ(LINE,*) ID; WRITE(*,'(A,I2)') 'IDCOL=',ID
 !## orientation
 IF(UTL_READINITFILE('IOCOL',LINE,IU,1))READ(LINE,*) IO; WRITE(*,'(A,I2)') 'IOCOL=',IO
 !## summer level
 IF(UTL_READINITFILE('ISCOL',LINE,IU,1))READ(LINE,*) IS; WRITE(*,'(A,I2)') 'ISCOL=',IS
 !## winter level
 IF(UTL_READINITFILE('IWCOL',LINE,IU,1))READ(LINE,*) IWISG; WRITE(*,'(A,I2)') 'IWCOL=',IWISG
 !## Maximum Distance to asign structure to segment (meters)
 IF(UTL_READINITFILE('MAXDIST',LINE,IU,1))READ(LINE,*) MAXDIST; WRITE(*,'(A,F10.2)') 'MAXDIST=',MAXDIST
 !## start period
 IF(UTL_READINITFILE('START_YEAR',LINE,IU,1))READ(LINE,*) SY; WRITE(*,'(A,I4)') 'START_YEAR=',SY
 !## end period
 IF(UTL_READINITFILE('END_YEAR',LINE,IU,1))READ(LINE,*) EY; WRITE(*,'(A,I4)') 'END_YEAR=',EY
 !## start summer period
 IF(UTL_READINITFILE('START_PERIOD_SUMMER',LINE,IU,1))READ(LINE,*) CSPS; WRITE(*,'(A)') 'START_PERIOD_SUMMER='//TRIM(CSPS)
 !## end summer period
 IF(UTL_READINITFILE('END_PERIOD_SUMMER',LINE,IU,1))  READ(LINE,*) CEPS; WRITE(*,'(A)') 'END_PERIOD_SUMMER='//TRIM(CEPS)
 !## start winter period
 IF(UTL_READINITFILE('START_PERIOD_WINTER',LINE,IU,1))READ(LINE,*) CSPW; WRITE(*,'(A)') 'START_PERIOD_WINTER='//TRIM(CSPW)
 !## end winter period
 IF(UTL_READINITFILE('END_PERIOD_WINTER',LINE,IU,1))  READ(LINE,*) CEPW; WRITE(*,'(A)') 'END_PERIOD_WINTER='//TRIM(CEPW)
 !## date of measure to be sued to compute undisturbed waterlevel
 !## give 0-0-0 to compute the mean of all values (e.g. 28-02-1994 or 0-0-0)
 IF(UTL_READINITFILE('DATE_WLEVEL',LINE,IU,1))READ(LINE,*) CMD; WRITE(*,'(A)') 'DATE_WLEVEL='//TRIM(CMD)
 !## logfile
 IF(UTL_READINITFILE('IPFLOGFILE',LINE,IU,1)) READ(LINE,*) LOGFNAME; WRITE(*,'(A)') 'IPFLOGFILE='//TRIM(LOGFNAME)

 IF(UTL_READINITFILE('ICORDIR',LINE,IU,1))READ(LINE,*) ICORDIR; WRITE(*,'(A,I2)') 'ICORDIR=',ICORDIR

 IBATCH=1
 IF(ISG_ADDSTRUCTURES(ISGFILE))THEN 
  IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN
  READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
  WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
  WRITE(*,'(/A/)') 'Writing updated ISG file ...'
  CALL ISGSAVE(ISGFILE,2) !- saving ONLY *.ISG, *.isp, *.isd
 ENDIF
 
 !## deallocate memory
 CALL ISGDEAL(1)
 
 END SUBROUTINE IMODBATCH_ISGADDSTRUCTURES

 !###======================================================================
 SUBROUTINE IMODBATCH_FOSM()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: COVFILE,SENSDIR
 INTEGER :: JU,I,J,N,NLAYERS,NDATES
 INTEGER,POINTER,DIMENSION(:) :: ILAYERS
 CHARACTER(LEN=32),POINTER,DIMENSION(:) :: CDATES
 TYPE(PARAMOBJ),ALLOCATABLE,DIMENSION(:) :: PARAM

 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: COV
 
 !## get covariance file
 IF(UTL_READINITFILE('COVFILE',LINE,IU,1))READ(LINE,*) COVFILE
 WRITE(*,'(A)') 'COVFILE='//TRIM(COVFILE)

 JU=UTL_GETUNIT(); OPEN(JU,FILE=COVFILE,STATUS='OLD',ACTION='READ')
 READ(JU,*) N; ALLOCATE(PARAM(N)); ALLOCATE(COV(N,N)); COV=0.0D0
 DO I=1,N; READ(JU,'(A2,3I3,A16)') PARAM(I)%PTYPE,PARAM(I)%ILS,PARAM(I)%IZONE,PARAM(I)%IGROUP,PARAM(I)%ACRONYM; ENDDO
 READ(JU,*); READ(JU,*); READ(JU,*); READ(JU,*)
 DO I=1,N; READ(JU,'(A15,99F15.0)') PARAM(I)%ACRONYM,(COV(I,J),J=1,N); ENDDO
 CLOSE(JU)

 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,ILAYERS,'ILAYERS',0))RETURN
 DO I=1,NLAYERS; WRITE(*,'(1X,I3,A4)') I,','//TRIM(ITOS(ILAYERS(I))); ENDDO

 IF(.NOT.UTL_READPOINTER_CHARACTER(IU,NDATES,CDATES,'CDATES',0))RETURN
 DO I=1,NDATES; WRITE(*,'(1X,A)') I,','//TRIM(CDATES(I)); ENDDO

 !## get sensitivities
 IF(.NOT.UTL_READINITFILE('SENSDIR',LINE,IU,0))RETURN
 READ(LINE,*) SENSDIR; WRITE(*,'(A)') 'SENSDIR='//TRIM(SENSDIR)

 DO I=1,NDATES
  DO J=1,NLAYERS
   CALL IMODBATCH_COMPUTE_FOSM(N,COV,ILAYERS(J),CDATES(I),SENSDIR,PARAM)
  ENDDO
 ENDDO
 
 END SUBROUTINE IMODBATCH_FOSM
 
 !#####=================================================================
 SUBROUTINE IMODBATCH_COMPUTE_FOSM(N,COV,ILAY,CDATE,SENSDIR,PARAM)
 !#####=================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: N,ILAY
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(N,N) :: COV
 CHARACTER(LEN=*),INTENT(IN) :: CDATE,SENSDIR
 TYPE(PARAMOBJ),DIMENSION(N),INTENT(IN) :: PARAM
 INTEGER :: I,J,II,IROW,ICOL
 TYPE(IDFOBJ) :: H
 CHARACTER(LEN=256) :: FNAME
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: JCBN
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: PROW

 CALL UTL_CREATEDIR(TRIM(SENSDIR)//CHAR(92)//'UNCERTAINTY')
 
 DO J=1,SIZE(PARAM)
  FNAME=TRIM(SENSDIR)//CHAR(92)//'HEAD_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'_SENS_'// &
        TRIM(PARAM(J)%PTYPE)//'_IGROUP'//TRIM(ITOS(PARAM(J)%IGROUP))//'.IDF'
  WRITE(*,'(A)') 'Reading '//TRIM(FNAME)//' ...'
  IF(.NOT.IDFREAD(H,FNAME,1))RETURN
  IF(J.EQ.1)ALLOCATE(JCBN(H%NCOL*H%NROW,N),PROW(N))
  II=0; DO IROW=1,H%NROW; DO ICOL=1,H%NCOL
   II=II+1; JCBN(II,J)=H%X(ICOL,IROW)
  ENDDO; ENDDO
 ENDDO
 
 !    II=(ILAY-1)*NCOL*NROW
 !    DO IROW=1,NROW; DO ICOL=1,NCOL
 !     II=II+1
 !     JCBN(II,J)=H(1)%X(ICOL,IROW)
 !    ENDDO; ENDDO

 !## received the variance per location
 H%X=0.0

 !## compute jcbn*cov*jcbn, process per row
 ICOL=0; IROW=1; DO II=1,H%NROW*H%NCOL

  ICOL=ICOL+1; IF(ICOL.GT.H%NCOL)THEN; ICOL=1; IROW=IROW+1; ENDIF

  PROW=0.0
  DO I=1,N; DO J=1,N
   PROW(I)=PROW(I)+JCBN(II,I)*COV(I,J)
  ENDDO; ENDDO
  H%X(ICOL,IROW)=0.0
  DO I=1,N
   H%X(ICOL,IROW)=H%X(ICOL,IROW)+PROW(I)*PROW(I)
  ENDDO
  H%X(ICOL,IROW)=SQRT(H%X(ICOL,IROW))
 
 ENDDO

! !## compute jcbn*cov*jcbn, process per row
 ! IROW=1; ICOL=0; ILAY=1
 ! DO II=1,NODES
 !  ICOL=ICOL+1
 !  IF(ICOL.GT.NCOL)THEN
 !   IROW=IROW+1
 !   ICOL=1
 !  ENDIF
 !  PROW=0.0;
 !  DO I=1,NP
 !   DO J=1,NP
 !    PROW(I)=PROW(I)+JCBN(II,I)*COV(I,J)
 !   ENDDO
 !  ENDDO
 !  H(1)%X(ICOL,IROW)=0.0
 !  DO I=1,NP
 !   H(1)%X(ICOL,IROW)=H(1)%X(ICOL,IROW)+PROW(I)*PROW(I)
 !  ENDDO
 !  H(1)%X(ICOL,IROW)=SQRT(H(1)%X(ICOL,IROW))

 !## schrijf laatste modellayer
 FNAME=TRIM(SENSDIR)//CHAR(92)//'UNCERTAINTY'//CHAR(92)//'UNCERTAINTY_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
 WRITE(*,'(A)') 'Writing '//TRIM(FNAME)//' ...'
 IF(.NOT.IDFWRITE(H,FNAME,0))RETURN
 
 CALL IDFDEALLOCATEX(H); DEALLOCATE(JCBN,PROW)

 END SUBROUTINE IMODBATCH_COMPUTE_FOSM
 
!!#####=================================================================
 !SUBROUTINE PESTWRITESTATISTICS_FOSM(NP,COV)
 !!#####=================================================================
 !USE VERSION, ONLY : CVERSION
 !USE IMOD_IDF
 !USE GLBVAR, ONLY : CDATE_SIM
 !IMPLICIT NONE
 !INTEGER,INTENT(IN) :: NP
 !DOUBLE PRECISION,INTENT(IN),DIMENSION(NP,NP) :: COV
 !INTEGER :: II,I,J,IPER,ILAY,IROW,ICOL
 !TYPE(IDFOBJ),DIMENSION(1) :: H
 !CHARACTER(LEN=256) :: FNAME
 !REAL,ALLOCATABLE,DIMENSION(:,:) :: JCBN
 !REAL,ALLOCATABLE,DIMENSION(:) :: PROW
 ! 
 !J=NP
 !ALLOCATE(JCBN(NCOL*NROW*NLAY,J),PROW(J))
 
 !
 !    II=(ILAY-1)*NCOL*NROW
 !    DO IROW=1,NROW; DO ICOL=1,NCOL
 !     II=II+1
 !     JCBN(II,J)=H(1)%X(ICOL,IROW)
 !    ENDDO; ENDDO
 !
 ! 
 ! !## received the variance per location
 ! H(1)%X=0.0
 !
 ! !## compute jcbn*cov*jcbn, process per row
 ! IROW=1; ICOL=0; ILAY=1
 ! DO II=1,NODES
 !  ICOL=ICOL+1
 !  IF(ICOL.GT.NCOL)THEN
 !   IROW=IROW+1
 !   ICOL=1
 !  ENDIF
 !  PROW=0.0;
 !  DO I=1,NP
 !   DO J=1,NP
 !    PROW(I)=PROW(I)+JCBN(II,I)*COV(I,J)
 !   ENDDO
 !  ENDDO
 !  H(1)%X(ICOL,IROW)=0.0
 !  DO I=1,NP
 !   H(1)%X(ICOL,IROW)=H(1)%X(ICOL,IROW)+PROW(I)*PROW(I)
 !  ENDDO
 !  H(1)%X(ICOL,IROW)=SQRT(H(1)%X(ICOL,IROW))
 ! 
 ! ENDDO
 !
 ! !## schrijf laatste modellayer
 ! FNAME=TRIM(ROOTRES)//CHAR(92)//'uncertainty\uncertainty_'//TRIM(CDATE_SIM(IPER))//'_l'//TRIM(ITOS(ILAY))//'.idf'
 ! CALL IMOD_UTL_PRINTTEXT('Writing '//TRIM(FNAME),0) 
 ! IF(.NOT.IDFWRITE(H(1),FNAME,0))CALL IMOD_UTL_PRINTTEXT('Can not write: '//TRIM(FNAME),2)
  
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATELAYERS_MAIN()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),DIMENSION(:),ALLOCATABLE :: IDF
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 INTEGER :: I,ILAY,NLAY,IROW,ICOL,ILEVEL
 REAL(KIND=DP_KIND) :: INILEVEL,Z,D
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: DZVAL

 I=2; ALLOCATE(IDF(I)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

 IF(.NOT.UTL_READINITFILE('LEVELIDF',LINE,IU,0))RETURN
 READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'LEVELIDF='//TRIM(IDF(1)%FNAME)

 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) IDF(1)%XMIN,IDF(1)%YMIN,IDF(1)%XMAX,IDF(1)%YMAX
  WRITE(*,'(A,4F15.2)') 'WINDOW=',IDF(1)%XMIN,IDF(1)%YMIN,IDF(1)%XMAX,IDF(1)%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%DX; WRITE(*,'(A,4F10.2)') 'CELLSIZE=',IDF(1)%DX; IDF(1)%DY=IDF(1)%DX
  CALL UTL_IDFSNAPTOGRID_LLC(IDF(1)%XMIN,IDF(1)%XMAX,IDF(1)%YMIN,IDF(1)%YMAX,IDF(1)%DX,IDF(1)%DY,IDF(1)%NCOL,IDF(1)%NROW,.TRUE.)
 ENDIF
 
 IF(.NOT.IDFREADSCALE(IDF(1)%FNAME,IDF(1),2,1,0.0D0,0))THEN; RETURN; ENDIF

 IF(.NOT.UTL_READPOINTER_REAL(IU,I,DZVAL,'DZVAL',0,EXCLVALUE=0.0D0))RETURN
 DO I=1,SIZE(DZVAL)
  IF(DZVAL(I).LE.0.0D0)THEN
   LINE='DZ('//TRIM(ITOS(I))//')='//TRIM(RTOS(DZVAL(I),'F',3))
   WRITE(*,'(A)') TRIM(LINE)//' which is not allowed'
  ENDIF
 ENDDO
 NLAY=SIZE(DZVAL)
 
 ILEVEL=0
 IF(UTL_READINITFILE('INILEVEL',LINE,IU,1))THEN
  READ(LINE,*) INILEVEL; WRITE(*,'(A)') 'INILEVEL='//TRIM(RTOS(INILEVEL,'F',2))
  ILEVEL=1
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

! IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,1))RETURN
 CALL IDFCOPY(IDF(1),IDF(2))
 Z=0.0D0; IF(ILEVEL.EQ.1)Z=INILEVEL+DZVAL(1)
 DO ILAY=1,NLAY
  Z=Z-DZVAL(ILAY)
  DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
   IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE
   IF(ILEVEL.EQ.0)THEN
    IDF(2)%X(ICOL,IROW)=IDF(1)%X(ICOL,IROW)-DZVAL(ILAY)
   ELSE
    D=IDF(1)%X(ICOL,IROW)-Z
    D=MAX(DZVAL(ILAY)*0.5,D)
    IDF(2)%X(ICOL,IROW)=IDF(1)%X(ICOL,IROW)-D
   ENDIF
   IDF(1)%X(ICOL,IROW)=IDF(2)%X(ICOL,IROW)
  ENDDO; ENDDO
  IDF(2)%FNAME=TRIM(OUTPUTFOLDER)//'\INT_L'//TRIM(ITOS(ILAY))//'.IDF'
  IF(.NOT.IDFWRITE(IDF(2),IDF(2)%FNAME,1))EXIT
  WRITE(*,'(A)') TRIM(ITOS(ILAY))//' of '//TRIM(ITOS(NLAY))//': INT_L'//TRIM(ITOS(ILAY))//'.IDF'
 ENDDO
 
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 
 END SUBROUTINE IMODBATCH_CREATELAYERS_MAIN
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATESOF()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),DIMENSION(:),ALLOCATABLE :: IDF
 TYPE(IDFOBJ),DIMENSION(:,:),ALLOCATABLE :: TQP
 INTEGER :: I,J,IFLOW,IPNTR,IWINDOW,IWRITE,IGRAD,ITQP,NTQP,TTQP,IFORMAT,MINFRICTION,NQDW
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: PTQP
 REAL(KIND=DP_KIND),DIMENSION(:,:),POINTER :: QDW
 CHARACTER(LEN=256) :: RESULTIDF,OUTPUTFOLDER,FNAME
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX,CELLSIZE,MINQ,RAIN
 
 IPNTR=0; IWINDOW=0; IGRAD=0
 
 IF(.NOT.UTL_READINITFILE('IFLOW',LINE,IU,0))RETURN
 READ(LINE,*) IFLOW; WRITE(*,'(A,I1)') 'IFLOW=',IFLOW
 
 !## compute d-infinity matrix and surface overland flow level
 IF(IFLOW.EQ.0)THEN

  I=6; ALLOCATE(IDF(I)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

  IF(.NOT.UTL_READINITFILE('LEVELIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'LEVELIDF='//TRIM(IDF(1)%FNAME)
  IF(UTL_READINITFILE('OUTLETIDF',LINE,IU,1))THEN
   IPNTR=1; READ(LINE,*) IDF(5)%FNAME; WRITE(*,'(A)') 'OUTLETIDF='//TRIM(IDF(5)%FNAME)
  ENDIF
  
  IF(.NOT.UTL_READINITFILE('SOFIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(3)%FNAME; WRITE(*,'(A)') 'SOFIDF='//TRIM(IDF(3)%FNAME)

  IF(UTL_READINITFILE('IGRAD',LINE,IU,1))READ(LINE,*) IGRAD
  WRITE(*,'(A,I2)') 'IGRAD=',IGRAD
  
  IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
   READ(LINE,*) XMIN,YMIN,XMAX,YMAX; IWINDOW=1
   WRITE(*,'(A,4F15.2)') 'WINDOW=',XMIN,YMIN,XMAX,YMAX
   IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
   READ(LINE,*) CELLSIZE; WRITE(*,'(A,4F10.2)') 'CELLSIZE=',CELLSIZE
  ENDIF
  
  !## compute sof-area with spill levels
  CALL SOF_MAIN(IDF,IPNTR,IWINDOW,XMIN,YMIN,XMAX,YMAX,CELLSIZE,IGRAD) 
 
 ELSEIF(IFLOW.EQ.1)THEN
 
  I=8; ALLOCATE(IDF(I)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

  IF(.NOT.UTL_READINITFILE('ASPECTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'ASPECTIDF='//TRIM(IDF(1)%FNAME)

  IF(.NOT.UTL_READINITFILE('LEVELIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(5)%FNAME; WRITE(*,'(A)') 'LEVELIDF='//TRIM(IDF(5)%FNAME)
  IF(.NOT.UTL_READINITFILE('SLOPEIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(6)%FNAME; WRITE(*,'(A)') 'SLOPEIDF='//TRIM(IDF(6)%FNAME)

  IF(.NOT.UTL_READINITFILE('COUNTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(2)%FNAME; WRITE(*,'(A)') 'COUNTIDF='//TRIM(IDF(2)%FNAME)
  IF(.NOT.UTL_READINITFILE('SLOPE_OUTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(7)%FNAME; WRITE(*,'(A)') 'SLOPE_OUTIDF='//TRIM(IDF(7)%FNAME)
  IF(.NOT.UTL_READINITFILE('LEVEL_OUTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(8)%FNAME; WRITE(*,'(A)') 'LEVEL_OUTIDF='//TRIM(IDF(8)%FNAME)

  IWRITE=0; IF(UTL_READINITFILE('IWRITE',LINE,IU,1))READ(LINE,*) IWRITE
  WRITE(*,'(A,I10)') 'IWRITE=',IWRITE

  IDF(4)%FNAME=''; IF(UTL_READINITFILE('DISZONEIPF',LINE,IU,1))THEN
   READ(LINE,*) IDF(4)%FNAME; WRITE(*,'(A)') 'DISZONEIPF='//TRIM(IDF(4)%FNAME)
  ENDIF

  CALL SOF_TRACE(IDF,SIZE(IDF),IWRITE)

 ELSEIF(IFLOW.EQ.2)THEN

  I=2; ALLOCATE(IDF(I)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

  IF(.NOT.UTL_READINITFILE('COUNTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'COUNTIDF='//TRIM(IDF(1)%FNAME)

  !## whenever itqp.eq.1 read the tqpidf files, create them otherwise
  IF(.NOT.UTL_READINITFILE('ITQP',LINE,IU,0))RETURN
  READ(LINE,*) ITQP; WRITE(*,'(A,I10)') 'ITQP=',ITQP

  MINQ=0.0D0; IF(ITQP.EQ.1)THEN
   !## whenever itqp.eq.1 read the tqpidf files, create them otherwise
   IF(.NOT.UTL_READINITFILE('MINQ',LINE,IU,0))RETURN
   READ(LINE,*) MINQ; WRITE(*,'(A,F10.2)') 'MINQ=',MINQ
  ENDIF
  
  !## decide to have a total p50 or a monthly p50
  IF(.NOT.UTL_READINITFILE('TTQP',LINE,IU,0))RETURN
  READ(LINE,*) TTQP; WRITE(*,'(A,I10)') 'TTQP=',TTQP

  !## read number of percentiles
  IF(.NOT.UTL_READINITFILE('NTQP',LINE,IU,0))RETURN
  READ(LINE,*) NTQP; WRITE(*,'(A,I10)') 'NTQP=',NTQP

  I=NTQP; J=1+11*TTQP; ALLOCATE(TQP(I,J),PTQP(I))
  DO I=1,SIZE(TQP,1); DO J=1,SIZE(TQP,2); CALL IDFNULLIFY(TQP(I,J)); ENDDO; ENDDO

  !## read percentiles of discharge groups
  DO I=1,NTQP
   IF(.NOT.UTL_READINITFILE('PTQP'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) PTQP(I); LINE='PTQP'//TRIM(ITOS(I))//'='//TRIM(RTOS(PTQP(I),'F',2)); WRITE(*,'(A)') TRIM(LINE)
  ENDDO

  !## read result folder with data to be traced
  IF(.NOT.UTL_READINITFILE('RESULTIDF',LINE,IU,0))RETURN
  READ(LINE,*) RESULTIDF; WRITE(*,'(A)') 'RESULTIDF='//TRIM(RESULTIDF)
  !## read output folder
  IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
  READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

  !## read in name of the output of the discharge per percentile
  DO I=1,NTQP
   TQP(I,1)%FNAME=''; IF(.NOT.UTL_READINITFILE('TQPIDF'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) FNAME
   IF(TTQP.EQ.1)THEN
    DO J=1,12
     TQP(I,J)%FNAME=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'_'//CDATE_SHORT(J)//'.IDF'
     WRITE(*,'(A)') 'TQPIDF'//TRIM(ITOS(I))//'_'//TRIM(ITOS(J))//'='//TRIM(TQP(I,J)%FNAME)
    ENDDO
   ELSE
    TQP(I,1)%FNAME=FNAME
    WRITE(*,'(A)') 'TQPIDF'//TRIM(ITOS(I))//'='//TRIM(TQP(I,1)%FNAME)
   ENDIF
  ENDDO

  CALL SOF_CATCHMENTS(RESULTIDF,OUTPUTFOLDER,IDF,TQP,PTQP,ITQP,TTQP,MINQ)

 !## create river input
 ELSEIF(IFLOW.EQ.3)THEN
 
  IF(.NOT.UTL_READINITFILE('IFORMAT',LINE,IU,0))RETURN
  READ(LINE,*) IFORMAT; WRITE(*,'(A,I10)') 'IFORMAT=',IFORMAT

  !## read catchment rainfall (mm/d)
  RAIN=1.0D0; IF(UTL_READINITFILE('RAIN',LINE,IU,1))READ(LINE,*) RAIN
  WRITE(*,'(A,F10.2)') 'RAIN=',RAIN
  MINFRICTION=0; IF(UTL_READINITFILE('MINFRICTION',LINE,IU,1))READ(LINE,*) MINFRICTION
  WRITE(*,'(A,I10)') 'MINFRICTION=',MINFRICTION

  NQDW=0; IF(UTL_READINITFILE('NQDW',LINE,IU,1))READ(LINE,*) NQDW
  IF(NQDW.GT.0)THEN
   WRITE(*,'(A,I10)') 'NQDW=',NQDW
   ALLOCATE(QDW(NQDW,3))
   !## q in m3/seconds
   DO I=1,NQDW
    IF(UTL_READINITFILE('QDW'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) QDW(I,1),QDW(I,2),QDW(I,3)
    LINE='QDW'//TRIM(ITOS(I)); WRITE(*,'(A,3(F10.2,A1))') TRIM(LINE)//'=',QDW(I,1),',',QDW(I,2),',',QDW(I,3)
   ENDDO
  ENDIF
   
  I=9; ALLOCATE(IDF(I)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

  IF(.NOT.UTL_READINITFILE('COUNTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'COUNTIDF='//TRIM(IDF(1)%FNAME)
  IF(.NOT.UTL_READINITFILE('SLOPEIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(2)%FNAME; WRITE(*,'(A)') 'SLOPEIDF='//TRIM(IDF(2)%FNAME)
  IF(.NOT.UTL_READINITFILE('ASPECTIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(3)%FNAME; WRITE(*,'(A)') 'ASPECTIDF='//TRIM(IDF(3)%FNAME)
  IF(.NOT.UTL_READINITFILE('LEVELIDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(4)%FNAME; WRITE(*,'(A)') 'LEVELIDF='//TRIM(IDF(4)%FNAME)

  IF(.NOT.UTL_READINITFILE('RCND_IDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(5)%FNAME; WRITE(*,'(A)') 'RCOND_IDF='//TRIM(IDF(5)%FNAME)
  IF(.NOT.UTL_READINITFILE('RSTG_IDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(6)%FNAME; WRITE(*,'(A)') 'RSTG_IDF='//TRIM(IDF(6)%FNAME)
  IF(.NOT.UTL_READINITFILE('RBOT_IDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(7)%FNAME; WRITE(*,'(A)') 'RBOT_IDF='//TRIM(IDF(7)%FNAME)
  IF(.NOT.UTL_READINITFILE('RINF_IDF',LINE,IU,0))RETURN
  READ(LINE,*) IDF(8)%FNAME; WRITE(*,'(A)') 'RINF_IDF='//TRIM(IDF(8)%FNAME)

  CALL SOF_EXPORT(IDF,SIZE(IDF),IFORMAT,RAIN,MINFRICTION,QDW)

 ENDIF
 
 CALL IDFDEALLOCATE(IDF,SIZE(IDF))
 
 END SUBROUTINE IMODBATCH_CREATESOF

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFTRACE_MAIN()
 !###======================================================================
 USE MOD_IDFEDIT_TRACE
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 INTEGER :: I,IROW,ICOL,JROW,JCOL,IPZ,JPZ,MINT
 INTEGER(KIND=1),POINTER,DIMENSION(:) :: ISPEC
 INTEGER(KIND=2),POINTER,DIMENSION(:,:) :: THREAD,YSEL
 INTEGER :: MAXTHREAD,NTHREAD,MAXN,DTERM,IMENU
 
 ALLOCATE(IDF(2));DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

 IF(.NOT.UTL_READINITFILE('IDF_IN',LINE,IU,0))RETURN
 READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'IDF_IN='//TRIM(IDF(1)%FNAME)
 IF(.NOT.UTL_READINITFILE('IDF_OUT',LINE,IU,0))RETURN
 READ(LINE,*) IDF(2)%FNAME; WRITE(*,'(A)') 'IDF_OUT='//TRIM(IDF(2)%FNAME)
 MINT=0; IF(UTL_READINITFILE('MINT',LINE,IU,1))THEN
  READ(LINE,*) MINT; WRITE(*,'(A,I10)') 'MINT=',MINT
 ENDIF
 
 WRITE(*,'(A)') 'Reading '//TRIM(IDF(1)%FNAME)
 IF(.NOT.IDFREAD(IDF(1),IDF(1)%FNAME,1))RETURN
 CALL IDFCOPY(IDF(1),IDF(2))
  
 IMENU= 4 ! greater than zero6 !## not equal
 DTERM= 1 !## 9-points
 IPZ  = 0 !## pointer value

 MAXTHREAD=1000; ALLOCATE(ISPEC(MAXTHREAD),THREAD(3,MAXTHREAD),YSEL(2,MAXTHREAD)); MAXN=MAXTHREAD
 
 WRITE(6,'(1X,A)') 'Tracing '
 
 IDF(2)%X=IDF(2)%NODATA
 
 !## start tracing
 DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
  !## skip nodata
  IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE
         
  !## set begin values
  NTHREAD=1; YSEL(1,NTHREAD)=ICOL; YSEL(2,NTHREAD)=IROW; IPZ=IPZ+1
  !## trace all not greater than zero, imenu=4, idf(1) will be adjusted
  CALL IDFEDITTRACE(IDF(1),IDF(2),THREAD,YSEL,ISPEC,DTERM,IMENU,MAXTHREAD,MAXN,0.0D0,NTHREAD,IPZ)

  JPZ=IPZ; IF(NTHREAD.LT.MINT)THEN; JPZ=0; IPZ=IPZ-1; ENDIF

  DO I=1,NTHREAD
   JCOL=YSEL(1,I); JROW=YSEL(2,I)
   IDF(2)%X(JCOL,JROW)=JPZ
   IDF(1)%X(JCOL,JROW)=IDF(1)%NODATA
  ENDDO
      
 ENDDO; WRITE(6,'(A,F7.3,A)') '+Progress ',REAL(IROW*100)/REAL(IDF(1)%NROW),' % finished        '; ENDDO

 WRITE(*,'(A)') 'Writing '//TRIM(IDF(2)%FNAME)
 IF(.NOT.IDFWRITE(IDF(2),IDF(2)%FNAME,1))THEN; ENDIF

 DEALLOCATE(ISPEC,THREAD,YSEL)
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)

 END SUBROUTINE IMODBATCH_IDFTRACE_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFINSERT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,NLAY,NIDF,ILAY,IROW,ICOL
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:,:) :: IDF
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: INIDF
 CHARACTER(LEN=256) :: OUTPUTFOLDER 
 LOGICAL :: LIDF
 
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY

 ALLOCATE(IDF(NLAY,2)); DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2); CALL IDFNULLIFY(IDF(I,J)); ENDDO; ENDDO

 IF(.NOT.UTL_READINITFILE('TOPSYSTEM',LINE,IU,0))RETURN
 READ(LINE,*) IDF(1,1)%FNAME;    WRITE(*,'(A)') 'TOPSYSTEM='//TRIM(IDF(1,1)%FNAME)
 IF(.NOT.UTL_READINITFILE('BOTSYSTEM',LINE,IU,0))RETURN
 READ(LINE,*) IDF(NLAY,2)%FNAME; WRITE(*,'(A)') 'BOTSYSTEM='//TRIM(IDF(NLAY,2)%FNAME)
 
 IF(.NOT.IDFREAD(IDF(1,1)   ,IDF(1   ,1)%FNAME,1))RETURN
 IF(.NOT.IDFREAD(IDF(NLAY,2),IDF(NLAY,2)%FNAME,1))RETURN 
 
 !## copy settings and allocate remaining idf files
 DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2) 
  IF(I.EQ.1.AND.J.EQ.1)CYCLE; IF(I.EQ.NLAY.AND.J.EQ.2)CYCLE; CALL IDFCOPY(IDF(1,1),IDF(I,J))
 ENDDO; ENDDO
  
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 CALL UTL_CREATEDIR(OUTPUTFOLDER)
 DO I=1,SIZE(IDF,1)
  IDF(I,1)%FNAME=TRIM(OUTPUTFOLDER)//'\TOP_MDL'//TRIM(ITOS(I))//'.IDF'
  IDF(I,2)%FNAME=TRIM(OUTPUTFOLDER)//'\BOT_MDL'//TRIM(ITOS(I))//'.IDF'
 ENDDO
 
 !## initialize data
 DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2)
  IF(I.EQ.1.AND.J.EQ.1)CYCLE; IF(I.EQ.NLAY.AND.J.EQ.2)CYCLE; IDF(I,J)%X=IDF(I,J)%NODATA
 ENDDO; ENDDO

 IF(.NOT.UTL_READINITFILE('NIDF',LINE,IU,0))RETURN
 READ(LINE,*) NIDF; LINE='NIDF='//TRIM(ITOS(NIDF)); WRITE(*,'(A)') TRIM(LINE)
 
 ALLOCATE(INIDF(3)); DO I=1,SIZE(INIDF); CALL IDFNULLIFY(INIDF(I)); ENDDO
 
 !## check input
 DO I=1,NIDF
  IF(.NOT.UTL_READINITFILE('INTOP'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) INIDF(1)%FNAME
  IF(.NOT.UTL_READINITFILE('INBOT'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) INIDF(2)%FNAME
  IF(.NOT.IDFREAD(INIDF(1),INIDF(1)%FNAME,0))THEN; RETURN; ENDIF 
  IF(.NOT.IDFREAD(INIDF(2),INIDF(2)%FNAME,0))THEN; RETURN; ENDIF 
  CLOSE(INIDF(1)%IU); CLOSE(INIDF(2)%IU)
  LIDF=UTL_READINITFILE('INLAY'//TRIM(ITOS(I)),LINE,IU,1)
  IF(LIDF)THEN
   READ(LINE,*) INIDF(3)%FNAME
   IF(.NOT.IDFREAD(INIDF(3),INIDF(3)%FNAME,0))THEN; RETURN; ENDIF 
   CLOSE(INIDF(3)%IU)
  ELSE
   IF(.NOT.UTL_READINITFILE('IL'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) ILAY ; IF(ILAY.GT.NLAY)STOP 'ILAY.GT.NLAY'
  ENDIF
 ENDDO
 
 !## read/scale/cut mean values
 DO I=1,NIDF
  IF(.NOT.UTL_READINITFILE('INTOP'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) INIDF(1)%FNAME; LINE='INTOP'//TRIM(ITOS(I))//'='//TRIM(INIDF(1)%FNAME)
  WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('INBOT'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) INIDF(2)%FNAME; LINE='INBOT'//TRIM(ITOS(I))//'='//TRIM(INIDF(2)%FNAME)
  WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF(1,1),INIDF(1)); IF(.NOT.IDFREADSCALE(INIDF(1)%FNAME,INIDF(1),2,1,0.0D0,0))THEN; RETURN; ENDIF
  CALL IDFCOPY(IDF(1,1),INIDF(2)); IF(.NOT.IDFREADSCALE(INIDF(2)%FNAME,INIDF(2),2,1,0.0D0,0))THEN; RETURN; ENDIF

  LIDF=UTL_READINITFILE('INLAY'//TRIM(ITOS(I)),LINE,IU,1)
  IF(LIDF)THEN
   READ(LINE,*) INIDF(3)%FNAME; LINE='INLAY'//TRIM(ITOS(I))//'='//TRIM(INIDF(3)%FNAME)
   WRITE(*,'(A)') TRIM(LINE)
   CALL IDFCOPY(IDF(1,1),INIDF(3)); IF(.NOT.IDFREADSCALE(INIDF(3)%FNAME,INIDF(3),7,1,0.0D0,0))THEN; RETURN; ENDIF
  ELSE
   IF(.NOT.UTL_READINITFILE('IL'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) ILAY; LINE='IL'//TRIM(ITOS(I))//'='//TRIM(ITOS(ILAY)); WRITE(*,'(A)') TRIM(LINE)
  ENDIF

  DO IROW=1,IDF(1,1)%NROW; DO ICOL=1,IDF(1,1)%NCOL
   IF(LIDF)ILAY=INIDF(3)%X(ICOL,IROW)
   IF(INIDF(1)%X(ICOL,IROW).NE.INIDF(1)%NODATA.AND. &     !## top
      INIDF(2)%X(ICOL,IROW).NE.INIDF(2)%NODATA.AND. &     !## bot
      INIDF(1)%X(ICOL,IROW).GE.INIDF(2)%X(ICOL,IROW))THEN !## top>bot
    !## skip ilay outside 1-nlay
    IF(ILAY.LE.0.OR.ILAY+1.GT.NLAY)THEN
     LINE='ILAY='//TRIM(ITOS(ILAY)); WRITE(*,'(A)') TRIM(LINE)
    ELSE
     !## not yet value given for top of resistance layer to be inserted
     IF(IDF(ILAY,2)%X(ICOL,IROW).EQ.IDF(ILAY,2)%NODATA)THEN
      IDF(ILAY,2)%X(ICOL,IROW)=INIDF(1)%X(ICOL,IROW)
     !## adjust bottom of resistance layer
     ELSE
      IDF(ILAY,2)%X(ICOL,IROW)=MAX(IDF(ILAY,2)%X(ICOL,IROW),INIDF(1)%X(ICOL,IROW))
     ENDIF
     !## not yet value given for bottom of resistance layer to be inserted
     IF(IDF(ILAY+1,1)%X(ICOL,IROW).EQ.IDF(ILAY+1,1)%NODATA)THEN
      IDF(ILAY+1,1)%X(ICOL,IROW)=INIDF(2)%X(ICOL,IROW)
     !## adjust bottom of resistance layer
     ELSE
      IDF(ILAY+1,1)%X(ICOL,IROW)=MIN(IDF(ILAY+1,1)%X(ICOL,IROW),INIDF(2)%X(ICOL,IROW))
     ENDIF
    ENDIF
   ENDIF
  ENDDO; ENDDO
 ENDDO

 DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2)
  IF(.NOT.IDFWRITE(IDF(I,J),IDF(I,J)%FNAME,1))RETURN
 ENDDO; ENDDO
 
 DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2); CALL IDFDEALLOCATE(IDF(I,J),1); ENDDO; ENDDO
 IF(ALLOCATED(INIDF))THEN; CALL IDFDEALLOCATE(INIDF,SIZE(INIDF)); DEALLOCATE(INIDF); ENDIF

 END SUBROUTINE IMODBATCH_IDFINSERT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_TSERIES()
 !###======================================================================
 USE MOD_TS_PAR, ONLY : IPFNAME1,IPFNAME2,TSILAY,SDATE,EDATE,TSDIR,LCOL,TXTCOL
 IMPLICIT NONE

 IF(.NOT.UTL_READINITFILE('IPF1',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME1; WRITE(*,'(A)') 'IPF1='//TRIM(IPFNAME1)
 
 IF(.NOT.UTL_READINITFILE('IPF2',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME2; WRITE(*,'(A)') 'IPF2='//TRIM(IPFNAME2)
 
 SDATE=INT(0,8)
 IF(UTL_READINITFILE('SDATE',LINE,IU,1))THEN
  READ(LINE,*) SDATE; ; IF(SDATE.LT.99999999)SDATE=SDATE*1000000
  LINE=TRIM(ITOS_DBL(SDATE)); WRITE(*,'(A)') 'SDATE='//TRIM(LINE)
 ENDIF
 EDATE=HUGE(EDATE)
 IF(UTL_READINITFILE('EDATE',LINE,IU,1))THEN
  READ(LINE,*) EDATE; IF(EDATE.LT.99999999)EDATE=EDATE*1000000
  LINE=TRIM(ITOS_DBL(EDATE)); WRITE(*,'(A)') 'EDATE='//TRIM(LINE)
 ENDIF
 
 LCOL=0; IF(UTL_READINITFILE('LABELCOL',LINE,IU,1))READ(LINE,*) LCOL
 LINE=TRIM(ITOS(LCOL)); WRITE(*,'(A)') 'LABELCOL='//TRIM(LINE)

 TXTCOL=2; IF(UTL_READINITFILE('TXTCOL',LINE,IU,1))READ(LINE,*) TXTCOL
 LINE=TRIM(ITOS(TXTCOL)); WRITE(*,'(A)') 'TXTCOL='//TRIM(LINE)

 IF(.NOT.UTL_READINITFILE('ILAY',LINE,IU,0))RETURN
 READ(LINE,*) TSILAY; LINE=TRIM(ITOS(TSILAY)); WRITE(*,'(A)') 'ILAY='//TRIM(LINE)
 
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) TSDIR; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(TSDIR)

 IF(.NOT.TS1COMPUTE(1))THEN; ENDIF; CALL TS_END()

 END SUBROUTINE IMODBATCH_TSERIES

 !###======================================================================
 SUBROUTINE IMODBATCH_PWTCOUNT()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: DIR,SDLFNAME,OUTPUTIDF,ILAYFNAME
 INTEGER :: SDATE,EDATE
 
 IF(.NOT.UTL_READINITFILE('SDLIDF',LINE,IU,0))RETURN
 READ(LINE,*) SDLFNAME; WRITE(*,'(A)') 'SDLIDF='//TRIM(SDLFNAME)
 IF(.NOT.UTL_READINITFILE('ILAYIDF',LINE,IU,0))RETURN
 READ(LINE,*) ILAYFNAME; WRITE(*,'(A)') 'ILAYIDF='//TRIM(ILAYFNAME)
 IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
 READ(LINE,*) SDATE; LINE=TRIM(ITOS(SDATE)); WRITE(*,'(A)') 'SDATE='//TRIM(LINE)
 IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
 READ(LINE,*) EDATE; LINE=TRIM(ITOS(EDATE)); WRITE(*,'(A)') 'EDATE='//TRIM(LINE)
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIR; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIR)
 IF(.NOT.UTL_READINITFILE('OUTPUTIDF',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTIDF; WRITE(*,'(A)') 'OUTPUTIDF='//TRIM(OUTPUTIDF)
 
 SDATE=UTL_IDATETOJDATE(SDATE); EDATE=UTL_IDATETOJDATE(EDATE)
 CALL MATH1_PWTCOUNT(DIR,SDLFNAME,ILAYFNAME,SDATE,EDATE,OUTPUTIDF)

 END SUBROUTINE IMODBATCH_PWTCOUNT

 !###======================================================================
 SUBROUTINE IMODBATCH_BITMAPTILING()
 !###======================================================================
 USE MOD_TOPO, ONLY : TOPO1DRAW_TILING
 IMPLICIT NONE
 CHARACTER(LEN=256) :: BMPFILE,OUTPUTFOLDER
 
 IF(.NOT.UTL_READINITFILE('BMPFILE',LINE,IU,0))RETURN
 READ(LINE,*) BMPFILE; WRITE(*,'(A)') 'BMPFILE='//TRIM(BMPFILE)
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 
 CALL TOPO1DRAW_TILING(BMPFILE,OUTPUTFOLDER,1,500,5)
 
 END SUBROUTINE IMODBATCH_BITMAPTILING
 
 !###======================================================================
 SUBROUTINE IMODBATCH_GEN2ISG()
 !###======================================================================
 USE MOD_GEN2GEN_PUZZLE, ONLY : GENFNAME,PUZZLEMAIN
 USE MOD_ISGGEN, ONLY : FNAME,IIDFZ,IIDFW,IIDFB,ICCF,IBOT,ICDY,RBOT,CSUMMER,CWINTER,ISTART,ISTOP,SAMPLE,ISGGEN_GENTOISG, &
   CDAY,INFFCT,XSEARCH,LDAT,IIDFC,IIDFI,IINF,ISUMMER_BACKUP,IWINTER_BACKUP,IIDFZ_BU,IIDFW_BU,DATCOL,ICORDIR
 IMPLICIT NONE
 CHARACTER(LEN=256) :: OUTFILE
 INTEGER :: IPUZZLE,I
 
 IPUZZLE=0
 CWINTER='0110'
 CSUMMER='0104'
 ISTART=2014
 ISTOP=2014
 SAMPLE=250.0D0
 XSEARCH=250.0D0
 CDAY=1.0D0
 INFFCT=0.33
 IBOT=-1
 ICDY=-1
 IINF=-1
 ICORDIR=0
 
 IF(.NOT.UTL_READINITFILE('GENFNAME',LINE,IU,0))RETURN
 READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFNAME='//TRIM(GENFNAME)
 
 !## test to see whether *.dat file exists with genfile information
 LDAT=.FALSE.; I=0
 IF(UTL_READINITFILE('IUSEDAT',LINE,IU,1))READ(LINE,*) I
 IF(I.EQ.1)LDAT=.TRUE.
 
 IF(LDAT)THEN

  IF(.NOT.UTL_READINITFILE('STAGE1_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(1); WRITE(*,'(A,I2)') 'STAGE1_COLUMN=',DATCOL(1)
  IF(.NOT.UTL_READINITFILE('STAGE2_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(2); WRITE(*,'(A,I2)') 'STAGE2_COLUMN=',DATCOL(2)
  IF(.NOT.UTL_READINITFILE('BOTL1_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(3); WRITE(*,'(A,I2)') 'BOTL1_COLUMN=',DATCOL(3)
  IF(.NOT.UTL_READINITFILE('BOTL2_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(4); WRITE(*,'(A,I2)') 'BOTL2_COLUMN=',DATCOL(4)
  IF(.NOT.UTL_READINITFILE('SLOPE_L_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(5); WRITE(*,'(A,I2)') 'SLOPE_L_COLUMN=',DATCOL(5)
  IF(.NOT.UTL_READINITFILE('SLOPE_R_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(6); WRITE(*,'(A,I2)') 'SLOPE_R_COLUMN=',DATCOL(6)
  IF(.NOT.UTL_READINITFILE('BWIDTH_COLUMN',LINE,IU,0))RETURN
  READ(LINE,*) DATCOL(7); WRITE(*,'(A,I2)') 'BWIDTH_COLUMN=',DATCOL(7)
 
 ELSE
 
  !## steady-state stage read in
  IF(UTL_READINITFILE('IDFSTAGE',LINE,IU,1))THEN

   READ(LINE,'(A)') FNAME(IIDFZ); WRITE(*,'(A)') 'IDFSTAGE='//TRIM(FNAME(IIDFZ))
   FNAME(IIDFW)=FNAME(IIDFZ)

  ELSE
    
   IF(.NOT.UTL_READINITFILE('IDFSUMMER',LINE,IU,0))RETURN
   READ(LINE,'(A)') FNAME(IIDFZ); WRITE(*,'(A)') 'IDFSUMMER='//TRIM(FNAME(IIDFZ))
   ISUMMER_BACKUP=0; IF(UTL_READINITFILE('IDFSUMMER_BACKUP',LINE,IU,1))THEN
   ISUMMER_BACKUP=1; READ(LINE,'(A)') FNAME(IIDFZ_BU); WRITE(*,'(A)') 'IDFSUMMER_BACKUP='//TRIM(FNAME(IIDFZ_BU)); ENDIF

   IF(.NOT.UTL_READINITFILE('IDFWINTER',LINE,IU,0))RETURN
   READ(LINE,'(A)') FNAME(IIDFW); WRITE(*,'(A)') 'IDFWINTER='//TRIM(FNAME(IIDFW))
   IWINTER_BACKUP=0; IF(UTL_READINITFILE('IDFWINTER_BACKUP',LINE,IU,1))THEN
   IWINTER_BACKUP=1; READ(LINE,'(A)') FNAME(IIDFW_BU); WRITE(*,'(A)') 'IDFWINTER_BACKUP='//TRIM(FNAME(IIDFW_BU)); ENDIF
  
   IF(UTL_READINITFILE('SUMMERPERIOD',LINE,IU,1))READ(LINE,*) CSUMMER
   WRITE(*,'(A)') 'SUMMERPERIOD='//TRIM(CSUMMER)
   IF(UTL_READINITFILE('WINTERPERIOD',LINE,IU,1))READ(LINE,*) CWINTER
   WRITE(*,'(A)') 'WINTERPERIOD='//TRIM(CWINTER)

   IF(UTL_READINITFILE('START_YEAR',LINE,IU,1))READ(LINE,*) ISTART
   WRITE(*,*) 'START_YEAR=',ISTART
   IF(UTL_READINITFILE('END_YEAR',LINE,IU,1))READ(LINE,*) ISTOP
   WRITE(*,*) 'END_YEAR=',ISTOP

  ENDIF
 
  IF(UTL_READINITFILE('IDFBOTTOM',LINE,IU,1))THEN
   IBOT=0; RBOT=0.0D0
   READ(LINE,'(A)') FNAME(IIDFB); WRITE(*,'(A)') 'IDFBOTTOM='//TRIM(FNAME(IIDFB))
  ENDIF
  IF(UTL_READINITFILE('BOTTOMVALUE',LINE,IU,1))THEN
   IBOT=1; READ(LINE,*) RBOT; WRITE(*,*) 'RBOT=',RBOT
  ENDIF
  IF(IBOT.LT.0)STOP 'SPECIFY IDFBOTTOM or BOTTOMVALUE'

  IF(UTL_READINITFILE('SAMPLE_DISTANCE',LINE,IU,1))READ(LINE,*) SAMPLE
  WRITE(*,*) 'SAMPLE_DISTANCE=',SAMPLE

  IF(.NOT.UTL_READINITFILE('CCFFNAME',LINE,IU,0))RETURN
  READ(LINE,*) FNAME(ICCF); WRITE(*,'(A)') 'CCFFNAME='//TRIM(FNAME(ICCF))

  IF(UTL_READINITFILE('SEARCH_DISTANCE',LINE,IU,1))READ(LINE,*) XSEARCH
  WRITE(*,*) 'SEARCH_DISTANCE=',XSEARCH

  IF(UTL_READINITFILE('IPUZZLE',LINE,IU,1))READ(LINE,*) IPUZZLE
  WRITE(*,'(A,I10)') 'IPUZZLE=',IPUZZLE

 ENDIF
 
 IF(UTL_READINITFILE('IDFRESISTANCE',LINE,IU,1))THEN
  ICDY=0; CDAY=0.0D0
  READ(LINE,'(A)') FNAME(IIDFC); WRITE(*,'(A)') 'IDFRESISTANCE='//TRIM(FNAME(IIDFC))
 ENDIF
 IF(UTL_READINITFILE('RESISTANCE',LINE,IU,1))THEN
  ICDY=1; READ(LINE,*) CDAY; WRITE(*,*) 'RESISTANCE=',CDAY
 ENDIF
 IF(ICDY.LT.0)STOP 'SPECIFY IDFRESISTANCE or RESISTANCE'

 IF(UTL_READINITFILE('IDFINFILTRATIONFACTOR',LINE,IU,1))THEN
  IINF=0; INFFCT=0.0D0
  READ(LINE,'(A)') FNAME(IIDFI); WRITE(*,'(A)') 'IDFINFILTRATIONFACTOR='//TRIM(FNAME(IIDFI))
 ENDIF
 IF(UTL_READINITFILE('INFILTRATIONFACTOR',LINE,IU,1))THEN
  IINF=1; READ(LINE,*) INFFCT; WRITE(*,*) 'INFILTRATIONFACTOR=',INFFCT
 ENDIF
 IF(IINF.LT.0)STOP 'SPECIFY IDFINFILTRATIONFACTOR or INFILTRATIONFACTOR'

 IF(.NOT.UTL_READINITFILE('ICORDIR',LINE,IU,0))RETURN
 READ(LINE,*) ICORDIR; WRITE(*,'(A)') 'ICORDIR='//TRIM(ITOS(ICORDIR))

 IF(.NOT.UTL_READINITFILE('OUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) OUTFILE; WRITE(*,'(A)') 'OUTFILE='//TRIM(OUTFILE)

 IF(IPUZZLE.EQ.1)CALL PUZZLEMAIN()
 CALL ISGGEN_GENTOISG(GENFNAME,OUTFILE)
 
 END SUBROUTINE IMODBATCH_GEN2ISG

 !###======================================================================
 SUBROUTINE IMODBATCH_IPF2ISG()
 !###======================================================================
 USE MOD_ISGGEN, ONLY : ISGGEN_IPFTOISG
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE,IPFFILE
 INTEGER,DIMENSION(9) :: DATCOL
 INTEGER(KIND=8) :: SDATE
 INTEGER :: I
 
 DO I=1,SIZE(DATCOL); DATCOL(I)=I; ENDDO; SDATE=20000101000000
 
 IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IPFFILE; WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFILE)

 IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) DATCOL(1)
 WRITE(*,'(A,I2)') 'IXCOL=',DATCOL(1)
 IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) DATCOL(2)
 WRITE(*,'(A,I2)') 'IYCOL=',DATCOL(2)
 IF(UTL_READINITFILE('ILABELCOL',LINE,IU,1))READ(LINE,*) DATCOL(3)
 WRITE(*,'(A,I2)') 'ILABELCOL=',DATCOL(3)
 IF(UTL_READINITFILE('ISEGMCOL',LINE,IU,1))READ(LINE,*) DATCOL(4)
 WRITE(*,'(A,I2)') 'ISEGMCOL=',DATCOL(4)
 IF(UTL_READINITFILE('IWIDTHCOL',LINE,IU,1))READ(LINE,*) DATCOL(5)
 WRITE(*,'(A,I2)') 'IWIDTHCOL=',DATCOL(5)
 IF(UTL_READINITFILE('IBOTTOMCOL',LINE,IU,1))READ(LINE,*) DATCOL(6)
 WRITE(*,'(A,I2)') 'IBOTTOMCOL=',DATCOL(6)
 IF(UTL_READINITFILE('ISTAGECOL',LINE,IU,1))READ(LINE,*) DATCOL(7)
 WRITE(*,'(A,I2)') 'ISTAGECOL=',DATCOL(7)
 IF(UTL_READINITFILE('IPERMCOL',LINE,IU,1))READ(LINE,*) DATCOL(8)
 WRITE(*,'(A,I2)') 'IPERMCOL=',DATCOL(8)
! IF(UTL_READINITFILE('ITALUSCOL',LINE,IU,1))READ(LINE,*) DATCOL(9)
! WRITE(*,'(A,I2)') 'ITALUSCOL=',DATCOL(9)

 IF(UTL_READINITFILE('SDATE',LINE,IU,1))READ(LINE,*) SDATE
 WRITE(*,'(A,I14)') 'SDATE=',SDATE

 IF(.NOT.UTL_READINITFILE('ISGFILE',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE='//TRIM(ISGFILE)

 CALL ISGGEN_IPFTOISG(IPFFILE,ISGFILE,DATCOL)
 
 END SUBROUTINE IMODBATCH_IPF2ISG

 !###======================================================================
 SUBROUTINE IMODBATCH_GENSNAPTOGRID()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: GENFILE
 INTEGER(KIND=1),DIMENSION(:,:,:),ALLOCATABLE :: IPC
 INTEGER :: IROW,ICOL,N,JU,I3D
 REAL(KIND=DP_KIND) :: T1,T2,B1,B2,T,B
 LOGICAL :: LEX
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF

 ALLOCATE(IDF(3)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO

 IF(.NOT.UTL_READINITFILE('GENFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) GENFILE; WRITE(*,'(A)') 'GENFILE_IN='//TRIM(GENFILE)

 I3D=0; IF(UTL_READINITFILE('I3D',LINE,IU,1))READ(LINE,*) I3D
 LINE='I3D='//TRIM(ITOS(I3D)); WRITE(*,'(A)') TRIM(LINE)
  
 IDF(3)%XMIN=0.0D0; IDF(3)%YMIN=0.0D0; IDF(3)%XMAX=0.0D0; IDF(3)%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) IDF(3)%XMIN,IDF(3)%YMIN,IDF(3)%XMAX,IDF(3)%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',IDF(3)%XMIN,IDF(3)%YMIN,IDF(3)%XMAX,IDF(3)%YMAX
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) IDF(3)%DX; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',IDF(3)%DX; IDF(3)%DY=IDF(3)%DX
  CALL UTL_IDFSNAPTOGRID_LLC(IDF(3)%XMIN,IDF(3)%XMAX,IDF(3)%YMIN,IDF(3)%YMAX,IDF(3)%DX,IDF(3)%DY,IDF(3)%NCOL,IDF(3)%NROW)
 ELSE
  IF(.NOT.UTL_READINITFILE('IDFFILE',LINE,IU,0))RETURN
  READ(LINE,*) IDF(3)%FNAME; WRITE(*,'(A)') 'IDFFILE='//TRIM(IDF(3)%FNAME)
  IF(.NOT.IDFREAD(IDF(3),IDF(3)%FNAME,0))RETURN
 ENDIF

 !## read/scale top/bot files
 IF(I3D.EQ.1)THEN
  IF(.NOT.UTL_READINITFILE('IDF_TOP',LINE,IU,0))RETURN
  READ(LINE,*) IDF(1)%FNAME; WRITE(*,'(A)') 'IDF_TOP='//TRIM(IDF(1)%FNAME)
  IF(.NOT.UTL_READINITFILE('IDF_BOT',LINE,IU,0))RETURN
  READ(LINE,*) IDF(2)%FNAME; WRITE(*,'(A)') 'IDF_BOT='//TRIM(IDF(2)%FNAME)
  CALL IDFCOPY(IDF(3),IDF(1)); CALL IDFCOPY(IDF(3),IDF(2))
  IF(.NOT.IDFREADSCALE(IDF(1)%FNAME,IDF(1),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'
  IF(.NOT.IDFREADSCALE(IDF(2)%FNAME,IDF(2),2,1,0.0D0,0))STOP 'Cannot read data for IDF(2)'
 ENDIF

 !## fill sx/sy variable in idf
 IF(.NOT.IDFFILLSXSY(IDF(3)))RETURN

 ALLOCATE(IPC(IDF(3)%NCOL,IDF(3)%NROW,2)); IPC=INT(0,1)

 CALL ASC2IDF_INT_NULLIFY(); ALLOCATE(XP(100),YP(100),ZP(100),WP(100),PP(100),FP(100))

 CALL ASC2IDF_HFB(IDF(3),IDF(3)%NROW,IDF(3)%NCOL,IPC,(/GENFILE/),-1)

 IF(.NOT.UTL_READINITFILE('GENFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) GENFILE; WRITE(*,'(A)') 'GENFILE_OUT='//TRIM(GENFILE)

 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=GENFILE,ACTION='WRITE',STATUS='UNKNOWN',FORM='FORMATTED')
 IF(JU.EQ.0)THEN; WRITE(*,'(A)') 'Error opening '//TRIM(GENFILE); RETURN; ENDIF

 N=0; DO IROW=1,IDF(3)%NROW; DO ICOL=1,IDF(3)%NCOL

  !## place vertical wall
  IF(IPC(ICOL,IROW,1).EQ.INT(1,1))THEN
   IF(ICOL.LT.IDF(3)%NCOL)THEN
    T1=0.0D0; B1=T1; LEX=.FALSE.
    IF(I3D.EQ.1)THEN
     T1=IDF(1)%X(ICOL,IROW); T2=IDF(1)%X(ICOL+1,IROW)
     B1=IDF(2)%X(ICOL,IROW); B2=IDF(2)%X(ICOL+1,IROW)
     IF(T1.NE.IDF(1)%NODATA.AND.T2.NE.IDF(1)%NODATA.AND. &
        B1.NE.IDF(2)%NODATA.AND.B2.NE.IDF(2)%NODATA)THEN
      T=MAX(T1,T2); B=MIN(B1,B2); LEX=.TRUE.
     ENDIF
    ELSE
     LEX=.TRUE.; T=0.0D0; B=0.0D0
    ENDIF
    IF(LEX)THEN
     N=N+1; CALL PMANAGER_GENERATEMFNETWORKS_WRITEXY(1,JU,0,IPC,IDF(3),IROW,ICOL,N,I3D,T,B) 
    ENDIF
   ENDIF
  ENDIF

  !## place horizontal wall
  IF(IPC(ICOL,IROW,2).EQ.INT(1,1))THEN
   !## write line in genfile
   IF(IROW.LT.IDF(3)%NROW)THEN
    T1=0.0D0; B1=T1; LEX=.FALSE.
    IF(I3D.EQ.1)THEN
     !## find appropriate top/bot
     T1=IDF(1)%X(ICOL,IROW); T2=IDF(1)%X(ICOL,IROW+1)
     B1=IDF(2)%X(ICOL,IROW); B2=IDF(2)%X(ICOL,IROW+1)
     IF(T1.NE.IDF(1)%NODATA.AND.T2.NE.IDF(1)%NODATA.AND. &
        B1.NE.IDF(2)%NODATA.AND.B2.NE.IDF(2)%NODATA)THEN
      T=MAX(T1,T2); B=MIN(B1,B2); LEX=.TRUE.
     ENDIF
    ELSE
     LEX=.TRUE.; T=0.0D0; B=0.0D0
    ENDIF
    IF(LEX)THEN
     N=N+1; CALL PMANAGER_GENERATEMFNETWORKS_WRITEXY(2,JU,0,IPC,IDF(3),IROW,ICOL,N,I3D,T,B) 
    ENDIF
   ENDIF
  ENDIF
 
 ENDDO; ENDDO

 WRITE(JU,'(A)') 'END'; CLOSE(JU)
 CALL ASC2IDF_INT_DEALLOCATE(); DEALLOCATE(IPC); CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)

 END SUBROUTINE IMODBATCH_GENSNAPTOGRID
 
 !###======================================================================
 SUBROUTINE IMODBATCH_UZFTOCSV()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: UZFFILE,CSVFILE
 INTEGER,DIMENSION(2) :: JU
 INTEGER :: I,J,IOS
   
 IF(.NOT.UTL_READINITFILE('UZFFILE',LINE,IU,0))RETURN
 READ(LINE,*) UZFFILE; WRITE(*,'(A)') 'UZFFILE='//TRIM(UZFFILE)
 IF(.NOT.UTL_READINITFILE('CSVFILE',LINE,IU,0))RETURN
 READ(LINE,*) CSVFILE; WRITE(*,'(A)') 'CSVFILE='//TRIM(CSVFILE)

 JU(1)=UTL_GETUNIT(); OPEN(JU(1),FILE=UZFFILE,STATUS='OLD'    ,ACTION='READ')
 JU(2)=UTL_GETUNIT(); OPEN(JU(2),FILE=CSVFILE,STATUS='UNKNOWN',ACTION='WRITE')
 
!             1    0.0000000E+00  8.7779391E-01  2.8722062E+00  7.1803361E-02  6.3689098E-02
!                                                               1.4360672E-01  6.3689098E-02

 !## read all first
 DO I=1,2
  DO J=1,3; READ(JU(1),*); ENDDO
  DO
!   READ(JU(1),'(9X,I5,3X,5(1PE14.7,1X)',IOSTAT=IOS) K,T,H,T,D,WC
! 9014 FORMAT (62X, 2(1PE14.7, 1X))
   IF(IOS.NE.0)EXIT
  ENDDO
 ENDDO
 
 CLOSE(JU(1)); CLOSE(JU(2))
 
 END SUBROUTINE IMODBATCH_UZFTOCSV

 !###======================================================================
 SUBROUTINE IMODBATCH_MKWELLIPF_MAIN()
 !###======================================================================
 USE MOD_SCENTOOL_PAR, ONLY : TOPIDF,BOTIDF,KHVIDF !,CIDF
 USE MOD_IPF_PAR, ONLY : NIPF,IPF
 USE MOD_IPF, ONLY : IPFALLOCATE
 USE MOD_SCENTOOL_WELLS, ONLY : ST1CREATEIPF_STEADY
 USE MOD_IDF, ONLY : IDFNULLIFY
 IMPLICIT NONE
 INTEGER :: I,N,IKD,SDATE,EDATE,ISS,IMIDF,IQCOL,STNLAY
 REAL(KIND=DP_KIND) :: HNODATA,FNODATA,MINKHT,MINKD
 
 STNLAY=-1; IMIDF=0; IKD=0; MINKHT=0.0D0; SDATE=0; EDATE=0; ISS=0
 HNODATA=0.0D0; FNODATA=-99999.0D0; MINKD=0.0D0
 
 IF(UTL_READINITFILE('NLAY',LINE,IU,1))THEN
  READ(LINE,*) STNLAY

  ALLOCATE(TOPIDF(STNLAY),BOTIDF(STNLAY),KHVIDF(STNLAY)) !,CIDF(STNLAY-1))
  DO I=1,SIZE(TOPIDF); CALL IDFNULLIFY(TOPIDF(I)); ENDDO
  DO I=1,SIZE(BOTIDF); CALL IDFNULLIFY(BOTIDF(I)); ENDDO
  DO I=1,SIZE(KHVIDF); CALL IDFNULLIFY(KHVIDF(I)); ENDDO
!  DO I=1,SIZE(CIDF);   CALL IDFNULLIFY(CIDF(I));   ENDDO

  DO I=1,STNLAY
   IF(.NOT.UTL_READINITFILE('TOPIDF'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) TOPIDF(I)%FNAME; LINE='TOPIDF'//TRIM(ITOS(I))//'='//TRIM(TOPIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
   IF(.NOT.UTL_READINITFILE('BOTIDF'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) BOTIDF(I)%FNAME; LINE='BOTIDF'//TRIM(ITOS(I))//'='//TRIM(BOTIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
   !## optionele opties
   IF(UTL_READINITFILE('KHVIDF'//TRIM(ITOS(I)),LINE,IU,1))THEN
    IKD=1
    READ(LINE,*) KHVIDF(I)%FNAME; LINE='KHVIDF'//TRIM(ITOS(I))//'='//TRIM(KHVIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
   ENDIF
!   IF(I.LT.STNLAY)THEN
!    IF(UTL_READINITFILE('CIDF'//TRIM(ITOS(I)),LINE,IU,1))THEN
!     ICW=1
!     READ(LINE,*) CIDF(I)%FNAME; LINE='CIDF'//TRIM(ITOS(I))//'='//TRIM(CIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!    ENDIF
!   ENDIF
  ENDDO

  IF(IKD.EQ.1)THEN
   IF(.NOT.UTL_READINITFILE('MINKHT',LINE,IU,0))RETURN; READ(LINE,*) MINKHT
   WRITE(*,'(A,F15.7)') 'MINKHT=',MINKHT 
  ENDIF
  IF(UTL_READINITFILE('MINKD',LINE,IU,1))THEN
   READ(LINE,*) MINKD
   WRITE(*,'(A,F15.7)') 'MINKD=',MINKD 
  ENDIF
!  !## whenever in clay, position above (<0) or beneath (+1)
!  IF(UTL_READINITFILE('ICLAY',LINE,IU,1))READ(LINE,*) ICLAY
!  WRITE(*,'(A,I5)') 'ICLAY=',ICLAY 
  !## usage of nodata  
  IF(UTL_READINITFILE('FNODATA',LINE,IU,1))READ(LINE,*) FNODATA
  WRITE(*,'(A,F15.7)') 'FNODATA=',FNODATA 
 ENDIF
  
 !## usage of nodata  
 IF(UTL_READINITFILE('HNODATA',LINE,IU,1))READ(LINE,*) HNODATA
 WRITE(*,'(A,F15.7)') 'HNODATA=',HNODATA 

 NIPF=1; CALL IPFALLOCATE()

 IF(UTL_READINITFILE('ISS',LINE,IU,1))READ(LINE,*) ISS
 WRITE(*,'(A,I1)') 'ISS=',ISS
 SDATE=0; EDATE=0; IF(ISS.EQ.1)THEN
  IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
  READ(LINE,*) SDATE; WRITE(*,'(A,I8)') 'SDATE=',SDATE
  IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
  READ(LINE,*) EDATE; WRITE(*,'(A,I8)') 'EDATE=',EDATE
 ENDIF

 IPF(1)%XCOL=1; IPF(1)%YCOL=2; IPF(1)%QCOL=3
 IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IPF(1)%XCOL; WRITE(*,'(A,I2)')  'IXCOL=',IPF(1)%XCOL
 IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IPF(1)%YCOL; WRITE(*,'(A,I2)')  'IYCOL=',IPF(1)%YCOL
 IF(ISS.EQ.0)THEN
  IF(UTL_READINITFILE('IQCOL',LINE,IU,1))READ(LINE,*) IPF(1)%QCOL; WRITE(*,'(A,I2)')  'IQCOL=',IPF(1)%QCOL
 ELSE
  IPF(1)%QCOL=IPF(1)%XCOL
 ENDIF
 IF(STNLAY.GT.0)THEN
  IPF(1)%ZCOL=4; IPF(1)%Z2COL=5
  IF(UTL_READINITFILE('ITCOL',LINE,IU,1))READ(LINE,*) IPF(1)%ZCOL; WRITE(*,'(A,I2)')  'ITCOL=',IPF(1)%ZCOL
  IF(UTL_READINITFILE('IBCOL',LINE,IU,1))READ(LINE,*) IPF(1)%Z2COL; WRITE(*,'(A,I2)') 'IBCOL=',IPF(1)%Z2COL
  IF(UTL_READINITFILE('IMIDF',LINE,IU,1))READ(LINE,*) IMIDF; WRITE(*,'(A,I2)') 'IMIDF=',IMIDF
 ELSE
  IPF(1)%ZCOL=1; IPF(1)%Z2COL=1
 ENDIF
 IQCOL=IPF(1)%QCOL

 IF(.NOT.UTL_READINITFILE('NIPF',LINE,IU,0))RETURN
 READ(LINE,*) N; WRITE(*,'(A,I5)') 'NIPF=',N

 DO I=1,N
  IF(.NOT.UTL_READINITFILE('IPF'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IPF(1)%FNAME
  LINE='IPF'//TRIM(ITOS(I))//'='//TRIM(IPF(1)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  !## reset qcol as that can be changed
  IPF(1)%QCOL=IQCOL
  !## read entire ipf
  IF(.NOT.IPFREAD2(1,1,1))RETURN
  IF(.NOT.ST1CREATEIPF_STEADY(IKD,MINKHT,IMIDF,SDATE,EDATE,ISS,HNODATA,FNODATA,MINKD,STNLAY)) &
    WRITE(*,'(A)') 'Error IPF '//TRIM(IPF(1)%FNAME)//' failed'
 ENDDO

 END SUBROUTINE IMODBATCH_MKWELLIPF_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IMPORTSOBEK_MAIN()
 !###======================================================================
 USE MOD_SOBEK_PAR, ONLY : ISGNAME,SOBEKDIR,CALCPNTHISNAME,STRUCHISNAME,IBATCH,DFLOWFMDIR,ISFINAL
 IMPLICIT NONE

 IBATCH=1

 IF(.NOT.UTL_READINITFILE('ISGNAME',LINE,IU,0))RETURN
 READ(LINE,'(A)') ISGNAME; WRITE(*,'(A)') 'ISGNAME='//TRIM(ISGNAME)
 
 IF(UTL_READINITFILE('ISFINAL',LINE,IU,1))THEN
  READ(LINE,*) ISFINAL; WRITE(*,'(A)') 'ISFINAL='//TRIM(ITOS(ISFINAL))
 ENDIF
 
 IF(UTL_READINITFILE('SOBEKDIR',LINE,IU,1))THEN
  READ(LINE,*) SOBEKDIR; WRITE(*,'(A)') 'SOBEKDIR='//TRIM(SOBEKDIR)
  IF(.NOT.UTL_READINITFILE('CALCHIS',LINE,IU,0))RETURN
  READ(LINE,*) CALCPNTHISNAME; WRITE(*,'(A)') 'CALCHIS='//TRIM(CALCPNTHISNAME)
  STRUCHISNAME=''
  IF(UTL_READINITFILE('STRUCHIS',LINE,IU,1))THEN
   READ(LINE,*) STRUCHISNAME; WRITE(*,'(A)') 'STRUCHIS='//TRIM(STRUCHISNAME)
  ENDIF
  IF(.NOT.SOBEK1CALC())THEN; ENDIF
 ELSE
  IF(.NOT.UTL_READINITFILE('DFLOWFMDIR',LINE,IU,0))RETURN
  READ(LINE,'(A)') DFLOWFMDIR; WRITE(*,'(A)') 'DFLOWFMDIR='//TRIM(DFLOWFMDIR)
  IF(.NOT.DFLOWFM1CALC())THEN; ENDIF
 ENDIF
 
 END SUBROUTINE IMODBATCH_IMPORTSOBEK_MAIN

 ! !###======================================================================
! SUBROUTINE IMODBATCH_CORRKD_MAIN()
! !###======================================================================
! USE MOD_CORRKD_PAR, ONLY : NLAY,MINVC,MAXK,C_IDF,KD_IDF,TOP_IDF,BOT_IDF, &
!    OUTPUTMAP,IBND_IDF,ANIF_IDF
! IMPLICIT NONE
! INTEGER :: I
! 
! IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
! READ(LINE,*) NLAY; LINE='NLAY='//TRIM(ITOS(NLAY)); WRITE(*,'(A)') TRIM(LINE)
! IF(.NOT.UTL_READINITFILE('MINVC',LINE,IU,0))RETURN
! READ(LINE,*) MINVC; LINE='MINVC='//TRIM(RTOS(MINVC,'F',7)); WRITE(*,'(A)') TRIM(LINE)
! IF(.NOT.UTL_READINITFILE('MAXK',LINE,IU,0))RETURN
! READ(LINE,*) MAXK; LINE='MAXK='//TRIM(RTOS(MAXK,'F',7)); WRITE(*,'(A)') TRIM(LINE)
! CALL CORRKD_ALLOCATE()
!! IF(.NOT.UTL_READINITFILE('MAXZ',LINE,IU,0))RETURN
!! READ(LINE,*) MAXZ; WRITE(*,'(A,F10.2)') 'MAXZ=',MAXZ
!
! DO I=1,NLAY
!  IF(I.LT.NLAY)THEN
!   IF(.NOT.UTL_READINITFILE('C_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!   READ(LINE,*) C_IDF(I)%FNAME; LINE='C_L'//TRIM(ITOS(I))//'='//TRIM(C_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  ENDIF
!  IF(.NOT.UTL_READINITFILE('KD_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) KD_IDF(I)%FNAME; LINE='KD_L'//TRIM(ITOS(I))//'='//TRIM(KD_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) TOP_IDF(I)%FNAME; LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(TOP_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) BOT_IDF(I)%FNAME; LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(BOT_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  IF(.NOT.UTL_READINITFILE('IBND_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) IBND_IDF(I)%FNAME; LINE='IBND_L'//TRIM(ITOS(I))//'='//TRIM(IBND_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  ANIF_IDF(I)%FNAME=''; IF(UTL_READINITFILE('ANIF_L'//TRIM(ITOS(I)),LINE,IU,1))THEN
!   READ(LINE,*) ANIF_IDF(I)%FNAME; LINE='ANIF_L'//TRIM(ITOS(I))//'='//TRIM(ANIF_IDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
!  ENDIF
! ENDDO
! IF(.NOT.UTL_READINITFILE('OUTPUTMAP',LINE,IU,0))RETURN
! READ(LINE,*) OUTPUTMAP; WRITE(*,'(A)') 'OUTPUTMAP='//TRIM(OUTPUTMAP)
! 
! CALL CORRKD_MAIN()
! !CALL CORRKD_DEALLOCATE()
! 
! END SUBROUTINE IMODBATCH_CORRKD_MAIN
!
 !###======================================================================
 SUBROUTINE IMODTOSTOMP()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IWINDOW,NLAY,ICROSS,ITYPE
 REAL(KIND=DP_KIND) :: SEAL
 TYPE(IDFOBJ) :: IDF
 
 IWINDOW=0; ICROSS=0
 
 IF(UTL_READINITFILE('ICROSS',LINE,IU,1))THEN
  READ(LINE,*) ICROSS
  IF(.NOT.UTL_READINITFILE('XLINE',LINE,IU,0))RETURN
   READ(LINE,*) IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
   WRITE(*,'(A,4F10.2)') 'XLINE=',IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
 ELSE
  IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
   IWINDOW=1
   READ(LINE,*) IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
   WRITE(*,'(A,4F10.2)') 'WINDOW=',IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
  ENDIF
 ENDIF
 
 IF(IWINDOW.NE.0.OR.ICROSS.NE.0)THEN
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) IDF%DX; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',IDF%DX
  IDF%DY=IDF%DX
 ENDIF 
 
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; LINE='NLAY='//TRIM(ITOS(NLAY)); WRITE(*,'(A)') TRIM(LINE)
 IF(.NOT.UTL_READINITFILE('ITYPE',LINE,IU,0))RETURN
 READ(LINE,*) ITYPE; LINE='ITYPE='//TRIM(ITOS(ITYPE)); WRITE(*,'(A)') TRIM(LINE)
 IF(.NOT.UTL_READINITFILE('SEAL',LINE,IU,0))RETURN
 READ(LINE,*) SEAL; LINE='SEAL='//TRIM(RTOS(SEAL,'G',7)); WRITE(*,'(A)') TRIM(LINE)

 IF(.NOT.UTL_READPOINTER(IU,NAGGR,IAGGR,'IAGGR',0))RETURN
 IF(SUM(IAGGR).NE.NLAY)THEN
  WRITE(*,'(A,I3.3,A)') 'SUM IAGGR (',SUM(IAGGR),') need to be as many entries as NLAY'
  STOP
 ENDIF
 
 !## initialise variables
 CALL STOMP_INIT(NLAY)
 
 IF(STOMP_READ(IU,IDF,IWINDOW,ICROSS,SEAL))THEN
  IF(STOMP_SAVEINPUT(ITYPE))THEN; ENDIF
 ENDIF
 
 CALL STOMP_CLOSE()
 
 END  SUBROUTINE IMODTOSTOMP
 
 !###======================================================================
 SUBROUTINE IMODBATCH_KDC()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,ILAY,IROW,ICOL,NLAY
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: TOP,BOT,KHV,KVV,KVA,BND,KDV,VCV,ERH,ERV
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=256) :: OUTPUTMAP
 INTEGER :: ISOLVE,IWINDOW,ICTB
 REAL(KIND=DP_KIND) :: D,T,B,C1,C2,C3,K,MINTHICKNESS
 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
 
 ISOLVE=0
 ICTB=0   !## correct top/bot - up-down approach
 MINTHICKNESS=0.0D0
 
 IF(UTL_READINITFILE('ICTB',LINE,IU,1))READ(LINE,*) ICTB
 LINE='ICTB='//TRIM(ITOS(ICTB)); WRITE(*,'(A)') TRIM(LINE)
 IF(ICTB.EQ.1)THEN
  IF(.NOT.UTL_READINITFILE('MINTHICKNESS',LINE,IU,0))RETURN
  READ(LINE,*) MINTHICKNESS; LINE='MINTHICKNESS='//TRIM(RTOS(MINTHICKNESS,'F',3)); WRITE(*,'(A)') TRIM(LINE)
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; LINE='NLAY='//TRIM(ITOS(NLAY)); WRITE(*,'(A)') TRIM(LINE)
 ALLOCATE(TOP(NLAY),BOT(NLAY),KHV(NLAY),KVA(NLAY),KVV(NLAY-1),VCV(NLAY-1),ERV(NLAY-1),BND(NLAY),KDV(NLAY),ERH(NLAY))
 DO I=1,NLAY
  CALL IDFNULLIFY(TOP(I));    CALL IDFNULLIFY(BOT(I)); CALL IDFNULLIFY(KHV(I))
  CALL IDFNULLIFY(KDV(NLAY)); CALL IDFNULLIFY(KVA(I)); CALL IDFNULLIFY(BND(I)); CALL IDFNULLIFY(ERH(NLAY))
 ENDDO
 DO I=1,NLAY-1
  CALL IDFNULLIFY(KVV(I)); CALL IDFNULLIFY(VCV(I)); CALL IDFNULLIFY(ERV(I))
 ENDDO

 IWINDOW=0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IWINDOW=1
  READ(LINE,*) IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) IDF%DX; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',IDF%DX
  IDF%DY=IDF%DX
  CALL UTL_IDFSNAPTOGRID_LLC(IDF%XMIN,IDF%XMAX,IDF%YMIN,IDF%YMAX,IDF%DX,IDF%DY,IDF%NCOL,IDF%NROW,.TRUE.)
 ENDIF
 
 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('BND_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) BND(I)%FNAME; LINE='BND_L'//TRIM(ITOS(I))//'='//TRIM(BND(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(I.LT.NLAY)THEN
   IF(.NOT.UTL_READINITFILE('KVV_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) KVV(I)%FNAME; LINE='KVV_L'//TRIM(ITOS(I))//'='//TRIM(KVV(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  IF(.NOT.UTL_READINITFILE('KHV_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) KHV(I)%FNAME; LINE='KHV_L'//TRIM(ITOS(I))//'='//TRIM(KHV(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('KVA_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) KVA(I)%FNAME; LINE='KVA_L'//TRIM(ITOS(I))//'='//TRIM(KVA(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) TOP(I)%FNAME; LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(TOP(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) BOT(I)%FNAME; LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(BOT(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 IF(.NOT.UTL_READINITFILE('OUTPUTMAP',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTMAP; WRITE(*,'(A)') 'OUTPUTMAP='//TRIM(OUTPUTMAP)
 DO I=1,NLAY
  WRITE(*,'(A,I10)') 'Reading files for layer ',I
  IF(I.EQ.1.AND.IWINDOW.EQ.0)THEN
   IF(.NOT.IDFREAD(BND(I),BND(I)%FNAME,1))RETURN
   CALL IDFCOPY(BND(1),IDF)
  ELSE
   CALL IDFCOPY(IDF,BND(I)); IF(.NOT.IDFREADSCALE(BND(I)%FNAME,BND(I),1,1,0.0D0,0))RETURN
  ENDIF
  CALL IDFCOPY(BND(I),TOP(I)); IF(.NOT.IDFREADSCALE(TOP(I)%FNAME,TOP(I),2,1,0.0D0,0))RETURN
  CALL IDFCOPY(BND(I),BOT(I)); IF(.NOT.IDFREADSCALE(BOT(I)%FNAME,BOT(I),2,1,0.0D0,0))RETURN
  CALL IDFCOPY(BND(I),KHV(I)); IF(.NOT.IDFREADSCALE(KHV(I)%FNAME,KHV(I),3,1,0.0D0,0))RETURN
  CALL IDFCOPY(BND(I),KVA(I)); IF(.NOT.IDFREADSCALE(KVA(I)%FNAME,KVA(I),2,1,0.0D0,0))RETURN
  CALL IDFCOPY(BND(I),KDV(I)); CALL IDFCOPY(BND(I),ERH(I))
  IF(I.LT.NLAY)THEN
   CALL IDFCOPY(BND(I),KVV(I)); IF(.NOT.IDFREADSCALE(KVV(I)%FNAME,KVV(I),3,1,0.0D0,0))RETURN
   CALL IDFCOPY(BND(I),VCV(I)); CALL IDFCOPY(BND(I),ERV(I))
  ENDIF
 ENDDO

 !## correct bnd if top/bot nodata turn into inactive
 DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL

  !## make nodata equal zero for boundary conditions
  DO ILAY=1,NLAY
   IF(BND(ILAY)%X(ICOL,IROW).EQ.BND(ILAY)%NODATA)BND(ILAY)%X(ICOL,IROW)=0.0D0
  ENDDO
  
  !## if top/base is inactive, deactivate all
  IF(TOP(1   )%X(ICOL,IROW).EQ.TOP(1   )%NODATA.OR. &
     TOP(NLAY)%X(ICOL,IROW).EQ.TOP(NLAY)%NODATA)THEN
   DO ILAY=1,NLAY; BND(ILAY)%X(ICOL,IROW)=0.0D0; ENDDO
  !## check/correct in between layers
  ELSE
   DO ILAY=1,NLAY
    
    IF(BOT(ILAY)%X(ICOL,IROW).EQ.BOT(ILAY)%NODATA)THEN
     BOT(ILAY)%X(ICOL,IROW)=TOP(ILAY)%X(ICOL,IROW)
    ENDIF
    IF(ILAY.GT.1)THEN
     IF(TOP(ILAY)%X(ICOL,IROW).EQ.TOP(ILAY)%NODATA)THEN
      TOP(ILAY)%X(ICOL,IROW)=BOT(ILAY-1)%X(ICOL,IROW)
     ENDIF
    ENDIF
    
   ENDDO
  ENDIF
 ENDDO; ENDDO
 
 !## correct top/bot
 DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
  DO ILAY=1,NLAY
   IF(BND(ILAY)%X(ICOL,IROW).EQ.0)THEN
    TOP(ILAY)%X(ICOL,IROW)=TOP(ILAY)%NODATA
    BOT(ILAY)%X(ICOL,IROW)=BOT(ILAY)%NODATA
   ELSE
    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))
   ENDIF  
  ENDDO
 ENDDO; ENDDO

 !## fill in permeability if thickness is not zero
 DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
  DO ILAY=1,NLAY
   T=TOP(ILAY)%X(ICOL,IROW); B=BOT(ILAY)%X(ICOL,IROW); D=T-B
   IF(D.GT.0.0D0)THEN
    IF(KHV(ILAY)%X(ICOL,IROW).EQ.KHV(ILAY)%NODATA)KHV(ILAY)%X(ICOL,IROW)=1.0D0
    IF(KVA(ILAY)%X(ICOL,IROW).EQ.KVA(ILAY)%NODATA)KVA(ILAY)%X(ICOL,IROW)=1.0D0
    IF(ILAY.LT.NLAY)THEN
     IF(KVV(ILAY)%X(ICOL,IROW).EQ.KVV(ILAY)%NODATA)KVV(ILAY)%X(ICOL,IROW)=1.0D0
    ENDIF
   ENDIF
  ENDDO
 ENDDO; ENDDO

 !## correct layers
 IF(ICTB.EQ.1)THEN
  ALLOCATE(TP(NLAY)   ,BT(NLAY)   ,HK(NLAY)   ,VK(NLAY)   ,VA(NLAY)   ,IB(NLAY),TH(NLAY,2), &
           TP_BU(NLAY),BT_BU(NLAY),HK_BU(NLAY),VK_BU(NLAY),VA_BU(NLAY))
  DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
   IF(BND(1)%X(ICOL,IROW).EQ.0)CYCLE
   DO ILAY=1,NLAY  ; IB(ILAY)=BND(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY  ; TP(ILAY)=TOP(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY  ; BT(ILAY)=BOT(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY  ; HK(ILAY)=KHV(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY  ; VA(ILAY)=KVA(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY-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,MINTHICKNESS,NLAY,ICOL,IROW)
   DO ILAY=1,NLAY  ; IB(ILAY)=BND(ILAY)%X(ICOL,IROW); ENDDO
   DO ILAY=1,NLAY  ; TOP(ILAY)%X(ICOL,IROW)=TP(ILAY); ENDDO
   DO ILAY=1,NLAY  ; BOT(ILAY)%X(ICOL,IROW)=BT(ILAY); ENDDO
   DO ILAY=1,NLAY  ; KHV(ILAY)%X(ICOL,IROW)=HK(ILAY); ENDDO
   DO ILAY=1,NLAY  ; KVA(ILAY)%X(ICOL,IROW)=VA(ILAY); ENDDO
   DO ILAY=1,NLAY-1; KVV(ILAY)%X(ICOL,IROW)=VK(ILAY); ENDDO
  ENDDO; ENDDO

  DEALLOCATE(TP,BT,HK,VK,VA,IB,TH,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU)
 ENDIF
  
 DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
  DO ILAY=NLAY,1,-1
   T=TOP(ILAY)%X(ICOL,IROW); B=BOT(ILAY)%X(ICOL,IROW); D=T-B
   IF(D.GT.0.0D0)EXIT
   BND(ILAY)%X(ICOL,IROW)=0.0D0
  ENDDO
 ENDDO; ENDDO

 !## solve issues
 IF(ISOLVE.EQ.1)THEN
  !## mark point for interpolation
  CALL IDFCOPY(BND(1),IDF)
  DO ILAY=1,NLAY;   CALL IMODBATCH_KDC_INT(IDF,BND(ILAY),KHV(ILAY),TOP(ILAY),BOT(ILAY)); ENDDO
  DO ILAY=1,NLAY-1; CALL IMODBATCH_KDC_INT(IDF,BND(ILAY),KVV(ILAY),BOT(ILAY),TOP(ILAY+1)); ENDDO
 ENDIF
 
 KDV%NODATA=HUGE(1.0D0); VCV%NODATA=HUGE(1.0D0)
 ERH%NODATA=HUGE(1.0D0); ERV%NODATA=HUGE(1.0D0)
 DO ILAY=1,NLAY;   KDV(ILAY)%X=KDV(ILAY)%NODATA; ERH(ILAY)%X=ERH(ILAY)%NODATA; ENDDO
 DO ILAY=1,NLAY-1; VCV(ILAY)%X=VCV(ILAY)%NODATA; ERV(ILAY)%X=ERV(ILAY)%NODATA; ENDDO

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

   D=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)
   T=D*KHV(ILAY)%X(ICOL,IROW)
   KDV(ILAY)%X(ICOL,IROW)=T
 
   IF(ILAY.LT.NLAY)THEN

    D=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW); C1=0.0D0
    IF(D.GT.0.0D0)THEN
     IF(KHV(ILAY)%X(ICOL,IROW).LE.0.0D0.OR.KHV(ILAY)%X(ICOL,IROW).EQ.KHV(ILAY)%NODATA)ERH(ILAY)%X(ICOL,IROW)=1.0D0
     IF(KVA(ILAY)%X(ICOL,IROW).LE.0.0D0.OR.KVA(ILAY)%X(ICOL,IROW).EQ.KVA(ILAY)%NODATA)ERH(ILAY)%X(ICOL,IROW)=1.0D0
     K= KHV(ILAY)%X(ICOL,IROW)
     IF(ERH(ILAY)%X(ICOL,IROW).EQ.ERH(ILAY)%NODATA.AND.K.GT.10.0E3)ERH(ILAY)%X(ICOL,IROW)=2.0
     K= K*KVA(ILAY)%X(ICOL,IROW)
     C1=0.5D0*D/K
    ELSEIF(D.LT.0.0D0)THEN
     IF(ERH(ILAY)%X(ICOL,IROW).EQ.ERH(ILAY)%NODATA)ERH(ILAY)%X(ICOL,IROW)=1.0D0
     ERH(ILAY)%X(ICOL,IROW)=-1.0D0*ABS(ERH(ILAY)%X(ICOL,IROW))
    ENDIF

    IF(BND(ILAY+1)%X(ICOL,IROW).EQ.0)CYCLE

    D=BOT(ILAY)%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW); C2=0.0D0
    IF(D.GT.0.0D0)THEN
     IF(KVV(ILAY)%X(ICOL,IROW).LE.0.0D0.OR.KVV(ILAY)%X(ICOL,IROW).EQ.KVV(ILAY)%NODATA)ERV(ILAY)%X(ICOL,IROW)=1.0D0
     K =KVV(ILAY)%X(ICOL,IROW)
     IF(ERV(ILAY)%X(ICOL,IROW).EQ.ERV(ILAY)%NODATA.AND.K.GE.1.0D0)ERV(ILAY)%X(ICOL,IROW)=2.0
     C2=D/K
    ELSEIF(D.LT.0.0D0)THEN
     IF(ERV(ILAY)%X(ICOL,IROW).EQ.ERH(ILAY)%NODATA)ERV(ILAY)%X(ICOL,IROW)=1.0D0
     ERV(ILAY)%X(ICOL,IROW)=-1.0D0*ABS(ERV(ILAY)%X(ICOL,IROW))
    ENDIF

    D=TOP(ILAY+1)%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW); C3=0.0D0
    IF(D.GT.0.0D0)THEN
     IF(KHV(ILAY+1)%X(ICOL,IROW).LE.0.0D0.OR.KHV(ILAY+1)%X(ICOL,IROW).EQ.KHV(ILAY+1)%NODATA)ERH(ILAY+1)%X(ICOL,IROW)=1.0D0
     IF(KVA(ILAY+1)%X(ICOL,IROW).LE.0.0D0.OR.KVA(ILAY+1)%X(ICOL,IROW).EQ.KVA(ILAY+1)%NODATA)ERH(ILAY+1)%X(ICOL,IROW)=1.0D0
     K= KHV(ILAY+1)%X(ICOL,IROW)
     IF(ERH(ILAY+1)%X(ICOL,IROW).EQ.ERH(ILAY)%NODATA.AND.K.GT.10.0E3)ERH(ILAY+1)%X(ICOL,IROW)=2.0
     K= K*KVA(ILAY+1)%X(ICOL,IROW)
     C3=0.5*D/K
    ELSEIF(D.LT.0.0D0)THEN
     IF(ERH(ILAY+1)%X(ICOL,IROW).EQ.ERH(ILAY)%NODATA)ERH(ILAY+1)%X(ICOL,IROW)=1.0D0
     ERH(ILAY+1)%X(ICOL,IROW)=-1.0D0*ABS(ERH(ILAY+1)%X(ICOL,IROW))
    ENDIF
    VCV(ILAY)%X(ICOL,IROW)=C1+C2+C3
   ENDIF
  ENDDO
 ENDDO; ENDDO

 CALL UTL_CREATEDIR(OUTPUTMAP)
 DO ILAY=1,NLAY
  WRITE(*,'(A,I10)') 'Writing KDV/VCV/ERH/ERV resulting files for layer ',ILAY
  KDV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\KDV_L'//TRIM(ITOS(ILAY))//'.IDF'
  IF(.NOT.IDFWRITE(KDV(ILAY),KDV(ILAY)%FNAME,1))RETURN
  ERH(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\ERH_L'//TRIM(ITOS(ILAY))//'.IDF'
  IF(.NOT.IDFWRITE(ERH(ILAY),ERH(ILAY)%FNAME,1))RETURN
  IF(ILAY.LT.NLAY)THEN
   VCV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\VCV_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(VCV(ILAY),VCV(ILAY)%FNAME,1))RETURN
   ERV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\ERV_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(ERV(ILAY),ERV(ILAY)%FNAME,1))RETURN
  ENDIF
 ENDDO
 DO ILAY=1,NLAY;   ERH(ILAY)%X=ERH(ILAY)%NODATA; ENDDO
 DO ILAY=1,NLAY-1; ERV(ILAY)%X=ERV(ILAY)%NODATA; ENDDO
 DO ILAY=1,NLAY; DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL
  IF(BND(ILAY)%X(ICOL,IROW).EQ.0)CYCLE
  ERH(ILAY)%X(ICOL,IROW)=TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY  )%X(ICOL,IROW)
  IF(ILAY.LT.NLAY)ERV(ILAY)%X(ICOL,IROW)=BOT(ILAY)%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW)
 ENDDO; ENDDO; ENDDO
 DO ILAY=1,NLAY
  WRITE(*,'(A,I10)') 'Writing TOP/BOT/BND/KHV/KVV/KVA/TKH/TKV resulting files for layer ',ILAY
  IF(ICTB.EQ.1)THEN
   TOP(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\TOP_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(TOP(ILAY),TOP(ILAY)%FNAME,1))RETURN
   BOT(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\BOT_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(BOT(ILAY),BOT(ILAY)%FNAME,1))RETURN
   BND(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\BND_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(BND(ILAY),BND(ILAY)%FNAME,1))RETURN
   KHV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\KHV_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(KHV(ILAY),KHV(ILAY)%FNAME,1))RETURN
   KVA(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\KVA_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(KVA(ILAY),KVA(ILAY)%FNAME,1))RETURN
   IF(ILAY.NE.NLAY)THEN
    KVV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\KVV_L'//TRIM(ITOS(ILAY))//'.IDF'
    IF(.NOT.IDFWRITE(KVV(ILAY),KVV(ILAY)%FNAME,1))RETURN
   ENDIF
  ENDIF
  ERH(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\TKH_L'//TRIM(ITOS(ILAY))//'.IDF'
  IF(.NOT.IDFWRITE(ERH(ILAY),ERH(ILAY)%FNAME,1))RETURN
  IF(ILAY.LT.NLAY)THEN
   ERV(ILAY)%FNAME=TRIM(OUTPUTMAP)//'\TKV_L'//TRIM(ITOS(ILAY))//'.IDF'
   IF(.NOT.IDFWRITE(ERV(ILAY),ERV(ILAY)%FNAME,1))RETURN
  ENDIF
 ENDDO
  
 END SUBROUTINE IMODBATCH_KDC
 
 !###======================================================================
 SUBROUTINE IMODBATCH_KDC_INT(IDF,BND,KV,TOP,BOT)
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF,BND,KV,TOP,BOT
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: XD,YD,ZD
 INTEGER :: IROW,IR1,ICOL,IC1,ND,IOS
 REAL(KIND=DP_KIND) :: D
  
 IDF%X=0.0D0
 DO IROW=1,BND%NROW; DO ICOL=1,BND%NCOL
  IF(BND%X(ICOL,IROW).EQ.0)CYCLE
  D=TOP%X(ICOL,IROW)-BOT%X(ICOL,IROW)
  IF(D.GT.0.AND.(KV%X(ICOL,IROW).LE.0.0D0.OR.KV%X(ICOL,IROW).EQ.KV%NODATA))THEN
   IDF%X(ICOL,IROW)=1.0D0 
  ENDIF
 ENDDO; ENDDO
 
 !## get fixed points - direct next to the selected zone(s) (only if not equal to nodata value)
 DO IROW=1,BND%NROW; DO ICOL=1,BND%NCOL
  IF(IDF%X(ICOL,IROW).EQ.1.0D0)THEN
   DO IR1=MAX(1,IROW-1),MIN(IROW+1,BND%NROW); DO IC1=MAX(1,ICOL-1),MIN(ICOL+1,BND%NCOL)
    IF(IDF%X(IC1,IR1).EQ.0.0D0)IDF%X(IC1,IR1)=2.0
   ENDDO; ENDDO
  ENDIF
 ENDDO; ENDDO

 ND=0; DO IROW=1,BND%NROW; DO ICOL=1,BND%NCOL; IF(IDF%X(ICOL,IROW).EQ.2.0)ND=ND+1; ENDDO; ENDDO 
 !## number data points
 ALLOCATE(XD(ND),YD(ND),ZD(ND))

 ND=0; DO IROW=1,BND%NROW; DO ICOL=1,BND%NCOL
 IF(IDF%X(ICOL,IROW).EQ.2.0)THEN
   ND=ND+1; XD(ND)=REAL(ICOL); YD(ND)=REAL(IROW)
   ZD(ND)=KV%X(ICOL,IROW)
  ENDIF
 ENDDO; ENDDO 

 !## start filling in missing values for permeability
 CALL SOLID_PCGINT(XD,YD,ZD,ND,IOS,IDF,1)

 ND=0; DO IROW=1,BND%NROW; DO ICOL=1,BND%NCOL
  IF(IDF%X(ICOL,IROW).EQ.2.0)THEN
   ND=ND+1; XD(ND)=REAL(ICOL); YD(ND)=REAL(IROW)
   KV%X(ICOL,IROW)=ZD(ND)
  ENDIF
 ENDDO; ENDDO 
 
 END SUBROUTINE IMODBATCH_KDC_INT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_DEVWELLTOIPF()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: CSVFNAME,IPFFNAME
 INTEGER,DIMENSION(:),POINTER :: ICOLS
 INTEGER :: NLC,I
 
 IF(.NOT.UTL_READINITFILE('CSVFNAME',LINE,IU,0))RETURN
 READ(LINE,*) CSVFNAME; WRITE(*,'(A)') 'CSVFNAME='//TRIM(CSVFNAME)

 IF(.NOT.UTL_READINITFILE('IPFFNAME',LINE,IU,0))RETURN
 READ(LINE,*) IPFFNAME; WRITE(*,'(A)') 'IPFFNAME='//TRIM(IPFFNAME)
 
 NLC=0; IF(UTL_READINITFILE('NLCOL',LINE,IU,1))READ(LINE,*) NLC; WRITE(*,'(A,I2)') 'NLC=',NLC
 ALLOCATE(ICOLS(7+NLC))

 ICOLS=0; DO I=1,7; ICOLS(I)=I; ENDDO; ICOLS(4)=0

 IF(UTL_READINITFILE('NCOL',LINE,IU,1))READ(LINE,*) ICOLS(1); WRITE(*,'(A,I2)') 'NCOL=',ICOLS(1)
 IF(UTL_READINITFILE('XCOL',LINE,IU,1))READ(LINE,*) ICOLS(2); WRITE(*,'(A,I2)') 'XCOL=',ICOLS(2)
 IF(UTL_READINITFILE('YCOL',LINE,IU,1))READ(LINE,*) ICOLS(3); WRITE(*,'(A,I2)') 'YCOL=',ICOLS(3)
 IF(UTL_READINITFILE('ZCOL',LINE,IU,1))READ(LINE,*) ICOLS(4); WRITE(*,'(A,I2)') 'ZCOL=',ICOLS(4)
 IF(UTL_READINITFILE('DCOL',LINE,IU,1))READ(LINE,*) ICOLS(5); WRITE(*,'(A,I2)') 'DCOL=',ICOLS(5)
 IF(UTL_READINITFILE('ICOL',LINE,IU,1))READ(LINE,*) ICOLS(6); WRITE(*,'(A,I2)') 'ICOL=',ICOLS(6)
 IF(UTL_READINITFILE('ACOL',LINE,IU,1))READ(LINE,*) ICOLS(7); WRITE(*,'(A,I2)') 'ACOL=',ICOLS(7)
 DO I=1,NLC
  IF(UTL_READINITFILE('LCOL'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) ICOLS(7+I); LINE='LCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(ICOLS(I+7)))
  WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 
! MPW%XMIN=0.0D0; MPW%YMIN=0.0D0; MPW%XMAX=0.0D0; MPW%YMAX=0.0D0
! IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
!  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
!  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
! ENDIF

! GENFNAME=''
! IF(UTL_READINITFILE('GENFILE',LINE,IU,1))THEN
!  READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFILE='//TRIM(GENFNAME)
! ENDIF

 CALL DEVWELL_IMPORT(CSVFNAME,IPFFNAME,ICOLS,1)
 
 END SUBROUTINE IMODBATCH_DEVWELLTOIPF

 !###======================================================================
 SUBROUTINE IMODBATCH_GEF2IPF_MAIN()
 !###======================================================================
 USE MOD_GEF2IPF_PAR, ONLY : GEFDIR,IPFFNAME,GENFNAME,GEFNAMES
 IMPLICIT NONE
 INTEGER :: GEFTYPE
 
 IF(.NOT.UTL_READINITFILE('GEFDIR',LINE,IU,0))RETURN
 READ(LINE,*) GEFDIR; WRITE(*,'(A)') 'GEFDIR='//TRIM(GEFDIR)

 IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IPFFNAME; WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFNAME)

 MPW%XMIN=0.0D0; MPW%YMIN=0.0D0; MPW%XMAX=0.0D0; MPW%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
 ENDIF

 GENFNAME=''
 IF(UTL_READINITFILE('GENFILE',LINE,IU,1))THEN
  READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFILE='//TRIM(GENFNAME)
 ENDIF

 GEFTYPE=0
 IF(.NOT.UTL_READINITFILE('GEFTYPE',LINE,IU,0))RETURN
 READ(LINE,*) GEFTYPE; WRITE(*,*) 'GEFTYPE=',GEFTYPE
 
 IF(UTL_DIRINFO_POINTER(GEFDIR(:INDEX(GEFDIR,'\',.TRUE.)-1),GEFDIR(INDEX(GEFDIR,'\',.TRUE.)+1:),GEFNAMES,'F'))THEN
  CALL GEF2IPF_MAIN(1,GEFTYPE)
 ELSE
  WRITE(*,'(/1X,A)') 'No files found that match'
  WRITE(*,'(1X,A/)') TRIM(GEFDIR)
 ENDIF

 END SUBROUTINE IMODBATCH_GEF2IPF_MAIN
 
  !###======================================================================
 SUBROUTINE IMODBATCH_UTM2LATLONG_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IDFNAME
 
 IF(.NOT.UTL_READINITFILE('IDFNAME',LINE,IU,0))RETURN
 READ(LINE,*) IDFNAME; WRITE(*,'(A)') 'IDFNAME='//TRIM(IDFNAME)

 CALL UTM_IDF2LATLONG(IDFNAME)
 
 END SUBROUTINE IMODBATCH_UTM2LATLONG_MAIN
 
 !###======================================================================
 SUBROUTINE IMODBATCH_DINO2IPF_MAIN()
 !###======================================================================
 USE MOD_DINO_PAR, ONLY : CSVFNAME,IPFFNAME,GENFNAME
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ROOT
 CHARACTER(LEN=52) :: WC
 INTEGER :: I,N
 
 ALLOCATE(CSVFNAME(1))
 IF(.NOT.UTL_READINITFILE('CSVFILE',LINE,IU,0))RETURN
 READ(LINE,*) CSVFNAME(1)
 IF(INDEX(CSVFNAME(1),'.').EQ.0)CSVFNAME(1)=TRIM(CSVFNAME(1))//'.csv'
 WRITE(*,'(A)') 'CSVFILE='//TRIM(CSVFNAME(1))

 IF(INDEX(CSVFNAME(1),'*').EQ.0)THEN
  IPFFNAME=CSVFNAME(1)(:INDEX(CSVFNAME(1),'.',.TRUE.))//'ipf'
  IF(UTL_READINITFILE('IPFFILE',LINE,IU,0))READ(LINE,*) IPFFNAME
 ELSE
  I=INDEX(CSVFNAME(1),'\',.TRUE.); ROOT=CSVFNAME(1)(:I-1); WC=TRIM(CSVFNAME(1)(I+1:))
  CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOT),TRIM(WC),N)
  IF(N.EQ.0)THEN; WRITE(*,'(A)') 'No files found in: '//TRIM(CSVFNAME(1)); RETURN; ENDIF
  DEALLOCATE(CSVFNAME); ALLOCATE(CSVFNAME(N))
  CALL UTL_DIRINFO(TRIM(ROOT),TRIM(WC),CSVFNAME,N,'F')
  DO I=1,SIZE(CSVFNAME); CSVFNAME(I)=TRIM(ROOT)//'\'//TRIM(CSVFNAME(I)); ENDDO
  IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
  READ(LINE,*) IPFFNAME
 ENDIF
 WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFNAME)

 MPW%XMIN=0.0D0; MPW%YMIN=0.0D0; MPW%XMAX=0.0D0; MPW%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
 ENDIF

 GENFNAME=''
 IF(UTL_READINITFILE('GENFILE',LINE,IU,1))THEN
  READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFILE='//TRIM(GENFNAME)
 ENDIF

 CALL IMOD_DINO_MAIN()
 CALL IMOD_DINO_DEALLOCATE()
 
 END SUBROUTINE IMODBATCH_DINO2IPF_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_REGRESSIONTXT()
 !###======================================================================
 USE LSQ
 IMPLICIT NONE
 CHARACTER(LEN=52) :: FILTER1,FILTER2,FILTER3
 CHARACTER(LEN=256) :: IPFFILE,FNAME,DIR
 INTEGER :: I,N,M,IALL,JU,KU,II,JJ,JJJ,NN,IDATE,NPOINTS
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: X,Y
 REAL(KIND=DP_KIND) :: A,B,R2,EZ,CORRELATION
 
 FILTER1=''; FILTER2=''

 IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IPFFILE; WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFILE)
 DIR=IPFFILE(:INDEX(IPFFILE,'\',.TRUE.)-1)
 IF(.NOT.UTL_READINITFILE('FILTER1',LINE,IU,0))RETURN
 READ(LINE,*) FILTER1; WRITE(*,'(A)') 'FILTER1='//TRIM(FILTER1)
 IALL=0; IF(UTL_READINITFILE('IALL',LINE,IU,1))READ(LINE,*) IALL
 IF(IALL.EQ.0)THEN
  IF(.NOT.UTL_READINITFILE('FILTER2',LINE,IU,0))RETURN
  READ(LINE,*) FILTER2; WRITE(*,'(A)') 'FILTER2='//TRIM(FILTER2)
 ENDIF
 CORRELATION=0.0D0 
 IF(.NOT.UTL_READINITFILE('CORRELATION',LINE,IU,0))RETURN
 READ(LINE,*) CORRELATION; WRITE(*,'(A)') 'CORRELATION='//TRIM(RTOS(CORRELATION,'F',3))
 NPOINTS=0.0
 IF(.NOT.UTL_READINITFILE('NPOINTS',LINE,IU,0))RETURN
 READ(LINE,*) NPOINTS; WRITE(*,'(A)') 'NPOINTS='//TRIM(ITOS(NPOINTS))

 NIPF=1; CALL IPFALLOCATE(); IPF(1)%FNAME=IPFFILE
 IPF(1)%XCOL =1; IPF(1)%YCOL=2; IPF(1)%ZCOL=2
 IPF(1)%Z2COL=2; IPF(1)%QCOL=2;
 IF(.NOT.IPFREAD2(1,1,1))RETURN
 
 !## open new file
 FNAME=IPFFILE(:INDEX(IPFFILE,'.',.TRUE.)-1)//'_REGRESSION.IPF_'
 KU=UTL_GETUNIT(); OPEN(KU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(KU,*) 'NaN1#'
 WRITE(KU,*) IPF(1)%NCOL+2
 DO I=1,IPF(1)%NCOL; WRITE(KU,'(A)') TRIM(IPF(1)%ATTRIB(I)); ENDDO; WRITE(KU,'(A)') 'Regression_coefficient'; WRITE(KU,'(A)') 'Sample_Size'
 WRITE(KU,*) IPF(1)%ACOL,','//TRIM(IPF(1)%FEXT) 
 
 !## store each drill in memory for picking purposes
 CALL IPFASSFILEALLOCATE(2)

 FILTER1=UTL_CAP(FILTER1,'U')

 !## get filter1
 N=1
 DO I=1,IPF(1)%NROW 
  FILTER3=UTL_CAP(IPF(1)%INFO(IPF(1)%ACOL,I),'U')
  IF(TRIM(FILTER1).NE.TRIM(FILTER3))CYCLE
  !## read dimensions of associated file
  FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
  IF(IPFOPENASSFILE(JU,N,FNAME))THEN
   !## measurements found
   IF(ASSF(N)%ITOPIC.EQ.1)THEN
    IF(.NOT.IPFREADASSFILELABEL(JU,N,FNAME).AND.IPFREADASSFILE(JU,N,FNAME))THEN
     WRITE(*,'(A)') 'Cannot properly read in file '//TRIM(FNAME); PAUSE; STOP
    ENDIF
   ENDIF
   CLOSE(JU)
  ENDIF
 ENDDO

 !## proces rest of filters
 N=2; M=0
 DO I=1,IPF(1)%NROW 
  IF(IALL.EQ.1)FILTER2=UTL_CAP(IPF(1)%INFO(IPF(1)%ACOL,I),'U')
  FILTER3=UTL_CAP(IPF(1)%INFO(IPF(1)%ACOL,I),'U')
  IF(TRIM(FILTER2).NE.TRIM(FILTER3))CYCLE
  !## read dimensions of associated file
  FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
  IF(IPFOPENASSFILE(JU,N,FNAME))THEN
   !## measurements found
   IF(ASSF(N)%ITOPIC.EQ.1)THEN
    IF(IPFREADASSFILELABEL(JU,N,FNAME).AND.IPFREADASSFILE(JU,N,FNAME))THEN
     CLOSE(JU)
     !## fill in x use 2 loops
     DO II=1,2
      NN=0
      !## look for overlapping dates
      DO JJ=1,ASSF(1)%NRASS
       DO JJJ=1,ASSF(2)%NRASS
        IF(ASSF(1)%IDATE(JJ).EQ.ASSF(2)%IDATE(JJJ))THEN
         IF(ASSF(1)%MEASURE(1,JJ) .NE.ASSF(1)%NODATA(2).AND. &
            ASSF(2)%MEASURE(1,JJJ).NE.ASSF(2)%NODATA(2))THEN
          NN=NN+1
          IF(II.EQ.2)THEN
           X(NN)=ASSF(1)%MEASURE(1,JJ)
           Y(NN)=ASSF(2)%MEASURE(1,JJJ)
          ENDIF
         ENDIF
        ENDIF
       ENDDO
      ENDDO
      IF(II.EQ.1)THEN
       IF(NN.GT.0)THEN
        ALLOCATE(X(NN),Y(NN)); X=0.0D0; Y=0.0D0
       ELSE
        EXIT
       ENDIF
      ELSE
       CALL LINREGRESSION(NN,X,Y,A,B,R2)

       IF(R2.GT.CORRELATION.AND.NN.GT.NPOINTS)THEN

        M=M+1
        IPF(1)%INFO(IPF(1)%ACOL,I)=TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'_regression'
        WRITE(KU,'(99A)') (TRIM(IPF(1)%INFO(JJ,I))//',',JJ=1,IPF(1)%NCOL),TRIM(RTOS(R2,'G',5)),','//TRIM(ITOS(NN))
       
        !## fill in remaining data points for first series
        FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
        JU=UTL_GETUNIT(); OPEN(JU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
        WRITE(JU,'(I9)') ASSF(1)%NRASS
        WRITE(JU,'(A)') '3,1'
        WRITE(JU,'(A)') 'DATE,-9999.0'
        WRITE(JU,'(A)') 'ESTIMATED,-9999.0'
        WRITE(JU,'(A)') 'MEASURE,-9999.0'

        !## fill in if needed
        DO JJ=1,ASSF(1)%NRASS
         IDATE=UTL_JDATETOIDATE(INT(ASSF(1)%IDATE(JJ)))
         DO JJJ=1,ASSF(2)%NRASS
          IF(ASSF(1)%IDATE(JJ).EQ.ASSF(2)%IDATE(JJJ))THEN
           WRITE(JU,'(I10,2(A1,F10.2))') IDATE,',',ASSF(2)%MEASURE(1,JJJ),',',ASSF(2)%MEASURE(1,JJJ)
           EXIT
          ENDIF
         ENDDO
         IF(JJJ.GT.ASSF(2)%NRASS)THEN
          IF(ASSF(1)%MEASURE(1,JJ).NE.ASSF(1)%NODATA(2))THEN
           IF(A.EQ.0.0)THEN
            EZ=-9999.0
           ELSE
            !## predict second serie
            EZ=ASSF(1)%MEASURE(1,JJ)*A+B
           ENDIF
          ELSE
           EZ=-9999.0
          ENDIF
          WRITE(JU,'(I10,2(A1,F10.2))') IDATE,',',EZ,',',-9999.0
         ENDIF
        ENDDO
      
        CLOSE(JU)       
       ENDIF
      ENDIF
     ENDDO
     IF(ALLOCATED(X))DEALLOCATE(X); IF(ALLOCATED(Y))DEALLOCATE(Y)

    ENDIF
   ELSE
    WRITE(*,'(A)') 'NTOPIC NE 1'; PAUSE
   ENDIF
  ELSE
   WRITE(*,'(A)') 'Cannot open '//TRIM(FNAME); PAUSE
  ENDIF
 ENDDO
 CLOSE(KU)
 
 FNAME=IPFFILE(:INDEX(IPFFILE,'.',.TRUE.)-1)//'_REGRESSION.IPF_'
 CALL UTL_MF2005_MAXNO(FNAME,(/M/))

 END SUBROUTINE IMODBATCH_REGRESSIONTXT

 !###======================================================================
 SUBROUTINE IMODBATCH_MF6TOIDF()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ) :: IDF,SUM,PHR
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: FFF,FRF,FLF
 CHARACTER(LEN=256) :: HEDFNAME,BDGFNAME
 INTEGER :: JU,NCOL,NROW,NLAY,ILAY,KSTP,KPER,ICOL,IROW,IOS,I1,I2,I3,NDIM1,NDIM2,NDIM3, &
  IMETH,NDAT,NLIST,I,J,LENTXT,NCELLS,NTXT,NJA,N,M,IPOS,NCON,SDATE,NODE,JLAY,JROW,JCOL, & 
  NLAYERS
 INTEGER,DIMENSION(:),ALLOCATABLE :: ID1,ID2
 CHARACTER(LEN=16) :: TEXT,TXT1ID1,TXT1ID2,TXT2ID1,TXT2ID2,CDATE
 CHARACTER(LEN=50) :: HDR
 CHARACTER(LEN=16),ALLOCATABLE,DIMENSION(:) :: AUXTXT
 CHARACTER(LEN=256) :: ROOT
 REAL(KIND=DP_KIND) :: PERTIM,TOTIM,DELT,ANGROT,Q
 REAL(KIND=DP_KIND),DIMENSION(:,:,:),ALLOCATABLE :: X,Y
 CHARACTER(LEN=:),ALLOCATABLE :: STRING
 INTEGER,DIMENSION(:),ALLOCATABLE :: IA,JA
 INTEGER,DIMENSION(:),POINTER :: SAVESHD,SAVEWEL,SAVEDRN,SAVERIV,SAVEGHB,SAVERCH,SAVEEVT,SAVEFLX,SAVECHD,SAVESTO,SAVESPY
 LOGICAL :: LEX
 
 SDATE=0; IF(UTL_READINITFILE('SDATE',LINE,IU,1))THEN
  READ(LINE,*) SDATE; WRITE(*,'(A)') 'SDATE='//TRIM(ITOS(SDATE))
  SDATE=UTL_IDATETOJDATE(SDATE)
 ENDIF

 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVESHD,'SAVESHD',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVEWEL,'SAVEWEL',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVEDRN,'SAVEDRN',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVERIV,'SAVERIV',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVEGHB,'SAVEGHB',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVERCH,'SAVERCH',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVEEVT,'SAVEEVT',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVECHD,'SAVECHD',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVEFLX,'SAVEFLX',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVESTO,'SAVESTO',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NLAYERS,SAVESPY,'SAVESPY',1))RETURN

 CALL IDFNULLIFY(IDF); CALL IDFNULLIFY(PHR); CALL IDFNULLIFY(SUM)
 IDF%ITYPE=8

 IF(UTL_READINITFILE('IDF',LINE,IU,1))THEN
  READ(LINE,*) IDF%FNAME; WRITE(*,'(A)') 'IDF='//TRIM(IDF%FNAME)
  IF(.NOT.IDFREAD(IDF,IDF%FNAME,1))STOP
 ELSEIF(UTL_READINITFILE('GRB',LINE,IU,1))THEN
  READ(LINE,*) IDF%FNAME; WRITE(*,'(A)') 'GRB='//TRIM(IDF%FNAME)
  JU=UTL_GETUNIT(); OPEN(JU,FILE=IDF%FNAME,ACTION='READ',ACCESS='STREAM',FORM='UNFORMATTED')
  READ(JU) HDR
  READ(JU) HDR
  READ(JU) HDR; READ(HDR(5:),*) NTXT
  READ(JU) HDR; READ(HDR(7:),*) LENTXT
  ALLOCATE(CHARACTER(LEN=LENTXT) :: STRING)
  DO I=1,NTXT; READ(JU) STRING; ENDDO
  READ(JU) NCELLS
  READ(JU) NLAY 
  READ(JU) IDF%NROW
  READ(JU) IDF%NCOL
  READ(JU) NJA
  READ(JU) IDF%XMIN
  READ(JU) IDF%YMIN
  READ(JU) ANGROT
  ALLOCATE(IDF%SX(0:IDF%NCOL)); READ(JU) (IDF%SX(I),I=1,IDF%NCOL)
  ALLOCATE(IDF%SY(0:IDF%NROW)); READ(JU) (IDF%SY(I),I=1,IDF%NROW)
  ALLOCATE(X(IDF%NCOL*IDF%NROW,1,1)); READ(JU) (X(I,1,1),I=1,IDF%NCOL*IDF%NROW); DEALLOCATE(X)
  ALLOCATE(X(NCELLS,1,1)); READ(JU) (X(I,1,1),I=1,NCELLS); DEALLOCATE(X)
  ALLOCATE(IA(NCELLS+1)); READ(JU) (IA(I),I=1,NCELLS+1)
  ALLOCATE(JA(NJA)); READ(JU) (JA(I),I=1,NJA)
  DEALLOCATE(STRING)
  IDF%DX=IDF%SX(1); IDF%DY=IDF%SY(1)
  IDF%XMAX=IDF%XMIN+(IDF%NCOL*IDF%DX)
  IDF%YMAX=IDF%YMIN+(IDF%NROW*IDF%DY)
  IDF%NODATA=HUGE(1.0)
  IF(.NOT.IDFALLOCATEX(IDF))STOP 'CANNOT ALLOCATE MEMORY X IN IDF OBJECT'
  CLOSE(JU)
 ELSE
  STOP 'IDF OR GRB NEEDED'
 ENDIF
 
! CALL IDFCOPY(IDF,NLD); IF(.NOT.IDFREADSCALE('d:\IMOD-MODELS\LHM\NLD.IDF',NLD,7,1,0.0D0,0))STOP

 IF(UTL_READINITFILE('HED',LINE,IU,1))THEN
  CALL IDFCOPY(IDF,PHR); CALL IDFCOPY(IDF,SUM); SUM%NODATA=0.0D0
  READ(LINE,*) HEDFNAME; WRITE(*,'(A)') 'HED='//TRIM(HEDFNAME)
  ROOT=HEDFNAME(:INDEX(HEDFNAME,'\',.TRUE.)-1)
  JU=UTL_GETUNIT()
  OPEN(JU,FILE=HEDFNAME,STATUS='OLD',ACTION='READ',ACCESS='STREAM',FORM='UNFORMATTED') 
  DO
   READ(JU,IOSTAT=IOS) KSTP,KPER,PERTIM,TOTIM,TEXT,NCOL,NROW,ILAY

   IF(ILAY.EQ.1)THEN
    SUM%X=0.0; PHR%X=PHR%NODATA
   ENDIF
   
!   WRITE(*,*) KSTP,KPER,PERTIM,TOTIM,TEXT,NCOL,NROW,ILAY
   
   TEXT=ADJUSTL(TEXT)
   IF(IOS.NE.0)EXIT
   IDF%NODATA=1.0D30

   IF(KPER.EQ.1)THEN !PERTIM.EQ.0.0D0)THEN
    CDATE='STEADY-STATE'
   ELSE
    CDATE=JDATETOFDATE(TOTIM,SDATE,2)
   ENDIF

   READ(JU) ((IDF%X(ICOL,IROW),ICOL=1,NCOL),IROW=1,NROW)

   LEX=.FALSE.; IF(ASSOCIATED(SAVESHD))THEN; DO I=1,SIZE(SAVESHD); IF(SAVESHD(I).EQ.ILAY.OR.SAVESHD(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
   
   IF(LEX)THEN
    IDF%FNAME=TRIM(ROOT)//'\'//TRIM(TEXT)//'\'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
    IF(.NOT.IDFWRITE(IDF,IDF%FNAME,1))STOP
   ENDIF
   
   DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
    IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)THEN
     IF(SUM%X(ICOL,IROW).EQ.0.0D0)PHR%X(ICOL,IROW)=IDF%X(ICOL,IROW)
     SUM%X(ICOL,IROW)=SUM%X(ICOL,IROW)+1.0D0
    ENDIF
   ENDDO; ENDDO

   IF(ILAY.EQ.NLAY)THEN
    SUM%FNAME=TRIM(ROOT)//'\SUMACT_'//TRIM(CDATE)//'.IDF';   IF(.NOT.IDFWRITE(SUM,SUM%FNAME,1))STOP
    PHR%FNAME=TRIM(ROOT)//'\PHRLEVEL_'//TRIM(CDATE)//'.IDF'; IF(.NOT.IDFWRITE(PHR,PHR%FNAME,1))STOP
   ENDIF

  ENDDO
  CLOSE(JU)

 ENDIF
 
 IF(UTL_READINITFILE('BDG',LINE,IU,1))THEN
  READ(LINE,*) BDGFNAME; WRITE(*,'(A)') 'BDG='//TRIM(BDGFNAME)
  ROOT=BDGFNAME(:INDEX(BDGFNAME,'\',.TRUE.)-1)
  JU=UTL_GETUNIT()
  OPEN(JU,FILE=BDGFNAME,STATUS='OLD',ACTION='READ',ACCESS='STREAM',FORM='UNFORMATTED') 
  DO
   READ(JU,IOSTAT=IOS) KSTP,KPER,TEXT,NDIM1,NDIM2,NDIM3; IF(IOS.NE.0)EXIT
   
!   WRITE(*,*) KSTP,KPER,TEXT,NDIM1,NDIM2,NDIM3
   
   TEXT=ADJUSTL(TEXT)

   READ(JU,IOSTAT=IOS) IMETH,DELT,PERTIM,TOTIM;          IF(IOS.NE.0)EXIT
   
!   IF(PERTIM.EQ.0.0D0)THEN
   IF(KPER.EQ.1)THEN
    CDATE='STEADY-STATE'
   ELSE
    TOTIM=TOTIM-1.0D0
    CDATE=JDATETOFDATE(TOTIM,SDATE,2)
   ENDIF

   SELECT CASE (IMETH)
    !## intercell flow + storage
    CASE (1)
     ALLOCATE(X(NDIM1,NDIM2,ABS(NDIM3)))
     READ(JU) (((X(I1,I2,I3),I1=1,NDIM1),I2=1,NDIM2),I3=1,ABS(NDIM3))
     IF(TRIM(ADJUSTL(TEXT)).EQ.'FLOW-JA-FACE')THEN
      ALLOCATE(FFF(NLAY),FRF(NLAY),FLF(NLAY))
      DO ILAY=1,NLAY
       CALL IDFNULLIFY(FFF(ILAY));  CALL IDFNULLIFY(FRF(ILAY));  CALL IDFNULLIFY(FLF(ILAY))
       CALL IDFCOPY(IDF,FFF(ILAY)); CALL IDFCOPY(IDF,FRF(ILAY)); CALL IDFCOPY(IDF,FLF(ILAY))
       FLF(ILAY)%NODATA=1.0D30; FLF(ILAY)%X=0.0D0
       FFF(ILAY)%NODATA=1.0D30; FFF(ILAY)%X=0.0D0
       FRF(ILAY)%NODATA=1.0D30; FRF(ILAY)%X=0.0D0
      ENDDO
      DO N=1,NCELLS
!       WRITE(*,'(A,I10)') 'THIS IS CELL: ', N

       NODE=N; CALL UTL_GETIROWICOL(NODE,IDF%NROW,IDF%NCOL,ILAY,IROW,ICOL)

       NCON=IA(N+1)-IA(N)-1
       IF(NCON.LE.0) NCON=0
!       WRITE(*,'(A,4I10)') 'NUMBER OF CONNECTED CELLS IS CELL,ILAY,IROW,ICOL', NCON,ILAY,IROW,ICOL
       DO IPOS=IA(N)+1,IA(N+1)-1
        M=JA(IPOS)
        Q=X(IPOS,1,1) 
        NODE=M; CALL UTL_GETIROWICOL(NODE,IDF%NROW,IDF%NCOL,JLAY,JROW,JCOL)
        !## determine what face it is
        IF(JLAY.GT.ILAY)THEN
         FLF(ILAY)%X(ICOL,IROW)=Q 
        ELSEIF(JROW.GT.IROW)THEN
         FFF(ILAY)%X(ICOL,IROW)=Q 
        ELSEIF(JCOL.GT.ICOL)THEN
         FRF(ILAY)%X(ICOL,IROW)=Q 
        ENDIF
!        WRITE(*,'(A,2I10,F10.3)') ' N M Q: ', N,M,Q
       ENDDO
      ENDDO
      DO ILAY=1,NLAY 

       LEX=.FALSE.; IF(ASSOCIATED(SAVEFLX))THEN; DO I=1,SIZE(SAVEFLX); IF(SAVEFLX(I).EQ.ILAY.OR.SAVEFLX(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
   
       IF(LEX)THEN
        IDF%NODATA=1.0D30
        IF(ILAY.LT.NLAY)THEN 
         TEXT='BDGFLF'; IDF%FNAME=TRIM(ROOT)//'\'//TRIM(TEXT)//'\'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
         IF(.NOT.IDFWRITE(FLF(ILAY),IDF%FNAME,1))STOP
        ENDIF
        TEXT='BDGFRF'; IDF%FNAME=TRIM(ROOT)//'\'//TRIM(TEXT)//'\'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
        IF(.NOT.IDFWRITE(FRF(ILAY),IDF%FNAME,1))STOP
        TEXT='BDGFFF'; IDF%FNAME=TRIM(ROOT)//'\'//TRIM(TEXT)//'\'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
        IF(.NOT.IDFWRITE(FFF(ILAY),IDF%FNAME,1))STOP
       ENDIF
      
      ENDDO
      CALL IDFDEALLOCATE(FFF,SIZE(FFF)); CALL IDFDEALLOCATE(FRF,SIZE(FRF)); CALL IDFDEALLOCATE(FLF,SIZE(FLF))
      DEALLOCATE(FFF,FRF,FLF)
     ELSE
      IF(TRIM(TEXT).EQ.'STO-SS')TEXT='STO'; IF(TRIM(TEXT).EQ.'STO-SY')TEXT='SPY'
      DO ILAY=1,ABS(NDIM3)
       LEX=.FALSE.
       SELECT CASE (TEXT)
        CASE ('WEL'); IF(ASSOCIATED(SAVEWEL))THEN; DO I=1,SIZE(SAVEWEL); IF(SAVEWEL(I).EQ.ILAY.OR.SAVEWEL(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('DRN'); IF(ASSOCIATED(SAVEDRN))THEN; DO I=1,SIZE(SAVEDRN); IF(SAVEDRN(I).EQ.ILAY.OR.SAVEDRN(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('RIV'); IF(ASSOCIATED(SAVERIV))THEN; DO I=1,SIZE(SAVERIV); IF(SAVERIV(I).EQ.ILAY.OR.SAVERIV(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('GHB'); IF(ASSOCIATED(SAVEGHB))THEN; DO I=1,SIZE(SAVEGHB); IF(SAVEGHB(I).EQ.ILAY.OR.SAVEGHB(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('RCH'); IF(ASSOCIATED(SAVERCH))THEN; DO I=1,SIZE(SAVERCH); IF(SAVERCH(I).EQ.ILAY.OR.SAVERCH(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('EVT'); IF(ASSOCIATED(SAVEEVT))THEN; DO I=1,SIZE(SAVEEVT); IF(SAVEEVT(I).EQ.ILAY.OR.SAVEEVT(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('CHD'); IF(ASSOCIATED(SAVECHD))THEN; DO I=1,SIZE(SAVECHD); IF(SAVECHD(I).EQ.ILAY.OR.SAVECHD(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('STO'); IF(ASSOCIATED(SAVESTO))THEN; DO I=1,SIZE(SAVESTO); IF(SAVESTO(I).EQ.ILAY.OR.SAVESTO(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('SPY'); IF(ASSOCIATED(SAVESPY))THEN; DO I=1,SIZE(SAVESPY); IF(SAVESPY(I).EQ.ILAY.OR.SAVESPY(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
       END SELECT
       IF(LEX)THEN
        DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL; IDF%X(ICOL,IROW)=X(ICOL,IROW,ILAY); ENDDO; ENDDO
        IDF%FNAME=TRIM(ROOT)//'\BDG'//TRIM(TEXT)//'\BDG'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
        IF(.NOT.IDFWRITE(IDF,IDF%FNAME,1))STOP
       ENDIF
      ENDDO
     ENDIF
     DEALLOCATE(X)

    !## packages + connected flow to submodels
    CASE (6)

     READ(JU) TXT1ID1; READ(JU) TXT2ID1; READ(JU) TXT1ID2; READ(JU) TXT2ID2
     READ(JU) NDAT
     IF(NDAT.GT.1)THEN; ALLOCATE(AUXTXT(NDAT-1)); READ(JU) (AUXTXT(I),I=1,NDAT-1); ENDIF
     READ(JU) NLIST
     IF(NLIST.GT.0)THEN
!      write(*,*) txt1id1,txt2id1,txt1id2,txt2id2,nlist
      ALLOCATE(ID1(NLIST),ID2(NLIST),X(NDAT,NLIST,1))
      READ(JU) ((ID1(J),ID2(J),(X(I,J,1),I=1,NDAT)),J=1,NLIST)

      IDF%NODATA=1.0D30; ALLOCATE(Y(NDIM1,NDIM2,ABS(NDIM3))); Y=0.0D0
      CALL IMODBATCH_MF6TOIDF_FILLY(Y,SIZE(Y),ID1,NLIST,X(:,:,1),NDAT)
      IF(TRIM(UTL_CAP(TEXT,'U')).EQ.'FLOW-JA-FACE')THEN
       TEXT='BDG'//ADJUSTL(TXT1ID2)
      ELSE
       TEXT='BDG'//ADJUSTL(TXT2ID2) !TXT1ID2)
      ENDIF
      DO ILAY=1,ABS(NDIM3)
       LEX=.FALSE.
       SELECT CASE (TEXT)
        CASE ('WEL'); IF(ASSOCIATED(SAVEWEL))THEN; DO I=1,SIZE(SAVEWEL); IF(SAVEWEL(I).EQ.ILAY.OR.SAVEWEL(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('DRN'); IF(ASSOCIATED(SAVEDRN))THEN; DO I=1,SIZE(SAVEDRN); IF(SAVEDRN(I).EQ.ILAY.OR.SAVEDRN(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('RIV'); IF(ASSOCIATED(SAVERIV))THEN; DO I=1,SIZE(SAVERIV); IF(SAVERIV(I).EQ.ILAY.OR.SAVERIV(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('GHB'); IF(ASSOCIATED(SAVEGHB))THEN; DO I=1,SIZE(SAVEGHB); IF(SAVEGHB(I).EQ.ILAY.OR.SAVEGHB(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('RCH'); IF(ASSOCIATED(SAVERCH))THEN; DO I=1,SIZE(SAVERCH); IF(SAVERCH(I).EQ.ILAY.OR.SAVERCH(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('EVT'); IF(ASSOCIATED(SAVEEVT))THEN; DO I=1,SIZE(SAVEEVT); IF(SAVEEVT(I).EQ.ILAY.OR.SAVEEVT(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
        CASE ('CHD'); IF(ASSOCIATED(SAVECHD))THEN; DO I=1,SIZE(SAVECHD); IF(SAVECHD(I).EQ.ILAY.OR.SAVECHD(I).EQ.-1)LEX=.TRUE.; ENDDO; ENDIF
       END SELECT
       IF(LEX)THEN
        IDF%X=IDF%NODATA
        DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL; IF(Y(ICOL,IROW,ILAY).NE.0.0D0)IDF%X(ICOL,IROW)=Y(ICOL,IROW,ILAY); ENDDO; ENDDO
        IDF%FNAME=TRIM(ROOT)//'\'//TRIM(TEXT)//'\'//TRIM(TEXT)//'_'//TRIM(CDATE)//'_L'//TRIM(ITOS(ILAY))//'.IDF'
        IF(.NOT.IDFWRITE(IDF,IDF%FNAME,1))STOP
       ENDIF
      ENDDO
      DEALLOCATE(ID1,ID2,X,Y)
     ENDIF    
     IF(NDAT.GT.1)DEALLOCATE(AUXTXT)
    CASE DEFAULT
     WRITE(*,'(/A,I10/)') 'Cannot distinguish IMETH type ',IMETH; STOP
   END SELECT
  ENDDO
  CLOSE(JU)
 ENDIF

 END SUBROUTINE IMODBATCH_MF6TOIDF
 
 !###======================================================================
 SUBROUTINE IMODBATCH_MF6TOIDF_FILLY(Y,NY,ID1,NLIST,X,NDAT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NY,NLIST,NDAT
 REAL(KIND=DP_KIND),INTENT(OUT),DIMENSION(NY) :: Y
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(NDAT,NLIST) :: X
 INTEGER,INTENT(IN),DIMENSION(NLIST) :: ID1 
 INTEGER :: I

 DO I=1,NLIST
  IPOS=ID1(I); Y(IPOS)=Y(IPOS)+X(1,I)
 ENDDO

 END SUBROUTINE IMODBATCH_MF6TOIDF_FILLY
 
 !###======================================================================
 SUBROUTINE IMODBATCH_XYZTOVOXEL()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: XYZFILE,OUTPUTDIR
 INTEGER :: IWINDOW
 REAL(KIND=DP_KIND) :: CELLSIZE,X1,Y1,X2,Y2,DZV,MULT
 TYPE(IDFOBJ) :: TOP,BOT
 
 IF(.NOT.UTL_READINITFILE('XYZFILE',LINE,IU,0))RETURN
 READ(LINE,*) XYZFILE; WRITE(*,'(A)') 'XYZFILE='//TRIM(XYZFILE)
 IF(.NOT.UTL_READINITFILE('OUTPUTDIR',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTDIR; WRITE(*,'(A)') 'OUTPUTDIR='//TRIM(OUTPUTDIR)
 IWINDOW=0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IWINDOW=1; READ(LINE,*) X1,Y1,X2,Y2; WRITE(*,'(A,4F10.2)') 'WINDOW=',X1,Y1,X2,Y2
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) CELLSIZE; WRITE(*,'(A,F10.2)') 'CELLSIZE=',CELLSIZE
 ELSE
  CELLSIZE=0.0D0; IF(UTL_READINITFILE('CELLSIZE',LINE,IU,1))THEN
   READ(LINE,*) CELLSIZE; WRITE(*,'(A,F10.2)') 'CELLSIZE=',CELLSIZE
  ENDIF
 ENDIF
 DZV=0.0D0; IF(UTL_READINITFILE('DZV',LINE,IU,1))THEN
  READ(LINE,*) DZV; WRITE(*,'(A,F10.2)') 'DZV=',DZV
 ENDIF
 IF(.NOT.UTL_READINITFILE('TOPIDF',LINE,IU,0))RETURN
 READ(LINE,*) TOP%FNAME; WRITE(*,'(A)') 'TOPIDF='//TRIM(TOP%FNAME)
 IF(.NOT.UTL_READINITFILE('BOTIDF',LINE,IU,0))RETURN
 READ(LINE,*) BOT%FNAME; WRITE(*,'(A)') 'BOTIDF='//TRIM(BOT%FNAME)
 IF(.NOT.UTL_READINITFILE('MULT',LINE,IU,0))RETURN
 READ(LINE,*) MULT; WRITE(*,'(A)') 'MULT='//TRIM(RTOS(MULT,'G',7))
 
 IF(.NOT.ASC2IDF_IMPORTXYZ_VOXEL(XYZFILE,OUTPUTDIR,IWINDOW,X1,Y1,X2,Y2, &
     CELLSIZE,DZV,TOP,BOT,MULT))RETURN
 
 END SUBROUTINE IMODBATCH_XYZTOVOXEL
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEENSEMBLES()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX,MINVALUE,MAXVALUE,STDV,AVERAGE
 INTEGER :: IN_TYPE,NSIM,ILOGTRANSFORM,I
 TYPE(IDFOBJ) :: MEAN,STDEV
 CHARACTER(LEN=256) :: DIR
  
 IXCOL=1; IYCOL=2; IZCOL=3; ASSF_COLUMN=0; ASSF_STARTDATE=0; ASSF_ENDDATE=0; ASSF_DDATE=0; ASSF_CDDATE=''; TRIMDEPTH_IDF%FNAME=''
 ASSF_IDEPTH=0; ASSF_TOP=0.0D0; ASSF_BOT=0.0D0; ASSF_DZ=0.0D0; ASSF_NTHRESHOLD=1; ASSF_INDICATOR=0; ELLIPS_IDF%FNAME=''; ASSF_ZPLUS=0.0D0; ZONE_IDF%FNAME=''
 ELLIPS_IDF%IU=0; ZONE_IDF%IU=0; IWFACTOR=0; ILOGTRANSFORM=0

 XMIN=0.0D0; YMIN=0.0D0; XMAX=0.0D0; YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) XMIN,YMIN,XMAX,YMAX; WRITE(*,'(A,4F10.2)') 'WINDOW=',XMIN,YMIN,XMAX,YMAX
  IF(.NOT.UTL_READINITFILE('CS',LINE,IU,0))RETURN
  READ(LINE,*) CS; WRITE(*,'(A,F10.3)') 'CS=',CS
 ENDIF

 ALLOCATE(XYZFNAMES(2)); XYZFNAMES='' 

 IF(.NOT.UTL_READINITFILE('NSIM',LINE,IU,0))RETURN
 READ(LINE,*) NSIM; WRITE(*,'(A,I10)') 'NSIM=',NSIM

 IF(UTL_READINITFILE('RANGE',LINE,IU,1))READ(LINE,*) RANGE
 WRITE(*,'(A,F10.2)') 'RANGE=',RANGE

 IF(.NOT.UTL_READINITFILE('IDFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IDFFILE; WRITE(*,'(A)') 'IDFFILE='//TRIM(IDFFILE)  !## points from idf files
 IF(.NOT.UTL_READINITFILE('STDEVIDF',LINE,IU,0))RETURN
 READ(LINE,*) STDEVIDF; WRITE(*,'(A)') 'STDEVIDF='//TRIM(STDEVIDF)

 IF(.NOT.UTL_READINITFILE('LOGTRANSFORM',LINE,IU,0))RETURN; READ(LINE,*) ILOGTRANSFORM
 WRITE(*,'(A,I10)') 'LOGTRANSFORM=',ILOGTRANSFORM

 IF(UTL_READINITFILE('IPFFILE',LINE,IU,1))THEN
  READ(LINE,*) XYZFNAMES(1); WRITE(*,'(A)') 'IPFFILE='//TRIM(XYZFNAMES(1)); IN_TYPE=2

  IF(.NOT.UTL_READINITFILE('KTYPE',LINE,IU,0))RETURN
  READ(LINE,*) KTYPE; WRITE(*,'(A,I10)') 'KTYPE=',KTYPE
  IF(.NOT.UTL_READINITFILE('SILL',LINE,IU,0))RETURN
  READ(LINE,*) SILL; WRITE(*,*) 'SILL=',SILL
  IF(.NOT.UTL_READINITFILE('NUGGET',LINE,IU,0))RETURN
  READ(LINE,*) NUGGET; WRITE(*,*) 'NUGGET=',NUGGET
  IF(NUGGET.LT.0.0D0)THEN
   WRITE(*,'(/A/)') 'It is not allowed to have a NUGGET value of less than zero'; STOP
  ENDIF

  IF(UTL_READINITFILE('NODATA',LINE,IU,1))READ(LINE,*) NODATA
  WRITE(*,'(A,F10.2)') 'NODATA=',NODATA

  IF(.NOT.UTL_READINITFILE('IGRIDFUNC',LINE,IU,0))RETURN
  READ(LINE,*) IGRIDFUNC; WRITE(*,'(A,I2)') 'GRIDFUNC=',IGRIDFUNC
  IF(ABS(IGRIDFUNC).NE.6)STOP 'IGRIDFUNC NEED TO BE -6 (SK) OR 6 (OK)'
 
  IF(UTL_READINITFILE('COINCIDENT',LINE,IU,1))THEN  
   READ(LINE,*) COINCIDENTDIST; WRITE(*,*) 'COINCIDENT=',COINCIDENTDIST
   COINCIDENT=1
  ENDIF
 
  PNTSEARCH=0; IF(UTL_READINITFILE('PNTSEARCH',LINE,IU,1))READ(LINE,*) PNTSEARCH
  WRITE(*,'(A,I10)') 'PNTSEARCH=',PNTSEARCH
  MAXPNT=0
  IF(PNTSEARCH.EQ.1)THEN
   IF(UTL_READINITFILE('MAXPNT',LINE,IU,1))READ(LINE,*) MAXPNT
   WRITE(*,'(A,I10)') 'MAXPNT=',MAXPNT
   IQUADRANT=0; IF(UTL_READINITFILE('IQUADRANT',LINE,IU,1))READ(LINE,*) IQUADRANT
   WRITE(*,'(A,I10)') 'IQUADRANT=',IQUADRANT
   IF(IQUADRANT.EQ.0)THEN
    IF(UTL_READINITFILE('ZONE_IDF',LINE,IU,1))READ(LINE,'(A)') ZONE_IDF%FNAME
    IF(TRIM(ZONE_IDF%FNAME).NE.'')WRITE(*,'(A)') 'ZONE_IDF='//TRIM(ZONE_IDF%FNAME)
    DO I=1,3
     IF(UTL_READINITFILE('ELLIPS_ANGLE'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,'(A)') ELLIPS_IDF(I,1)%FNAME
     IF(TRIM(ELLIPS_IDF(I,1)%FNAME).NE.'')WRITE(*,'(A)') 'ELLIPS_ANGLE'//TRIM(ITOS(I))//'='//TRIM(ELLIPS_IDF(I,1)%FNAME)
     IF(UTL_READINITFILE('ELLIPS_RANGE'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,'(A)') ELLIPS_IDF(I,2)%FNAME
     IF(TRIM(ELLIPS_IDF(I,2)%FNAME).NE.'')WRITE(*,'(A)') 'ELLIPS_RANGE'//TRIM(ITOS(I))//'='//TRIM(ELLIPS_IDF(I,2)%FNAME)
    ENDDO
   ENDIF
  ENDIF
  
  !## perform kriging to get stdev spatially
  IF(.NOT.ASC2IDF_INT_MAIN(1,1,XMIN,YMIN,XMAX,YMAX,IN_TYPE))STOP

  !## read the mean/stdev again
  IF(.NOT.IDFREAD(MEAN,IDFFILE,1))STOP
  !## error standard-deviation (s=sqrt(variance)) - used as parameter variance=s^2
  IF(.NOT.IDFREAD(STDEV,STDEVIDF,1))STOP

  !## fill in variance (kriging)
  SILL=1.0D0; NUGGET=0.0D0
 
 ! KTYPE=2 !OKAY - SPHERICAL STOPS @ 1
  KTYPE=3 !OKAY - exponential STOPS @ 1
 ! KTYPE=4 !niet OKAY - gaussian STOPS @ 1
 ! KTYPE=1 NIET OKAY OOKAL STOPS HIJ @1 
 ELSE

  !## set sill/nugget for cholesky/eigenvalue decomposition
  SILL=1.0D0; NUGGET=0.0D0; KTYPE=3

  IF(.NOT.UTL_READINITFILE('MINVALUE',LINE,IU,0))RETURN; READ(LINE,*) MINVALUE
  WRITE(*,'(A,F10.2)') 'MINVALUE=',MINVALUE
  IF(.NOT.UTL_READINITFILE('MAXVALUE',LINE,IU,0))RETURN; READ(LINE,*) MAXVALUE
  WRITE(*,'(A,F10.2)') 'MAXVALUE=',MAXVALUE

  MEAN%XMIN=XMIN; MEAN%XMAX=XMAX; MEAN%YMIN=YMIN; MEAN%YMAX=YMAX; MEAN%DX=CS; MEAN%DY=MEAN%DX; MEAN%ITYPE=4
  CALL UTL_IDFSNAPTOGRID_LLC(MEAN%XMIN,MEAN%XMAX,MEAN%YMIN,MEAN%YMAX,MEAN%DX,MEAN%DX,MEAN%NCOL,MEAN%NROW) !,LLC)
  IF(.NOT.IDFALLOCATEX(MEAN))STOP
  CALL IDFCOPY(MEAN,STDEV)
  IF(.NOT.IDFALLOCATEX(STDEV))STOP
  IF(ILOGTRANSFORM.EQ.0)THEN
   AVERAGE=(MAXVALUE+MINVALUE)/2.0D0
   STDV   =(MAXVALUE-MINVALUE)/4.0D0
  ELSE
   AVERAGE=(LOG10(ABS(MAXVALUE))+LOG10(ABS(MINVALUE)))/2.0D0
   STDV   =(LOG10(ABS(MAXVALUE))-LOG10(ABS(MINVALUE)))/4.0D0
  ENDIF
  MEAN%X=AVERAGE; MEAN%NODATA =-999.99D0
  STDEV%X=STDV;   STDEV%NODATA=-999.99D0
  WRITE(*,*) 'AVERAGE,STDEV',AVERAGE,STDV
 ENDIF
 
 DIR=IDFFILE(:INDEX(IDFFILE,'\',.TRUE.)-1)
 CALL IMODBATCH_CREATEENSEMBLES_CHOLESKY(STDEV,MEAN,DIR,RANGE,NSIM,'ENSEMBLE',ILOGTRANSFORM)
 
 CALL IDFDEALLOCATEX(STDEV); CALL IDFDEALLOCATEX(MEAN)
 
 END SUBROUTINE IMODBATCH_CREATEENSEMBLES
 
 !###======================================================================
 SUBROUTINE IMODBATCH_XYZTOIDF_MAIN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,N,IN_TYPE,JU,M,IDATE,SDATE,EDATE,DDATE,IOS,ICOL,IROW,JF,ID,KSUM,ILAY,NLAYVAL,NBLNFILE,MAXPOINT
 CHARACTER(LEN=3) :: EXT
 CHARACTER(LEN=52) :: GRIDFUNC,WC,ROOT
 CHARACTER(LEN=256) :: FNAMEVAL,SNAME
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX,Z1,Z2,MF,KHVAL,VCVAL
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: VOXEL
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: DZVAL=>NULL()
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: XYZRANGE=>NULL()

 IBLNTYPE=0; NBLNFILE=0; COINCIDENT=0; TRIMCONF_IDF=1; MAXPOINT=0

 N=0; IN_TYPE=0
 IF(UTL_READINITFILE('SOURCEDIR',LINE,IU,1))THEN
  READ(LINE,*) SOURCEDIR
  WRITE(*,'(A)') 'SOURCEDIR='//TRIM(SOURCEDIR)
  I=INDEX(SOURCEDIR,'\',.TRUE.); ROOT=SOURCEDIR(:I-1); WC=TRIM(SOURCEDIR(I+1:))
  CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOT),TRIM(WC),N)
  IF(N.EQ.0)THEN
   WRITE(*,'(A)') 'No files found in: '//TRIM(SOURCEDIR)
   RETURN
  ENDIF
  ALLOCATE(XYZFNAMES(N)); XYZFNAMES=''
  CALL UTL_DIRINFO(TRIM(ROOT),TRIM(WC),XYZFNAMES,N,'F')
  IF(.NOT.UTL_READINITFILE('TARGETDIR',LINE,IU,0))RETURN
  READ(LINE,*) TARGETDIR
  WRITE(*,'(A)') 'TARGETDIR='//TRIM(TARGETDIR)
 ELSE
  ALLOCATE(XYZFNAMES(2)); XYZFNAMES=''
  IF(UTL_READINITFILE('XYZFILE',LINE,IU,1))THEN
   READ(LINE,*) XYZFNAMES(1); WRITE(*,'(A)') 'XYZFILE='//TRIM(XYZFNAMES(1)); IN_TYPE=1
  ENDIF
  IF(UTL_READINITFILE('IPFFILE',LINE,IU,1))THEN
   READ(LINE,*) XYZFNAMES(1); WRITE(*,'(A)') 'IPFFILE='//TRIM(XYZFNAMES(1)); IN_TYPE=2
  ENDIF
  IF(UTL_READINITFILE('IDFFILE_IN',LINE,IU,1))THEN
   READ(LINE,*) XYZFNAMES(1); WRITE(*,'(A)') 'IDFFILE_IN='//TRIM(XYZFNAMES(1)); IN_TYPE=3
   IF(UTL_READINITFILE('MASKIDF',LINE,IU,1))THEN
    READ(LINE,*) XYZFNAMES(2); WRITE(*,'(A)') 'MASKIDF='//TRIM(XYZFNAMES(2))
   ENDIF
  ENDIF
  IF(UTL_READINITFILE('GENFILE',LINE,IU,1))THEN
   READ(LINE,*) XYZFNAMES(1); WRITE(*,'(A)') 'GENFILE='//TRIM(XYZFNAMES(1)); IN_TYPE=4
  ENDIF
 ENDIF

 XMIN=0.0D0; YMIN=0.0D0; XMAX=0.0D0; YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) XMIN,YMIN,XMAX,YMAX; WRITE(*,'(A,4F10.2)') 'WINDOW=',XMIN,YMIN,XMAX,YMAX
 ENDIF

 NODATA=-999.99D0
 IF(UTL_READINITFILE('NODATA',LINE,IU,1))READ(LINE,*) NODATA
 WRITE(*,'(A,F10.2)') 'NODATA=',NODATA
 
 IXCOL=1; IYCOL=2; IZCOL=3; ASSF_COLUMN=0; ASSF_STARTDATE=0; ASSF_ENDDATE=0; ASSF_DDATE=0; ASSF_CDDATE=''; TRIMDEPTH_IDF%FNAME=''
 ASSF_IDEPTH=0; ASSF_TOP=0.0D0; ASSF_BOT=0.0D0; ASSF_DZ=0.0D0; ASSF_NTHRESHOLD=1; ASSF_INDICATOR=0; ELLIPS_IDF%FNAME=''; ASSF_ZPLUS=0.0D0; ZONE_IDF%FNAME=''
 ELLIPS_IDF%IU=0; ZONE_IDF%IU=0; IWFACTOR=0

 IF(IN_TYPE.EQ.2)THEN
  IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IXCOL
  IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IYCOL
  IF(UTL_READINITFILE('IZCOL',LINE,IU,1))READ(LINE,*) IZCOL
  IF(UTL_READINITFILE('IWCOL',LINE,IU,1)) READ(LINE,*) IWCOL
  WRITE(*,'(A,I10)') 'IXCOL=',IXCOL
  WRITE(*,'(A,I10)') 'IYCOL=',IYCOL
  WRITE(*,'(A,I10)') 'IZCOL=',IZCOL    
  WRITE(*,'(A,I10)') 'IWCOL=',IWCOL
 
  !## apply weight-column - how
  IF(IWCOL.GT.0)THEN
   IF(UTL_READINITFILE('IWFACTOR',LINE,IU,1)) READ(LINE,*) IWFACTOR
   SELECT CASE (IWFACTOR)
    CASE (1); WRITE(*,'(A,I1,A)') 'IWFACTOR=',IWFACTOR,' 1-(3-MIN(3,LOG(W))'
    CASE DEFAULT; WRITE(*,'(/A/)') 'UNKNOWN WEIGHT PROCEDURE'; STOP
   END SELECT
  ENDIF
  !## if zcol eq iext then specify period for gridding
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=XYZFNAMES(1),STATUS='OLD',FORM='FORMATTED',ACTION='READ,DENYWRITE')
  IF(JU.EQ.0)THEN
   WRITE(*,'(/1X,A/)') 'Error, cannot find '//TRIM(XYZFNAMES(1)); STOP
  ENDIF
  READ(JU,*) M; READ(JU,*) M; DO I=1,M; READ(JU,*); ENDDO; READ(JU,*) M; CLOSE(JU)
  IF(M.GT.0.AND.M.EQ.IZCOL)THEN

   IF(.NOT.UTL_READINITFILE('ASSF_IDEPTH',LINE,IU,0))RETURN
   READ(LINE,*) ASSF_IDEPTH; WRITE(*,'(A,I10)') 'ASSF_IDEPTH=',ASSF_IDEPTH

   SELECT CASE (ASSF_IDEPTH)
    CASE (1,2,3)
     IF(.NOT.UTL_READINITFILE('ASSF_COLUMN',LINE,IU,0))RETURN
     READ(LINE,*) ASSF_COLUMN; WRITE(*,'(A,I3)') 'ASSF_COLUMN=',ASSF_COLUMN
    !## always use column=1 for these types
    CASE DEFAULT 
     ASSF_COLUMN=1
   END SELECT

   IF(ASSF_IDEPTH.EQ.0)THEN
    WRITE(*,'(/A/)') '>>> Dates are processed <<<'
    IF(.NOT.UTL_READINITFILE('ASSF_STARTDATE',LINE,IU,0))RETURN
    READ(LINE,*) ASSF_STARTDATE; WRITE(*,'(A,I10)') 'ASSF_STARTDATE=',ASSF_STARTDATE
    IF(.NOT.UTL_READINITFILE('ASSF_ENDDATE',LINE,IU,0))RETURN
    READ(LINE,*) ASSF_ENDDATE; WRITE(*,'(A,I10)') 'ASSF_ENDDATE=',ASSF_ENDDATE
    IF(.NOT.UTL_READINITFILE('ASSF_DDATE',LINE,IU,0))RETURN
    READ(LINE,*,IOSTAT=IOS) ASSF_DDATE
    IF(IOS.EQ.0)THEN
     WRITE(*,'(A,I10)') 'ASSF_DDATE=',ASSF_DDATE
    ELSE
     READ(LINE,*,IOSTAT=IOS) ASSF_CDDATE
     SELECT CASE (ASSF_CDDATE)
      CASE('D','W','M','Y','T')
      CASE DEFAULT
       WRITE(*,'(A)') 'SPECIFY ASSF_DDATE TO BE D,W,M,Y,T'
     END SELECT
     WRITE(*,'(A,A1)') 'ASSF_DDATE=',ASSF_CDDATE
    ENDIF
    ASSF_STARTDATE=UTL_IDATETOJDATE(ASSF_STARTDATE)
    ASSF_ENDDATE  =UTL_IDATETOJDATE(ASSF_ENDDATE)
    ALLOCATE(ASSF_THRESHOLD(1)); ASSF_THRESHOLD=''
    ALLOCATE(ASSF_KH_THRESHOLD(1)); ASSF_KH_THRESHOLD=0.0D0
    ALLOCATE(ASSF_KV_THRESHOLD(1)); ASSF_KV_THRESHOLD=0.0D0

   ELSE
    WRITE(*,'(/A/)') '>>> Depths are processed <<<'

    IF(ASSF_IDEPTH.EQ.1)THEN

     WRITE(*,'(/A/)') '>>> VOXEL model is created with constant elevations <<<'

     IF(.NOT.UTL_READINITFILE('ASSF_TOP',LINE,IU,0))RETURN
     READ(LINE,*) ASSF_TOP; WRITE(*,'(A,F10.2)') 'ASSF_TOP=',ASSF_TOP
     IF(.NOT.UTL_READINITFILE('ASSF_BOT',LINE,IU,0))RETURN
     READ(LINE,*) ASSF_BOT; WRITE(*,'(A,F10.2)') 'ASSF_BOT=',ASSF_BOT
     IF(.NOT.UTL_READPOINTER_REAL(IU,I,DZVAL,'ASSF_DZ',0,EXCLVALUE=0.0D0))RETURN
     DO I=1,SIZE(DZVAL)
      IF(DZVAL(I).LE.0.0D0)THEN
       LINE='DZ('//TRIM(ITOS(I))//')='//TRIM(RTOS(DZVAL(I),'F',3))
       WRITE(*,'(A)') TRIM(LINE)//' which is not allowed'
      ENDIF
     ENDDO
     IF(UTL_READINITFILE('ASSF_ZPLUS',LINE,IU,1))READ(LINE,*) ASSF_ZPLUS
     WRITE(*,'(A,F10.2)') 'ASSF_ZPLUS=',ASSF_ZPLUS
     IF(UTL_READINITFILE('TRIMTOP_IDF',LINE,IU,1))READ(LINE,'(A)') TRIMDEPTH_IDF(1)%FNAME
     IF(TRIM(TRIMDEPTH_IDF(1)%FNAME).NE.'')WRITE(*,'(A)') 'TRIMTOP_IDF='//TRIM(TRIMDEPTH_IDF(1)%FNAME)
     IF(UTL_READINITFILE('TRIMBOT_IDF',LINE,IU,1))READ(LINE,'(A)') TRIMDEPTH_IDF(2)%FNAME
     IF(TRIM(TRIMDEPTH_IDF(2)%FNAME).NE.'')WRITE(*,'(A)') 'TRIMBOT_IDF='//TRIM(TRIMDEPTH_IDF(2)%FNAME)
     IF(UTL_READINITFILE('TRIMCONF_IDF',LINE,IU,1))READ(LINE,*) TRIMCONF_IDF
     WRITE(*,'(A,I1)') 'TRIMCONF_IDF',TRIMCONF_IDF

     ALLOCATE(ASSF_THRESHOLD(1)); ASSF_THRESHOLD=''
     ALLOCATE(ASSF_KH_THRESHOLD(1)); ASSF_KH_THRESHOLD=0.0D0
     ALLOCATE(ASSF_KV_THRESHOLD(1)); ASSF_KV_THRESHOLD=0.0D0

    ELSEIF(ASSF_IDEPTH.EQ.2)THEN

     WRITE(*,'(/A/)') '>>> VOXEL model is created with spatial elevations <<<'

     IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
     READ(LINE,*) NLAYVAL; WRITE(*,'(A,I3)') 'NLAY=',NLAYVAL
     ALLOCATE(INT_IDF(NLAYVAL))
     DO ILAY=1,NLAYVAL
      IF(.NOT.UTL_READINITFILE('INT_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
      READ(LINE,*) INT_IDF(ILAY)%FNAME; LINE='INT_L'//TRIM(ITOS(ILAY)); WRITE(*,'(A,I3)') TRIM(LINE)//'='//TRIM(INT_IDF(ILAY)%FNAME)
     ENDDO    
     ALLOCATE(ASSF_THRESHOLD(1)); ASSF_THRESHOLD=''
     ALLOCATE(ASSF_KH_THRESHOLD(1)); ASSF_KH_THRESHOLD=0.0D0
     ALLOCATE(ASSF_KV_THRESHOLD(1)); ASSF_KV_THRESHOLD=0.0D0

    !## interface(3)/thickness(4) from boreholes interpolated
    ELSEIF(ASSF_IDEPTH.EQ.3.OR.ASSF_IDEPTH.EQ.4)THEN
    
     IF(ASSF_IDEPTH.EQ.3)WRITE(*,'(/A/)') '>>> 3D model is created per interface ELEVATION <<<'
     IF(ASSF_IDEPTH.EQ.4)WRITE(*,'(/A/)') '>>> 3D model is created per interface THICKNESS <<<'

     IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
     READ(LINE,*) NLAYVAL
     IF(NLAYVAL.GT.0)THEN
      WRITE(*,'(A,I3)') 'NLAY IS 1 UP TO ',NLAYVAL
     ELSEIF(NLAYVAL.LT.0)THEN
      WRITE(*,'(A,I3)') 'NLAY IS ',ABS(NLAYVAL)
     ELSE
      STOP 'NLAY NEED TO BE <>0'
     ENDIF
     
    ENDIF

    !## indicator
    ASSF_INDICATOR=0
    IF(UTL_READINITFILE('INDICATOR',LINE,IU,1))THEN
     READ(LINE,*) ASSF_INDICATOR; WRITE(*,*) 'INDICATOR=',ASSF_INDICATOR
     IF(.NOT.UTL_READINITFILE('NTHRESHOLD',LINE,IU,0))RETURN
     ASSF_NTHRESHOLD=0; READ(LINE,*) ASSF_NTHRESHOLD; WRITE(*,*) 'NTHRESHOLD=',ASSF_NTHRESHOLD

     IF(ALLOCATED(ASSF_THRESHOLD  ))DEALLOCATE(ASSF_THRESHOLD  )
     IF(ALLOCATED(ASSF_KH_THRESHOLD))DEALLOCATE(ASSF_KH_THRESHOLD)
     IF(ALLOCATED(ASSF_KV_THRESHOLD))DEALLOCATE(ASSF_KV_THRESHOLD)
     ALLOCATE(ASSF_THRESHOLD(ASSF_NTHRESHOLD)); ASSF_THRESHOLD=''
     ALLOCATE(ASSF_KH_THRESHOLD(ASSF_NTHRESHOLD)); ASSF_KH_THRESHOLD=0.0D0
     ALLOCATE(ASSF_KV_THRESHOLD(ASSF_NTHRESHOLD)); ASSF_KV_THRESHOLD=0.0D0

     DO I=1,ASSF_NTHRESHOLD
      IF(.NOT.UTL_READINITFILE('THRESHOLD'//TRIM(ITOS(I)),LINE,IU,0))RETURN
      READ(LINE,*) ASSF_THRESHOLD(I); WRITE(*,*) 'THRESHOLD'//TRIM(ITOS(I))//'=',ASSF_THRESHOLD(I)
      IF(.NOT.UTL_READINITFILE('KH_THRESHOLD'//TRIM(ITOS(I)),LINE,IU,0))RETURN
      READ(LINE,*) ASSF_KH_THRESHOLD(I); WRITE(*,*) 'KH_THRESHOLD'//TRIM(ITOS(I))//'=',ASSF_KH_THRESHOLD(I)
      IF(.NOT.UTL_READINITFILE('KV_THRESHOLD'//TRIM(ITOS(I)),LINE,IU,0))RETURN
      READ(LINE,*) ASSF_KV_THRESHOLD(I); WRITE(*,*) 'KV_THRESHOLD'//TRIM(ITOS(I))//'=',ASSF_KV_THRESHOLD(I)
     ENDDO
     KSUM=0; IF(UTL_READINITFILE('KSUM',LINE,IU,1))READ(LINE,*) KSUM
     WRITE(*,*) 'KSUM=',KSUM
    ELSE
     IF(.NOT.ALLOCATED(ASSF_THRESHOLD))THEN
      ALLOCATE(ASSF_THRESHOLD(ASSF_NTHRESHOLD)); ASSF_THRESHOLD=''
     ENDIF
    ENDIF

   ENDIF
  ENDIF
 !## genfile
 ELSEIF(IN_TYPE.EQ.4)THEN
  IF(UTL_READINITFILE('IZCOL',LINE,IU,1))READ(LINE,*) IZCOL
  WRITE(*,'(A,I10)') 'IZCOL=',IZCOL
  NV=0; NL=0
  !## reading labels
  WRITE(*,'(A)') 'Reading '//XYZFNAMES(1)(:INDEX(XYZFNAMES(1),'.',.TRUE.)-1)//'.dat ...'
  CALL UTL_GENLABELSREAD(XYZFNAMES(1)(:INDEX(XYZFNAMES(1),'.',.TRUE.)-1)//'.dat',VAR,NL,NV)
  IF(IZCOL.GT.NV)THEN; WRITE(*,'(A)') 'Error, entered label number exceeds available label'; STOP; ENDIF
 ENDIF

 ILOG=0; IF(UTL_READINITFILE('ILOG',LINE,IU,1))THEN
  READ(LINE,*) ILOG; WRITE(*,'(A,I10)') 'ILOG=',ILOG
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('GRIDFUNC',LINE,IU,0))RETURN
 READ(LINE,*) GRIDFUNC; GRIDFUNC=UTL_CAP(GRIDFUNC,'U'); WRITE(*,'(A)') 'GRIDFUNC='//TRIM(GRIDFUNC)

 IGRIDFUNC=0
 SELECT CASE (GRIDFUNC)
  CASE ('MIN');       IGRIDFUNC= 1
  CASE ('MAX');       IGRIDFUNC= 2
  CASE ('MEAN');      IGRIDFUNC= 3
  CASE ('PERC');      IGRIDFUNC= 4
  CASE ('BIVAR');     IGRIDFUNC= 5
  CASE ('SKRIGING');  IGRIDFUNC= 6
  CASE ('OKRIGING');  IGRIDFUNC=-6
  CASE ('VARIOGRAM'); IGRIDFUNC= 7
  CASE ('PCG')    ;   IGRIDFUNC= 8
 END SELECT
 
 IF(IGRIDFUNC.NE.7)THEN
  IF(.NOT.UTL_READINITFILE('IDFFILE',LINE,IU,0))RETURN
  READ(LINE,*) IDFFILE; WRITE(*,'(A)') 'IDFFILE='//TRIM(IDFFILE)  !## points from idf files
  IF(IN_TYPE.EQ.3)THEN 
   !## neccessary to read in cell-size
   IF(XMIN.NE.XMAX)THEN
    IF(.NOT.UTL_READINITFILE('CS',LINE,IU,0))RETURN
    READ(LINE,*) CS; WRITE(*,'(A,F10.2)') 'CS=',CS
   ENDIF
  ELSE
   IF(.NOT.UTL_READINITFILE('CS',LINE,IU,0))RETURN
   READ(LINE,*) CS; WRITE(*,'(A,F10.2)') 'CS=',CS
  ENDIF
 ENDIF
 
 IF(IN_TYPE.EQ.3.AND.IGRIDFUNC.LT.5)STOP 'IDFFILE_IN in combination with GRIDFUNC=MIN,MAX,MEAN or PERC not sustained'
 
 SELECT CASE (IGRIDFUNC)
  CASE (0)
   WRITE(*,'(A)') 'ERROR, enter GRIDFUNC=MIN,MAX,MEAN,PERC,BIVAR,PCG,SKRIGING,OKRIGING,VARIOGRAM'; RETURN
  CASE (4)
   IF(.NOT.UTL_READINITFILE('PERCENTILE',LINE,IU,0))RETURN
   READ(LINE,*) PERCENTILE; WRITE(*,'(A,F10.2)') 'PERCENTILE=',PERCENTILE
  CASE (-6,6)
   IF(.NOT.UTL_READINITFILE('KTYPE',LINE,IU,0))RETURN
   READ(LINE,*) KTYPE; WRITE(*,'(A,I10)') 'KTYPE=',KTYPE


   IF(UTL_READINITFILE('COINCIDENT',LINE,IU,1))THEN  
    READ(LINE,*) COINCIDENTDIST; WRITE(*,*) 'COINCIDENT=',COINCIDENTDIST
    COINCIDENT=1
   ENDIF
   
   IF(.NOT.UTL_READINITFILE('SILL',LINE,IU,0))RETURN
   READ(LINE,*) SILL; WRITE(*,*) 'SILL=',SILL
   IF(.NOT.UTL_READINITFILE('NUGGET',LINE,IU,0))RETURN
   READ(LINE,*) NUGGET; WRITE(*,*) 'NUGGET=',NUGGET
   IF(NUGGET.LT.0.0D0)THEN
    WRITE(*,'(/A/)') 'It is not allowed to have a NUGGET value of less than zero'; STOP
   ENDIF
   PNTSEARCH=0; IF(UTL_READINITFILE('PNTSEARCH',LINE,IU,1))READ(LINE,*) PNTSEARCH
   WRITE(*,'(A,I10)') 'PNTSEARCH=',PNTSEARCH
   MAXPNT=0
   IF(PNTSEARCH.EQ.1)THEN
    IF(UTL_READINITFILE('MAXPNT',LINE,IU,1))READ(LINE,*) MAXPNT
    WRITE(*,'(A,I10)') 'MAXPNT=',MAXPNT
    IQUADRANT=0; IF(UTL_READINITFILE('IQUADRANT',LINE,IU,1))READ(LINE,*) IQUADRANT
    WRITE(*,'(A,I10)') 'IQUADRANT=',IQUADRANT
    IF(IQUADRANT.EQ.0)THEN
     IF(UTL_READINITFILE('ZONE_IDF',LINE,IU,1))READ(LINE,'(A)') ZONE_IDF%FNAME
     IF(TRIM(ZONE_IDF%FNAME).NE.'')WRITE(*,'(A)') 'ZONE_IDF='//TRIM(ZONE_IDF%FNAME)
     DO I=1,3
      IF(UTL_READINITFILE('ELLIPS_ANGLE'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,'(A)') ELLIPS_IDF(I,1)%FNAME
      IF(TRIM(ELLIPS_IDF(I,1)%FNAME).NE.'')WRITE(*,'(A)') 'ELLIPS_ANGLE'//TRIM(ITOS(I))//'='//TRIM(ELLIPS_IDF(I,1)%FNAME)
      IF(UTL_READINITFILE('ELLIPS_RANGE'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,'(A)') ELLIPS_IDF(I,2)%FNAME
      IF(TRIM(ELLIPS_IDF(I,2)%FNAME).NE.'')WRITE(*,'(A)') 'ELLIPS_RANGE'//TRIM(ITOS(I))//'='//TRIM(ELLIPS_IDF(I,2)%FNAME)
     ENDDO
    ENDIF
   ENDIF
   !## used to reset maxpnt each cycle if needed
   MAXPOINT=MAXPNT
   
   !## no usage of ellipses, so specify range
   IF(TRIM(ELLIPS_IDF(1,1)%FNAME).EQ.'')THEN
    IF(.NOT.UTL_READPOINTER_REAL(IU,I,XYZRANGE,'RANGE',0))RETURN !,EXCLVALUE=0.0D0))RETURN
    DO I=1,SIZE(XYZRANGE)
     IF(XYZRANGE(I).LT.0.0D0)THEN
      LINE='RANGE('//TRIM(ITOS(I))//')='//TRIM(RTOS(XYZRANGE(I),'F',3))
      WRITE(*,'(A)') TRIM(LINE)//' which is not allowed'
     ELSEIF(XYZRANGE(I).EQ.0.0D0)THEN
      LINE='RANGE('//TRIM(ITOS(I))//')='//TRIM(RTOS(XYZRANGE(I),'F',3))
      WRITE(*,'(A)') TRIM(LINE)//' yield automatic determination of range'
     ENDIF
    ENDDO
   ELSE
    ALLOCATE(XYZRANGE(1)); XYZRANGE=0.0D0
   ENDIF
   
   IF(.NOT.UTL_READINITFILE('STDEVIDF',LINE,IU,0))RETURN
   READ(LINE,*) STDEVIDF; WRITE(*,'(A)') 'STDEVIDF='//TRIM(STDEVIDF)
   
  CASE (7)
   IF(.NOT.UTL_READINITFILE('LAGINTERVAL',LINE,IU,0))RETURN
   READ(LINE,*) LAGINTERVAL; WRITE(*,*) 'LAGINTERVAL=',LAGINTERVAL
   IF(.NOT.UTL_READINITFILE('LAGDISTANCE',LINE,IU,0))RETURN
   READ(LINE,*) LAGDISTANCE; WRITE(*,*) 'LAGDISTANCE=',LAGDISTANCE
  CASE (8)
   MXITER2=50 !## inner (linear system)
   HCLOSE=0.01D0 
   RCLOSE=10000.0D0
   IF(UTL_READINITFILE('NINNER',LINE,IU,1))READ(LINE,*) MXITER2
   IF(UTL_READINITFILE('HCLOSE',LINE,IU,1))READ(LINE,*) HCLOSE
   IF(UTL_READINITFILE('RCLOSE',LINE,IU,1))READ(LINE,*) RCLOSE
   WRITE(*,*) 'NINNER=',MXITER2
   WRITE(*,*) 'HCLOSE=',HCLOSE
   WRITE(*,*) 'RCLOSE=',RCLOSE
 END SELECT
 
 IF(UTL_READINITFILE('NBLNFILE',LINE,IU,1))THEN
  READ(LINE,*) NBLNFILE; WRITE(*,'(A)') 'NBLNFILE='//TRIM(ITOS(NBLNFILE))
  ALLOCATE(BLNFILE(NBLNFILE),FCTBLNFILE(NBLNFILE)); FCTBLNFILE=0.0
  DO I=1,NBLNFILE
   IF(.NOT.UTL_READINITFILE('BLNFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) BLNFILE(I); WRITE(*,'(A)') 'BLNFILE'//TRIM(ITOS(I))//'='//TRIM(BLNFILE(I))
   IF(UTL_READINITFILE('FCTBLNFILE'//TRIM(ITOS(I)),LINE,IU,1))THEN
    READ(LINE,*) FCTBLNFILE(I); WRITE(*,'(A)') 'FCTBLNFILE'//TRIM(ITOS(I))//'='//TRIM(RTOS(FCTBLNFILE(I),'G',5))
   ENDIF
  ENDDO
  IF(UTL_READINITFILE('IBLNTYPE',LINE,IU,1))READ(LINE,*) IBLNTYPE
  WRITE(*,'(A)') 'IBLNTYPE='//TRIM(ITOS(IBLNTYPE))
 ENDIF
 
 DDATE=0
 FNAMEVAL=IDFFILE(:INDEX(IDFFILE,'.',.TRUE.)-1)
 SNAME=STDEVIDF(:INDEX(STDEVIDF,'.',.TRUE.)-1)

 IF(ASSF_COLUMN.EQ.0)THEN
  SDATE=1; EDATE=1; DDATE=1
 ELSE
  IF(ASSF_IDEPTH.EQ.0)THEN
   SDATE=ASSF_STARTDATE
   EDATE=ASSF_ENDDATE
   IF(ASSF_DDATE.EQ.0)THEN
    !## duration is equal to difference start- and enddate
    IF(ASSF_CDDATE.EQ.'')DDATE=(EDATE-SDATE)+1 
   ELSE
    DDATE=ASSF_DDATE
   ENDIF
  ENDIF
 ENDIF

 IF(N.EQ.0)THEN

  Z1=ASSF_TOP
  Z2=ASSF_BOT

  IF(ASSF_INDICATOR.GE.0)THEN

   DO I=1,ASSF_NTHRESHOLD

    IF(ASSF_INDICATOR.GT.0)THEN
     WRITE(*,'(/1X,A/)') 'Busy with indicator: '//TRIM(ASSF_THRESHOLD(ASSF_INDICATOR))
    ENDIF

    ASSF_TOP=Z1; IINT_IDF=0

    IF(ASSF_IDEPTH.EQ.3.OR.ASSF_IDEPTH.EQ.4)THEN
     IF(NLAYVAL.LT.0)IINT_IDF=ABS(NLAYVAL)-1
    ENDIF
   
    IF(ASSF_IDEPTH.EQ.0)IDATE=SDATE; ID=0
    DO   
     ID=ID+1
     IF(ASSF_IDEPTH.EQ.0)THEN
      CALL IMODBATCH_XYZTOIDF_GETDDATE(IDATE,DDATE,ASSF_CDDATE)
      ASSF_STARTDATE= IDATE
      ASSF_ENDDATE  = MIN(IDATE+DDATE,EDATE)
     ELSEIF(ASSF_IDEPTH.EQ.1)THEN
      IF(ID.LE.SIZE(DZVAL))THEN
       ASSF_DZ=DZVAL(ID)
      ELSE
       ASSF_DZ=DZVAL(SIZE(DZVAL))
      ENDIF
      ASSF_BOT=MAX(Z2,ASSF_TOP-ASSF_DZ)
     ELSE !IF(ASSF_IDEPTH.EQ.2)THEN
      IINT_IDF=IINT_IDF+1
     ENDIF
     
     !## kriging
     IF(ABS(IGRIDFUNC).EQ.6)THEN
      IF(ID.LE.SIZE(XYZRANGE))THEN
       RANGE=XYZRANGE(ID)
      ELSE
       RANGE=XYZRANGE(SIZE(XYZRANGE))
      ENDIF
     ENDIF
          
     !## startdate
     IF(ASSF_COLUMN.NE.0)THEN
      SELECT CASE (ASSF_IDEPTH)
       CASE (0)
        IDFFILE =TRIM(FNAMEVAL)//'_'//TRIM(ITOS(UTL_JDATETOIDATE(IDATE)))//'.IDF'
        STDEVIDF=TRIM(SNAME)//'_'//TRIM(ITOS(UTL_JDATETOIDATE(IDATE)))//'.IDF'
       CASE (1)
        IF(ASSF_INDICATOR.GT.0)THEN
         IDFFILE =TRIM(FNAMEVAL)//'_'//TRIM(ASSF_THRESHOLD(I))//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'.IDF'
         STDEVIDF=TRIM(SNAME)//'_'//TRIM(ASSF_THRESHOLD(I))//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'.IDF'
        ELSE
         IDFFILE =TRIM(FNAMEVAL)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'.IDF'
         STDEVIDF=TRIM(SNAME)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'.IDF'
        ENDIF
       CASE (2)
        IF(ASSF_INDICATOR.GT.0)THEN
         IDFFILE =TRIM(FNAMEVAL)//'_'//TRIM(ASSF_THRESHOLD(I))//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
         STDEVIDF=TRIM(SNAME)//'_'//TRIM(ASSF_THRESHOLD(I))//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
        ELSE
         IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
         STDEVIDF=TRIM(SNAME)//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
        ENDIF
       CASE (3)
        IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
        STDEVIDF=TRIM(SNAME)//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
       CASE (4)
        IDFFILE =TRIM(FNAMEVAL)//'_THK'//TRIM(ITOS(IINT_IDF))//'.IDF'
        STDEVIDF=TRIM(SNAME)//'_THK'//TRIM(ITOS(IINT_IDF))//'.IDF'
      END SELECT
     ENDIF
     
     !## reset max.point per cycle
     MAXPNT=MAXPOINT
     IF(.NOT.ASC2IDF_INT_MAIN(1,1,XMIN,YMIN,XMAX,YMAX,IN_TYPE))THEN; ENDIF

     SELECT CASE (ASSF_IDEPTH)
      CASE (0)
       IDATE=IDATE+DDATE
       IF(IDATE.GT.EDATE)EXIT
      CASE (1)
       IF(ASSF_BOT.LE.Z2)EXIT
       ASSF_TOP=ASSF_TOP-ASSF_DZ
      CASE (2)
       IF(IINT_IDF.EQ.NLAYVAL-1)EXIT
      CASE (3,4)
       IF(IINT_IDF.EQ.ABS(NLAYVAL))EXIT
     END SELECT
    ENDDO

    ASSF_INDICATOR=ASSF_INDICATOR+1

   ENDDO
  
  ENDIF
  
  !## get final voxel-images
  IF(ABS(ASSF_INDICATOR).GT.0.AND.ASSF_NTHRESHOLD.GT.1)THEN
   
   ALLOCATE(VOXEL(ASSF_NTHRESHOLD+4)) 

   ASSF_TOP=Z1; ID=0; IINT_IDF=0
   DO
    
    ID=ID+1
    IF(ASSF_IDEPTH.EQ.1)THEN
     IF(ID.LE.SIZE(DZVAL))THEN
      ASSF_DZ=DZVAL(ID)
     ELSE
      ASSF_DZ=DZVAL(SIZE(DZVAL))
     ENDIF
     ASSF_BOT=MAX(Z2,ASSF_TOP-ASSF_DZ)
     WRITE(*,'(/1X,A/)') 'Busy with voxel layer: '//TRIM(RTOS(ASSF_TOP,'F',2))//'_'//TRIM(RTOS(ASSF_BOT,'F',2))
    ELSEIF(ASSF_IDEPTH.EQ.2)THEN
     IINT_IDF=IINT_IDF+1
     WRITE(*,'(/1X,A/)') 'Busy with interface: '//TRIM(ITOS(IINT_IDF))
    ENDIF

    DO I=1,ASSF_NTHRESHOLD
     IF(ASSF_IDEPTH.EQ.1)THEN
      IDFFILE =TRIM(FNAMEVAL)//'_'//TRIM(ASSF_THRESHOLD(I))//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'.IDF'
     ELSEIF(ASSF_IDEPTH.EQ.2)THEN
      IDFFILE =TRIM(FNAMEVAL)//'_'//TRIM(ASSF_THRESHOLD(I))//'_INT'//TRIM(ITOS(IINT_IDF))//'.IDF'
     ENDIF
     IF(.NOT.IDFREAD(VOXEL(I),IDFFILE,1,0))STOP
    ENDDO

    CALL IDFCOPY(VOXEL(1),VOXEL(ASSF_NTHRESHOLD+1))
    CALL IDFCOPY(VOXEL(1),VOXEL(ASSF_NTHRESHOLD+2))
    CALL IDFCOPY(VOXEL(1),VOXEL(ASSF_NTHRESHOLD+3))
    CALL IDFCOPY(VOXEL(1),VOXEL(ASSF_NTHRESHOLD+4))

    !## fill in final voxel - take majority value per voxel
    DO IROW=1,VOXEL(ASSF_NTHRESHOLD+1)%NROW; DO ICOL=1,VOXEL(ASSF_NTHRESHOLD+1)%NCOL

     !## main lithology
     VOXEL(ASSF_NTHRESHOLD+1)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+1)%NODATA
     !## permeability
     VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)=0.0D0
     !## vertical anisotropy
     VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)=0.0D0
     !## fraction
     VOXEL(ASSF_NTHRESHOLD+4)%X(ICOL,IROW)=0.0D0

     !## normalize fraction to be 1.0D0
     MF=0.0D0
     DO I=1,ASSF_NTHRESHOLD
      IF(VOXEL(I)%X(ICOL,IROW).NE.VOXEL(I)%NODATA)THEN
       !## total fraction
       MF=MF+VOXEL(I)%X(ICOL,IROW)
       VOXEL(ASSF_NTHRESHOLD+4)%X(ICOL,IROW)=MF
      ENDIF
     ENDDO
     IF(MF.NE.0.0D0)MF=1.0D0/MF
     DO I=1,ASSF_NTHRESHOLD
      IF(VOXEL(I)%X(ICOL,IROW).NE.VOXEL(I)%NODATA)THEN
       VOXEL(I)%X(ICOL,IROW)=VOXEL(I)%X(ICOL,IROW)*MF
      ENDIF
     ENDDO     

     MF=0.0D0; JF=0
     DO I=1,ASSF_NTHRESHOLD
      IF(VOXEL(I)%X(ICOL,IROW).NE.VOXEL(I)%NODATA)THEN
       IF(VOXEL(I)%X(ICOL,IROW).GT.MF)THEN
        MF=VOXEL(I)%X(ICOL,IROW); JF=I
       ENDIF
       IF(KSUM.EQ.1)THEN
        !## horizontal permeability
        KHVAL= VOXEL(I)%X(ICOL,IROW)*ASSF_KH_THRESHOLD(I)
        VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)+KHVAL
        !## vertical resistance per meter
        VCVAL=VOXEL(I)%X(ICOL,IROW)/ASSF_KV_THRESHOLD(I)
        VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)+VCVAL
       ENDIF
      ENDIF
     ENDDO
     IF(JF.GT.0)THEN
      VOXEL(ASSF_NTHRESHOLD+1)%X(ICOL,IROW)=JF
      IF(KSUM.EQ.0)THEN
       VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)=ASSF_KH_THRESHOLD(JF)
       VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)=ASSF_KV_THRESHOLD(JF)
      ENDIF
      !## vertical anisotropy
      VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)/VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)
     ELSE
      VOXEL(ASSF_NTHRESHOLD+2)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+2)%NODATA
      VOXEL(ASSF_NTHRESHOLD+3)%X(ICOL,IROW)=VOXEL(ASSF_NTHRESHOLD+3)%NODATA
     ENDIF
    ENDDO; ENDDO

    IF(ASSF_IDEPTH.EQ.1)THEN
     DO I=1,4; VOXEL(ASSF_NTHRESHOLD+I)%ITB=INT(1,1); VOXEL(ASSF_NTHRESHOLD+I)%TOP=ASSF_TOP; VOXEL(ASSF_NTHRESHOLD+I)%BOT=ASSF_BOT; ENDDO
    ELSEIF(ASSF_IDEPTH.EQ.2)THEN
     DO I=1,4; VOXEL(ASSF_NTHRESHOLD+I)%ITB=INT(0,1); VOXEL(ASSF_NTHRESHOLD+I)%TOP=0.0D0; VOXEL(ASSF_NTHRESHOLD+I)%BOT=0.0D0; ENDDO
    ENDIF
   
    !## main lithology
    IF(ASSF_IDEPTH.EQ.1)IDFFILE =TRIM(FNAMEVAL)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'_L.IDF'
    IF(ASSF_IDEPTH.EQ.2)IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'_L.IDF'
    IF(.NOT.IDFWRITE(VOXEL(ASSF_NTHRESHOLD+1),IDFFILE,1))STOP
    
    !## permeability
    IF(ASSF_IDEPTH.EQ.1)IDFFILE =TRIM(FNAMEVAL)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'_K.IDF'
    IF(ASSF_IDEPTH.EQ.2)IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'_K.IDF'
    IF(.NOT.IDFWRITE(VOXEL(ASSF_NTHRESHOLD+2),IDFFILE,1))STOP

    !## vertical anisotropy
    IF(ASSF_IDEPTH.EQ.1)IDFFILE =TRIM(FNAMEVAL)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'_A.IDF'
    IF(ASSF_IDEPTH.EQ.2)IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'_A.IDF'
    IF(.NOT.IDFWRITE(VOXEL(ASSF_NTHRESHOLD+3),IDFFILE,1))STOP

    !## sum of fractions
    IF(ASSF_IDEPTH.EQ.1)IDFFILE =TRIM(FNAMEVAL)//'_T'//TRIM(RTOS(ASSF_TOP,'F',2))//'_F.IDF'
    IF(ASSF_IDEPTH.EQ.2)IDFFILE =TRIM(FNAMEVAL)//'_INT'//TRIM(ITOS(IINT_IDF))//'_F.IDF'
    IF(.NOT.IDFWRITE(VOXEL(ASSF_NTHRESHOLD+4),IDFFILE,1))STOP

    IF(ASSF_IDEPTH.EQ.1)THEN
     IF(ASSF_BOT.LE.Z2)EXIT
     ASSF_TOP=ASSF_TOP-ASSF_DZ
    ELSEIF(ASSF_IDEPTH.EQ.2)THEN
     IF(IINT_IDF.EQ.NLAYVAL-1)EXIT
    ENDIF
     
   ENDDO
   CALL IDFDEALLOCATE(VOXEL,SIZE(VOXEL)); DEALLOCATE(VOXEL)
     
  ENDIF
  
 ELSE

  IDATE=SDATE
  DO 
  
   ASSF_STARTDATE= IDATE
   ASSF_ENDDATE  = MIN(IDATE+DDATE,EDATE)

   DO I=1,N
    WRITE(*,'(A)') 'Busy with '//TRIM(XYZFNAMES(I))
    J=INDEX(XYZFNAMES(I),'\',.TRUE.)+1; K=INDEX(XYZFNAMES(I),'.',.TRUE.)-1
    IDFFILE=TRIM(TARGETDIR)//'\'//XYZFNAMES(I)(J:K)
    IF(ASSF_COLUMN.NE.0)IDFFILE=TRIM(IDFFILE)//'_'//TRIM(ITOS(UTL_JDATETOIDATE(IDATE)))
    IDFFILE=TRIM(IDFFILE)//'.IDF'
    XYZFNAMES(I)=TRIM(ROOT)//'\'//TRIM(XYZFNAMES(I))

    EXT=XYZFNAMES(I)(INDEX(XYZFNAMES(I),'.',.TRUE.)+1:)
    SELECT CASE (UTL_CAP(EXT,'U'))
     CASE ('XYZ'); IN_TYPE=1
     CASE ('IPF'); IN_TYPE=2
     CASE ('IDF'); IN_TYPE=3
     CASE ('GEN'); IN_TYPE=4
    END SELECT
    IF(.NOT.ASC2IDF_INT_MAIN(1,I,XMIN,YMIN,XMAX,YMAX,IN_TYPE))THEN
    ENDIF
   ENDDO

   IDATE=IDATE+DDATE; IF(IDATE.GT.EDATE)EXIT

  ENDDO
 ENDIF

 IF(ASSOCIATED(DZVAL))DEALLOCATE(DZVAL)
 IF(ASSOCIATED(XYZRANGE))DEALLOCATE(XYZRANGE)
 IF(ALLOCATED(ASSF_THRESHOLD))DEALLOCATE(ASSF_THRESHOLD)
 IF(ALLOCATED(ASSF_KH_THRESHOLD))DEALLOCATE(ASSF_KH_THRESHOLD)
 IF(ALLOCATED(ASSF_KV_THRESHOLD))DEALLOCATE(ASSF_KV_THRESHOLD)
 IF(ALLOCATED(INT_IDF))THEN; CALL IDFDEALLOCATE(INT_IDF,SIZE(INT_IDF)); DEALLOCATE(INT_IDF); ENDIF

 END SUBROUTINE IMODBATCH_XYZTOIDF_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_XYZTOIDF_GETDDATE(IDATE,DDATE,ASSF_CDDATE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IDATE
 INTEGER,INTENT(INOUT) :: DDATE
 CHARACTER(LEN=1),INTENT(IN) :: ASSF_CDDATE
 INTEGER :: IY,IM,ID,DD
 
 SELECT CASE (ASSF_CDDATE)
  !## daily
  CASE ('D')
   DDATE=1
  !## weekly
  CASE ('W')
   DDATE=7
  !## monthly
  CASE ('M')
   CALL UTL_GDATE(IDATE,IY,IM,ID)
   DDATE=WDATEDAYSINMONTH(IY,IM)
  !## yearly
  CASE ('Y')
   CALL UTL_GDATE(IDATE,IY,IM,ID)
   DDATE=365; IF(WDATELEAPYEAR(IY))DDATE=DDATE+1
  !## twice a month
  CASE ('T')
   CALL UTL_GDATE(IDATE,IY,IM,ID)
   IF(ID.GE.28)THEN
    DD=WDATEDAYSINMONTH(IY,IM); DDATE=(DD-ID)+14
   ELSEIF(ID.LT.14)THEN
    DDATE=14-ID
   ELSE
    DDATE=28-ID
   ENDIF
 END SELECT
 
 END SUBROUTINE IMODBATCH_XYZTOIDF_GETDDATE

 !###======================================================================
 LOGICAL FUNCTION IMODBATCH_IPFSAMPLE_MAIN(OUTIPF,ICOLS,NLAY)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(OUT),OPTIONAL :: OUTIPF
 INTEGER,INTENT(OUT),DIMENSION(:),OPTIONAL :: ICOLS
 INTEGER,INTENT(OUT),OPTIONAL :: NLAY
 CHARACTER(LEN=256),DIMENSION(3) :: FNAME
 INTEGER :: IXCOL,IYCOL,IACOL,ILCOL,IMCOL,NFILES
 REAL(KIND=DP_KIND) :: NODATA
 
 IMODBATCH_IPFSAMPLE_MAIN=.FALSE.
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) FNAME(1); WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(FNAME(1))

 IXCOL=1; IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IXCOL
 WRITE(*,'(A,I2)') 'IXCOL=',IXCOL; IF(PRESENT(ICOLS))ICOLS(1)=IXCOL
 IYCOL=2; IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IYCOL
 WRITE(*,'(A,I2)') 'IYCOL=',IYCOL; IF(PRESENT(ICOLS))ICOLS(2)=IYCOL
 !## column for the insertion
 IACOL=0; IF(UTL_READINITFILE('IACOL',LINE,IU,1))READ(LINE,*) IACOL
 WRITE(*,'(A,I2)') 'IACOL=',IACOL; IF(PRESENT(ICOLS))ICOLS(3)=IACOL
 IF(PRESENT(ICOLS))THEN
  !## measurement column
  IMCOL=0; IF(UTL_READINITFILE('IMCOL',LINE,IU,1))READ(LINE,*) IMCOL
  WRITE(*,'(A,I2)') 'IMCOL=',IMCOL; ICOLS(4)=IMCOL
  !## layer column
  ILCOL=0; IF(UTL_READINITFILE('ILCOL',LINE,IU,1))READ(LINE,*) ILCOL
  WRITE(*,'(A,I2)') 'ILCOL=',ILCOL; ICOLS(5)=ILCOL
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) FNAME(2); WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(FNAME(2))

 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) FNAME(3); WRITE(*,'(A)') 'SOURCEDIR='//TRIM(FNAME(3))
 
 NODATA=-999.99D0
 IF(UTL_READINITFILE('NODATA',LINE,IU,1))READ(LINE,*) NODATA
 WRITE(*,'(A)') 'NODATA='//TRIM(RTOS(NODATA,'F',7))

 CALL IPFSAMPLE(FNAME(1),FNAME(2),FNAME(3),IXCOL,IYCOL,IACOL,NODATA,NFILES)
 IF(PRESENT(NLAY))NLAY=NFILES
 IF(PRESENT(OUTIPF))OUTIPF=FNAME(2)
 
 IMODBATCH_IPFSAMPLE_MAIN=.TRUE.
 
 END FUNCTION IMODBATCH_IPFSAMPLE_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IPFRESIDUAL()
 !###======================================================================
 USE MOD_TSTAT_PAR, ONLY : IPFFILE,OUTNAME,IHCOL,IMCOL,IWCOL,ILCOL,W_TYPE, &
    POINTERIDF,NZONE,IZONE,ICOLLECT,SOBSDATE,EOBSDATE
 IMPLICIT NONE
 INTEGER :: I,NIPF
 
 POINTERIDF=''
 IF(UTL_READINITFILE('POINTERIDF',LINE,IU,1))THEN
  READ(LINE,*) POINTERIDF; WRITE(*,'(A)') 'POINTERIDF='//TRIM(POINTERIDF)
  IF(.NOT.UTL_READINITFILE('NZONE',LINE,IU,0))RETURN
  READ(LINE,*) NZONE; WRITE(*,'(A,I10)') 'NZONE=',NZONE
  ALLOCATE(IZONE(NZONE))
  DO I=1,NZONE
   IF(.NOT.UTL_READINITFILE('IZONE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) IZONE(I); LINE='IZONE'//TRIM(ITOS(I))//'='//TRIM(ITOS(IZONE(I)))
   WRITE(*,'(A)') TRIM(LINE)
  ENDDO  
 ENDIF

 !## colect all txt files into a single folder and add to the ipf file
 ICOLLECT=0; IF(UTL_READINITFILE('ICOLLECT',LINE,IU,1))READ(LINE,*) ICOLLECT
 WRITE(*,'(A,I2)') 'ICOLLECT=',ICOLLECT

 !HNODATA=-999.99; IF(UTL_READINITFILE('HNODATA',LINE,IU,1))READ(LINE,*) HNODATA
 !WRITE(*,'(A,F10.3)') 'HNODATA=',HNODATA

 IF(.NOT.UTL_READINITFILE('NIPF',LINE,IU,0))RETURN
 READ(LINE,*) NIPF; WRITE(*,'(A,I10)') 'NIPF=',NIPF
 
 ALLOCATE(IPFFILE(NIPF),IHCOL(NIPF),IMCOL(NIPF),IWCOL(NIPF),ILCOL(NIPF),W_TYPE(NIPF))
 DO I=1,NIPF
  IF(.NOT.UTL_READINITFILE('IPFFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IPFFILE(I); LINE='IPFFILE'//TRIM(ITOS(I))//'='//TRIM(IPFFILE(I))
  WRITE(*,'(A)') TRIM(LINE)
  W_TYPE(I)=0
  IF(UTL_READINITFILE('W_TYPE'//TRIM(ITOS(I)),LINE,IU,1))THEN
   READ(LINE,*) W_TYPE(I)
   LINE='W_TYPE'//TRIM(ITOS(I))//'='//TRIM(ITOS(W_TYPE(I))); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  IWCOL(I)=3
  IF(W_TYPE(I).NE.0)THEN
   IF(UTL_READINITFILE('IWCOL'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) IWCOL(I)
   LINE='IWCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(IWCOL(I))); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  IHCOL(I)=3 
  IF(UTL_READINITFILE('IHCOL'//TRIM(ITOS(I)),LINE,IU,1))THEN
   READ(LINE,*) IHCOL(I)
   LINE='IHCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(IHCOL(I))); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  IMCOL(I)=3 
  IF(UTL_READINITFILE('IMCOL'//TRIM(ITOS(I)),LINE,IU,1))THEN
   READ(LINE,*) IMCOL(I)
   LINE='IMCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(IMCOL(I))); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  ILCOL(I)=3 
  IF(UTL_READINITFILE('ILCOL'//TRIM(ITOS(I)),LINE,IU,1))THEN
   READ(LINE,*) ILCOL(I)
   LINE='ILCOL'//TRIM(ITOS(I))//'='//TRIM(ITOS(ILCOL(I))); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  
 ENDDO
 
 SOBSDATE=0
 IF(UTL_READINITFILE('SDATE',LINE,IU,1))THEN
  READ(LINE,*) SOBSDATE
  LINE='SDATE='//TRIM(ITOS(SOBSDATE)); WRITE(*,'(A)') TRIM(LINE)
 ENDIF
 EOBSDATE=0
 IF(UTL_READINITFILE('EDATE',LINE,IU,1))THEN
  READ(LINE,*) EOBSDATE
  LINE='EDATE='//TRIM(ITOS(EOBSDATE)); WRITE(*,'(A)') TRIM(LINE)
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('OUTNAME',LINE,IU,0))RETURN
 READ(LINE,*) OUTNAME; WRITE(*,'(A)') 'OUTNAME='//TRIM(OUTNAME)

 CALL TSTATRESIDUAL()

 END SUBROUTINE IMODBATCH_IPFRESIDUAL

 !###======================================================================
 SUBROUTINE IMODBATCH_ISGGRID()
 !###======================================================================
 USE MOD_ISG_PAR
 USE MOD_PMANAGER_PAR, ONLY : PBMAN
 IMPLICIT NONE
 INTEGER :: I,NLAY,MLAY
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: TOP,BOT,KHV,BND
 TYPE(GRIDISGOBJ) :: GRIDISG
 CHARACTER(LEN=256) :: ISGFILE
 
 PBMAN%IFVDL=0
 PBMAN%DMMFILE=0
 
 GRIDISG%MINDEPTH=0.10D0   !'mindepth          : minimal waterdepth for computing conductances (m)'
 GRIDISG%WDEPTH=1.0D0      ! waterdepth        : for simgro trapezia
 GRIDISG%ICDIST=0          !'icdist            : (0) do not compute effect of weirs (1) do compute effect of weirs'
 GRIDISG%ISIMGRO=0         !'isimgro           : usage of simgro'
 !## if isimgro>0
 GRIDISG%THIESSENFNAME=''
 GRIDISG%AHNFNAME=''
 GRIDISG%SEGMENTCSVFNAME=''
 GRIDISG%SYSID=0
 
 GRIDISG%ISTEADY=1         !'iss               : (1) mean over all periods, (2) mean over given period'
 GRIDISG%IDIM=2            !'idim              : (1) give area (2) entire domain of isg (3) selected isg'
 GRIDISG%POSTFIX='' 
 GRIDISG%STIME=INT(0,8); GRIDISG%ETIME=INT(0,8); GRIDISG%DTIME=INT(0,8)
 GRIDISG%SDATE=0; GRIDISG%EDATE=0; GRIDISG%DDATE=0
 GRIDISG%ISAVE=1
 GRIDISG%MAXWIDTH=250.0D0
 GRIDISG%IAVERAGE=1 !## (1) take the mean (2) take the median value
 GRIDISG%IEXPORT=0  !## (0) idf (1) modflow river file
 NLAY=0             !## number of layer read in
 MLAY=1
 
 GRIDISG%IDIM=2; GRIDISG%XMIN=0.0D0; GRIDISG%YMIN=0.0D0; GRIDISG%XMAX=0.0D0; GRIDISG%YMAX=0.0D0
! REQUIRED KEYWORDS
 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)
 IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
 READ(LINE,*) GRIDISG%CS; WRITE(*,'(A,F15.3)') 'CELL_SIZE=',GRIDISG%CS
 IF(.NOT.UTL_READINITFILE('NODATA',LINE,IU,0))RETURN
 READ(LINE,*) GRIDISG%NODATA; WRITE(*,'(A,G15.7)') 'NODATA=',GRIDISG%NODATA
 IF(.NOT.UTL_READINITFILE('ISAVE',LINE,IU,0))RETURN
 READ(LINE,*) GRIDISG%ISAVE; WRITE(*,'(A,99I1)') 'ISAVE=',GRIDISG%ISAVE
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) GRIDISG%ROOT; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(GRIDISG%ROOT)
 CALL UTL_CREATEDIR(GRIDISG%ROOT)
 
! OPTIONAL KEYWORDS
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) GRIDISG%XMIN,GRIDISG%YMIN,GRIDISG%XMAX,GRIDISG%YMAX
  WRITE(*,'(A,4F15.3)') 'WINDOW=',GRIDISG%XMIN,GRIDISG%YMIN,GRIDISG%XMAX,GRIDISG%YMAX
  MPW%XMIN=GRIDISG%XMIN; MPW%YMIN=GRIDISG%YMIN; MPW%XMAX=GRIDISG%XMAX; MPW%YMAX=GRIDISG%YMAX
  GRIDISG%IDIM=1
 ENDIF
  
 IF(UTL_READINITFILE('ISIMGRO',LINE,IU,1))READ(LINE,*) GRIDISG%ISIMGRO
 WRITE(*,'(A,I1)') 'ISIMGRO=',GRIDISG%ISIMGRO
 IF(GRIDISG%ISIMGRO.EQ.1)THEN
  IF(.NOT.UTL_READINITFILE('SVAT2SWNR_DRNG',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%SVAT2SWNR_DRNG; WRITE(*,'(A)') 'SVAT2SWNR_DRNG='//TRIM(GRIDISG%SVAT2SWNR_DRNG)
  IF(.NOT.UTL_READINITFILE('THIESSENFNAME',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%THIESSENFNAME; WRITE(*,'(A)') 'THIESSENFNAME='//TRIM(GRIDISG%THIESSENFNAME)
  IF(.NOT.UTL_READINITFILE('AHNFNAME',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%AHNFNAME; WRITE(*,'(A)') 'AHNFNAME='//TRIM(GRIDISG%AHNFNAME)
  IF(.NOT.UTL_READINITFILE('SEGMENTCSVFNAME',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%SEGMENTCSVFNAME; WRITE(*,'(A)') 'SEGMENTCSVFNAME='//TRIM(GRIDISG%SEGMENTCSVFNAME)
  IF(.NOT.UTL_READINITFILE('SYSID',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%SYSID; WRITE(*,'(A,I10)') 'SYSID=',GRIDISG%SYSID
  IF(UTL_READINITFILE('WDEPTH',LINE,IU,1))READ(LINE,*) GRIDISG%WDEPTH
  WRITE(*,'(A,F15.3)') 'WDEPTH=',GRIDISG%WDEPTH
  GRIDISG%MINDEPTH=GRIDISG%WDEPTH
 ELSE
  IF(UTL_READINITFILE('MINDEPTH',LINE,IU,1))READ(LINE,*) GRIDISG%MINDEPTH
  WRITE(*,'(A,F15.3)') 'MINDEPTH=',GRIDISG%MINDEPTH
 ENDIF
 
 IF(UTL_READINITFILE('MAXWIDTH',LINE,IU,1))READ(LINE,*) GRIDISG%MAXWIDTH
 WRITE(*,'(A,F15.3)') 'MAXWIDTH=',GRIDISG%MAXWIDTH
 IF(UTL_READINITFILE('POSTFIX',LINE,IU,1))READ(LINE,*) GRIDISG%POSTFIX
 WRITE(*,'(A)') 'POSTFIX='//TRIM(GRIDISG%POSTFIX)
 IF(UTL_READINITFILE('ICDIST',LINE,IU,1))READ(LINE,*) GRIDISG%ICDIST
 WRITE(*,'(A,99I1)') 'ICDIST=',GRIDISG%ICDIST

 IF(UTL_READINITFILE('IPERIOD',LINE,IU,1))READ(LINE,*) GRIDISG%ISTEADY
 WRITE(*,'(A,I1)') 'IPERIOD=',GRIDISG%ISTEADY
 IF(GRIDISG%ISTEADY.EQ.2)THEN
  IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%SDATE; WRITE(*,'(A,I8)') 'SDATE=',GRIDISG%SDATE
  IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
  READ(LINE,*) GRIDISG%EDATE; WRITE(*,'(A,I8)') 'EDATE=',GRIDISG%EDATE
  IF(UTL_READINITFILE('DDATE',LINE,IU,1))READ(LINE,*) GRIDISG%DDATE
  WRITE(*,'(A,I10)') 'DDATE=',GRIDISG%DDATE
  GRIDISG%STIME=GRIDISG%SDATE*1000000; GRIDISG%ETIME=GRIDISG%EDATE*1000000; GRIDISG%DTIME=GRIDISG%DDATE*1000000
 ENDIF

 IF(UTL_READINITFILE('IAVERAGE',LINE,IU,1))READ(LINE,*) GRIDISG%IAVERAGE
 WRITE(*,'(A,I1)') 'IAVERAGE=',GRIDISG%IAVERAGE
 IF(UTL_READINITFILE('DMMFILE',LINE,IU,1))READ(LINE,*) PBMAN%DMMFILE
 WRITE(*,'(A,I1)') 'DMMFILE=',PBMAN%DMMFILE
 IF(PBMAN%DMMFILE.EQ.0)THEN
  IF(UTL_READINITFILE('IEXPORT',LINE,IU,1))READ(LINE,*) GRIDISG%IEXPORT
  WRITE(*,'(A,I1)') 'IEXPORT=',GRIDISG%IEXPORT
  IF(GRIDISG%IEXPORT.EQ.1)THEN
   IF(UTL_READINITFILE('NLAY',LINE,IU,1))READ(LINE,*) NLAY
   WRITE(*,'(A,I8)') 'NLAY=',NLAY
   IF(NLAY.GT.0)THEN
    MLAY=0
    ALLOCATE(TOP(NLAY),BOT(NLAY),KHV(NLAY),BND(NLAY))
    DO I=1,NLAY
     CALL IDFNULLIFY(BOT(I)); CALL IDFNULLIFY(TOP(I)); CALL IDFNULLIFY(KHV(I)); CALL IDFNULLIFY(BND(I))
     IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) TOP(I)%FNAME; LINE='TOP_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(TOP(I)%FNAME)
     IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) BOT(I)%FNAME; LINE='BOT_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(BOT(I)%FNAME)
     IF(.NOT.UTL_READINITFILE('KHV_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) KHV(I)%FNAME; LINE='KHV_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(KHV(I)%FNAME)
     IF(.NOT.UTL_READINITFILE('BND_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) BND(I)%FNAME; LINE='BND_L'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(KHV(I)%FNAME)
    ENDDO
   ENDIF
  ENDIF
 ELSE
  GRIDISG%IEXPORT=-1
 ENDIF

 IF(.NOT.ALLOCATED(TOP))THEN
  NLAY=1; ALLOCATE(TOP(NLAY),BOT(NLAY),KHV(NLAY),BND(NLAY))
  DO I=1,NLAY; CALL IDFNULLIFY(BOT(I)); CALL IDFNULLIFY(TOP(I)); CALL IDFNULLIFY(KHV(I)); CALL IDFNULLIFY(BND(I)); ENDDO
 ENDIF
 
 IF(.NOT.ISG2GRIDMAIN(ISGFILE,1,NLAY,MLAY,TOP,BOT,KHV,BND,GRIDISG))THEN; WRITE(*,'(/A/)') 'Error occured in ISG Grid routine'; ENDIF
 CALL ISGDEAL(1) 
 DO I=1,NLAY
  CALL IDFDEALLOCATE(TOP,SIZE(TOP)); CALL IDFDEALLOCATE(BOT,SIZE(BOT))
  CALL IDFDEALLOCATE(KHV,SIZE(KHV)); CALL IDFDEALLOCATE(BND,SIZE(BND))
 ENDDO
 DEALLOCATE(TOP,BOT,KHV,BND)
 
 END SUBROUTINE IMODBATCH_ISGGRID

 !###======================================================================
 SUBROUTINE IMODBATCH_ISGADJUST_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: SESFILE,LOGFILE,ISGFILE
  
 IF(.NOT.UTL_READINITFILE('SESFILE',LINE,IU,0))RETURN
 READ(LINE,*) SESFILE
 WRITE(*,'(A)') 'SESFILE='//TRIM(SESFILE)
 LOGFILE='.\log_ses.txt'
 IF(UTL_READINITFILE('LOGFILE',LINE,IU,1))READ(LINE,*) LOGFILE
 WRITE(*,'(A/)') 'LOGFILE='//TRIM(LOGFILE)

 IF(ISGADJUSTAPPLY(SESFILE,LOGFILE,1))THEN
  IF(UTL_READINITFILE('OUTNAME',LINE,IU,1))READ(LINE,*) ISGFILE
  WRITE(*,'(/A)') 'OUTNAME='//TRIM(ISGFILE)
  CALL ISGSAVE(ISGFILE,2) !- saving ONLY *.ISG, *.isp, *.isd
 ENDIF
 
 END SUBROUTINE IMODBATCH_ISGADJUST_MAIN
 
 !###======================================================================
 SUBROUTINE IMODBATCH_ISGSIMPLIFY_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE
 REAL(KIND=DP_KIND) :: ZTOLERANCE,NODATA
  
 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)
 IF(.NOT.UTL_READINITFILE('ZTOLERANCE',LINE,IU,0))RETURN
 READ(LINE,*) ZTOLERANCE; WRITE(*,'(A,F10.2)') 'ZTOLERANCE=',ZTOLERANCE
 IF(.NOT.UTL_READINITFILE('NODATA',LINE,IU,0))RETURN
 READ(LINE,*) NODATA; WRITE(*,'(A,F10.2)') 'NODATA=',NODATA
 IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN

 CALL ISG_SIMPLIFYMAIN(ISGFILE,ZTOLERANCE,NODATA,1)
 
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)

 !## saving isg
 CALL ISGSAVE(ISGFILE,2)
 
 END SUBROUTINE IMODBATCH_ISGSIMPLIFY_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_SFRTOISG_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE,SFRFILE
 REAL(KIND=DP_KIND),DIMENSION(11) :: R
 INTEGER,DIMENSION(5) :: ID
 REAL(KIND=DP_KIND) :: QSTR,SHED,SDEP,SWID
 INTEGER :: JU,I,J,IREC,IPER,NPER
 
 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)

 !## read entire ISG file
 IF(ISGREAD((/ISGFILE/),1))THEN; ENDIF

 IF(.NOT.UTL_READINITFILE('SFRFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) SFRFILE; WRITE(*,'(A)') 'SFRFILE_IN='//TRIM(SFRFILE)

 JU=UTL_GETUNIT(); OPEN(JU,FILE=SFRFILE,FORM='FORMATTED',STATUS='OLD',ACTION='READ')
 NPER=ISD(1)%N

 DO IPER=1,NPER
  DO J=1,8; READ(JU,*); ENDDO
  DO I=1,NISG

   READ(JU,*) (ID(J),J=1,5),(R(J),J=1,11)
   !## average flow in stream
   QSTR=(R(1)+R(3))/2.0
   !## waterlevel
   SHED=R(7)
   !## waterdepth
   SDEP=R(8)
   !## waterwidth
   SWID=R(9)

   !## put results on each calculation point of isg
   DO J=1,ISG(I)%NCLC
    IREC=IPER+(I-1)*NPER*2+(J-1)*NPER
    DATISD(IREC)%WLVL =SHED
    DATISD(IREC)%BTML =SDEP
    DATISD(IREC)%RESIS=SWID
    DATISD(IREC)%INFF =QSTR/86400.0D0 !## m3/day -> m3/sec
   ENDDO
  ENDDO
 ENDDO
 CLOSE(JU)
 
 IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)

 !## saving isg
 CALL ISGSAVE(ISGFILE,2) 
 
 END SUBROUTINE IMODBATCH_SFRTOISG_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_ISGTOSFR_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: ISGFILE
 REAL(KIND=DP_KIND) :: WL,BL,F,C
 INTEGER :: I,ID
 
 IF(.NOT.UTL_READINITFILE('ISGFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_IN='//TRIM(ISGFILE)

 !## read entire ISG file
 IF(ISGREAD((/ISGFILE/),1))THEN; ENDIF

 !## turn to sfr mode
 ISFR=1

 !## fill in the appropriate data
 DO I=1,SIZE(DATISD)

  ID=DATISD(I)%IDATE
  WL=DATISD(I)%WLVL
  BL=DATISD(I)%BTML
  C =DATISD(I)%RESIS
  F =DATISD(I)%INFF

  DATISD(I)%IDATE=ID
  DATISD(I)%CTIME='00:00:00'
  DATISD(I)%WLVL =WL
  DATISD(I)%BTML =BL
  DATISD(I)%WIDTH=1.0D0
  DATISD(I)%THCK =1.0D0
  DATISD(I)%HCND =1.0D0
  DATISD(I)%QFLW =0.0D0
  DATISD(I)%QROF =0.0D0
  DATISD(I)%PPTSW =0.0D0
  DATISD(I)%ETSW   =0.0D0
  DATISD(I)%UPSG =0
  DATISD(I)%DWNS =0
  DATISD(I)%ICLC =1
  DATISD(I)%IPRI =1

 ENDDO
 
 IF(.NOT.UTL_READINITFILE('ISGFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) ISGFILE; WRITE(*,'(A)') 'ISGFILE_OUT='//TRIM(ISGFILE)
 WRITE(*,'(/A)') 'ISGFILE_OUT='//TRIM(ISGFILE)

 !## saving isg
 CALL ISGSAVE(ISGFILE,2) 
 
 END SUBROUTINE IMODBATCH_ISGTOSFR_MAIN
 
 !###======================================================================
 SUBROUTINE IMODBATCH_IPESTTOPARAM()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: PRJFNAME,FNAME,OUTPUTFOLDER
 INTEGER :: I,J,K,N,M,NU,IROW,ICOL,IZ,IP,JZ
 REAL(KIND=DP_KIND) :: F,P
 CHARACTER(LEN=2),DIMENSION(:),ALLOCATABLE :: UP
 INTEGER,DIMENSION(:,:),ALLOCATABLE :: ILS
 INTEGER,DIMENSION(:),ALLOCATABLE :: NLS
 TYPE(IDFOBJ),DIMENSION(:,:),ALLOCATABLE :: IDF
 TYPE(IDFOBJ) :: ZIDF
 
 PRJFNAME=''; IF(.NOT.UTL_READINITFILE('PRJFNAME',LINE,IU,0))RETURN
 READ(LINE,*) PRJFNAME; WRITE(*,'(A)') 'PRJFNAME='//TRIM(PRJFNAME)
 OUTPUTFOLDER=''; IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 
 CALL PMANAGER_UTL_INIT()
 IF(.NOT.PMANAGER_LOADPRJ(PRJFNAME,1))STOP 'ERROR READING PRJFILE'

 !## find unique stuff
 N=SIZE(PEST%PARAM); ALLOCATE(UP(N)); DO I=1,SIZE(PEST%PARAM); UP(I)=PEST%PARAM(I)%PPARAM; ENDDO
 CALL UTL_GETUNIQUE_CHAR(UP,N,NU)
 ALLOCATE(NLS(NU))
 DO J=1,NU; NLS(J)=0; DO I=1,N; IF(UP(J).EQ.PEST%PARAM(I)%PPARAM)NLS(J)=NLS(J)+1; ENDDO; ENDDO
 ALLOCATE(ILS(NU,MAXVAL(NLS)))
 DO J=1,NU; NLS(J)=0; DO I=1,N; IF(UP(J).EQ.PEST%PARAM(I)%PPARAM)THEN; NLS(J)=NLS(J)+1; ILS(J,NLS(J))=PEST%PARAM(I)%PILS; ENDIF; ENDDO; ENDDO
 DO J=1,NU; CALL UTL_GETUNIQUE_INT(ILS(J,:),NLS(J),M); NLS(J)=M; ENDDO
 WRITE(*,'(/1X,A)') 'Unique parameters found that can be processed:'
 DO I=1,NU; WRITE(*,'(1X,99A)') UP(I),(','//TRIM(ITOS(ILS(I,J))),J=1,NLS(I)); ENDDO
 !## find unqique layers/systems per parameter
 CALL IDFNULLIFY(ZIDF); ALLOCATE(IDF(NU,MAXVAL(NLS))); DO I=1,SIZE(IDF,1); DO J=1,SIZE(IDF,2); CALL IDFNULLIFY(IDF(I,J)); ENDDO; ENDDO
 !## use first zone to dimension idf
 DO I=1,SIZE(PEST%IDFFILES); IF(INDEX(UTL_CAP(PEST%IDFFILES(I),'U'),'.IDF').GT.0)EXIT; ENDDO
 IF(I.GT.SIZE(PEST%IDFFILES))STOP 'NEED TO FIND IDFFILES IN ZONES'
 IF(.NOT.IDFREAD(ZIDF,PEST%IDFFILES(I),0))THEN; WRITE(*,'(/1X,A/)') 'CANNOT READ '//TRIM(PEST%IDFFILES(I)); STOP; ENDIF
 IF(.NOT.IDFALLOCATEX(ZIDF))STOP
 DO I=1,SIZE(IDF,1); DO J=1,NLS(I); CALL IDFCOPY(ZIDF,IDF(I,J)); ENDDO; ENDDO
 
 DO I=1,SIZE(IDF,1); DO J=1,NLS(I); IF(.NOT.IDFALLOCATEX(IDF(I,J)))STOP 'CANNOT ALLOCATE MEMORY'; IDF(I,J)%X=0.0D0; ENDDO; ENDDO
 !## process each zone
 DO I=1,SIZE(PEST%IDFFILES)
  IF(.NOT.IDFREAD(ZIDF,PEST%IDFFILES(I),1))THEN; WRITE(*,'(/1X,A/)') 'CANNOT READ '//TRIM(PEST%IDFFILES(I)); STOP; ENDIF
  JZ=0; DO IROW=1,ZIDF%NROW; DO ICOL=1,ZIDF%NCOL
   IF(ZIDF%X(ICOL,IROW).EQ.ZIDF%NODATA)CYCLE
   IZ=INT(ZIDF%X(ICOL,IROW)); F=MOD(ZIDF%X(ICOL,IROW),1.0D0); IF(F.EQ.0.0D0)F=1.0D0
   !## find new zone
   DO IP=1,SIZE(PEST%PARAM)
    IF(PEST%PARAM(IP)%PIZONE.NE.IZ)CYCLE
    !## find idf to be add values
    DO J=1,NU; IF(UP(J).EQ.PEST%PARAM(IP)%PPARAM)EXIT; ENDDO
    !## find ils
    DO K=1,NLS(J); IF(ILS(J,K).EQ.PEST%PARAM(IP)%PILS)EXIT; ENDDO
    P=F*PEST%PARAM(IP)%PINI
    IDF(J,K)%X(ICOL,IROW)=IDF(J,K)%X(ICOL,IROW)+P
   ENDDO
  ENDDO; ENDDO
  F=DBLE(I)/SIZE(PEST%IDFFILES)*100.0D0; WRITE(6,'(A,F10.2,A)') '+Progress ',F,' ...            '
 ENDDO
 DO I=1,SIZE(IDF,1); DO J=1,NLS(I)
  DO IROW=1,IDF(I,J)%NROW; DO ICOL=1,IDF(I,J)%NCOL
   IF(IDF(I,J)%X(ICOL,IROW).EQ.0.0D0)IDF(I,J)%X(ICOL,IROW)=1.0D0
  ENDDO; ENDDO
  FNAME=TRIM(OUTPUTFOLDER)//'\'//TRIM(UP(I))//'_F_LS'//TRIM(ITOS(ILS(I,J)))//'.IDF'
  IF(.NOT.IDFWRITE(IDF(I,J),FNAME,1))THEN; WRITE(*,'(/A/)') 'ERROR WRITING '//TRIM(FNAME); CYCLE; ENDIF
  WRITE(*,'(A)') 'WRITING '//TRIM(FNAME)
 ENDDO; ENDDO
 
 END SUBROUTINE IMODBATCH_IPESTTOPARAM
 
 !###======================================================================
 SUBROUTINE IMODBATCH_IFFCROSSSECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IFFNAME,GENNAME,IPFNAME
 CHARACTER(LEN=256) :: LINE 
 INTEGER :: IOS,NC,I,J,K,N,IPOL,ISEG,ISTATUS,JU,NCPOINTS
 REAL(KIND=DP_KIND) :: XINTER,YINTER,ZINTER
 
 !## read function keywords
 IF(.NOT.UTL_READINITFILE('IFFNAME',LINE,IU,0))RETURN
 READ(LINE,*) IFFNAME; WRITE(*,'(A)') 'IFFNAME='//TRIM(IFFNAME)
 IF(.NOT.UTL_READINITFILE('GENNAME',LINE,IU,0))RETURN
 READ(LINE,*) GENNAME; WRITE(*,'(A)') 'GENNAME='//TRIM(GENNAME)
 IF(.NOT.UTL_READINITFILE('IPFNAME',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFNAME='//TRIM(IPFNAME)
 
 !## allocate and open IFF
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=IFFNAME,STATUS='OLD',FORM='FORMATTED',ACTION='READ,DENYWRITE',IOSTAT=IOS)
 IF(IOS.NE.0) RETURN
 READ(IU,*) NC ; N=NC-5
 ALLOCATE(IFF(2))
 DO I=1,SIZE(IFF); NULLIFY(IFF(I)%XVAL); ALLOCATE(IFF(I)%XVAL(N)); ENDDO
 !## read IFF attributes
 DO I=1,NC; READ(IU,*); END DO

 !## allocate and open GEN
 CALL POLYGON1INIT()
 CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,GENNAME,'GEN')

 JU=UTL_GETUNIT()
 CALL OSD_OPEN(JU,FILE=IPFNAME,STATUS='UNKNOWN',FORM='FORMATTED',ACTION='WRITE',IOSTAT=IOS,IQUESTION=0)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot write file:'//CHAR(13)//TRIM(IPFNAME),'Error')
  RETURN
 ENDIF
 DO I=1,2 !## two loops: 1) get NCPOINTS and 2) write IPF
  !## read IFF header   
  REWIND(IU) ; READ(IU,*) ; DO J=1,NC; READ(IU,*); END DO

  IF(I.EQ.2)THEN   
   Write(JU,*) NCPOINTS
   Write(JU,*) "8"
   Write(JU,*) "XINTER"
   Write(JU,*) "YINTER"
   Write(JU,*) "ZINTER"
   Write(JU,*) "PARTICLE_NUMBER"
   Write(JU,*) "ILAY-FROM"
   Write(JU,*) "ILAY-TO"
   Write(JU,*) "TIME-FROM(YEARS)"
   Write(JU,*) "TIME-TO(YEARS)"
   Write(JU,*) "0 TXT"
  ENDIF

  !## loop over all IFF points/segments
  IFF(2)%IPART=0; NCPOINTS=0 ; K=0
  DO
   !## read IFF line    
   READ(IU,*,IOSTAT=IOS) IFF(1)%IPART,IFF(1)%IL,IFF(1)%X,IFF(1)%Y,IFF(1)%Z,(IFF(1)%XVAL(J),J=1,N)
   IF(IOS.NE.0)EXIT
   K=K+1
   IF(K.EQ.25)THEN
      WRITE(6,'(A,I)') '+Progress. Reading Particle Number: ',IFF(1)%IPART
      K=0
   ENDIF
   !## same particle
   IF(IFF(1)%IPART.EQ.IFF(2)%IPART)THEN
     !## loop over all GEN segments
     DO IPOL=1,SIZE(SHP%POL) 
      DO ISEG=1,SIZE(SHP%POL(IPOL)%X)-1 
       !## calculate intersection    
       CALL DBL_IGRINTERSECTLINE(SHP%POL(IPOL)%X(ISEG)  ,SHP%POL(IPOL)%Y(ISEG)  , &
                                 SHP%POL(IPOL)%X(ISEG+1),SHP%POL(IPOL)%Y(ISEG+1), &
                                 IFF(1)%X,IFF(1)%Y, &
                                 IFF(2)%X,IFF(2)%Y, &
                                 XINTER,YINTER,ISTATUS) 
       IF(ISTATUS.EQ.5)THEN
        NCPOINTS=NCPOINTS+1  
        ZINTER=IFF(1)%Z
        IF(IFF(2)%X-IFF(1)%X.GT.0) ZINTER=IFF(1)%Z+(IFF(2)%Z-IFF(1)%Z)*(XINTER-IFF(1)%X)/(IFF(2)%X-IFF(1)%X)
        !## write IPF content
      ! IF(I.EQ.2) WRITE(JU,'(3F12.2,I10,2I5,2F13.3)') XINTER,YINTER,ZINTER,IFF(1)%IPART, &
      !                                                IFF(2)%IL,IFF(1)%IL,IFF(2)%XVAL(1),IFF(1)%XVAL(1) !## TO=IFF(1), FROM=IFF(2)
        IF(I.EQ.2) WRITE(JU,'(A)') TRIM(RTOS(XINTER,'F',3))//','//TRIM(RTOS(YINTER,'F',3))//','//TRIM(RTOS(ZINTER,'F',3))//','// &
                                   TRIM(ITOS(IFF(1)%IPART))//','// & 
                                   TRIM(ITOS(IFF(2)%IL))//','//TRIM(ITOS(IFF(1)%IL))//','// &   !## TO=IFF(1), FROM=IFF(2)
                                   TRIM(RTOS(IFF(2)%XVAL(1),'F',3))//','//TRIM(RTOS(IFF(1)%XVAL(1),'F',3))
 
       ENDIF    
      ENDDO
    ENDDO
  ENDIF 
  IFF(2)%IPART=IFF(1)%IPART
  IFF(2)%IL   =IFF(1)%IL
  IFF(2)%X    =IFF(1)%X
  IFF(2)%Y    =IFF(1)%Y
  IFF(2)%Z    =IFF(1)%Z
  DO J=1,N; IFF(2)%XVAL(J)=IFF(1)%XVAL(J); ENDDO
 ENDDO !## loop over IFF
ENDDO 
WRITE(*,'(A)') 'Number of intersections found: '//TRIM(ITOS(NCPOINTS))
  
!## deallocate
DO I=1,SIZE(IFF); DEALLOCATE(IFF(I)%XVAL); ENDDO; 
DEALLOCATE(IFF)
CALL POLYGON1CLOSE()

CLOSE(IU) ; CLOSE(JU)
 
END SUBROUTINE IMODBATCH_IFFCROSSSECTION

 !###======================================================================
 SUBROUTINE IMODBATCH_IMODPATH7_MAIN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: JU,KU,NLAY,I,J,K,IOS,ILAY,ID
 CHARACTER(LEN=256) :: MF6DIR,MODPATH7,LINE
 REAL(KIND=DP_KIND) :: XLL,YLL,X1,Y1,X2,Y2,X,Y,Z,T,XD
 TYPE(IDFOBJ) :: MODELIDF
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: TOP,BOT
 
 CALL IDFNULLIFY(MODELIDF)
 
 MF6DIR=''; IF(.NOT.UTL_READINITFILE('MF6DIR',LINE,IU,0))RETURN
 READ(LINE,*) MF6DIR; WRITE(*,'(A)') 'MF6DIR='//TRIM(MF6DIR)
 MODPATH7=''; IF(.NOT.UTL_READINITFILE('MODPATH7',LINE,IU,0))RETURN
 READ(LINE,*) MODPATH7; WRITE(*,'(A)') 'MODPATH7='//TRIM(MODPATH7)
 NSPFNAME=1; ALLOCATE(SPFNAME(NSPFNAME)); SPFNAME(1)=''
 IF(.NOT.UTL_READINITFILE('ISDNAME',LINE,IU,0))RETURN
 READ(LINE,*) SPFNAME(1); WRITE(*,'(A)') 'ISDNAME='//TRIM(SPFNAME(1))
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 
 !## generate mf6 namfile
 CALL UTL_CREATEDIR(TRIM(MF6DIR)//'\MP7')
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7.MPNAM',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') 'MPBAS     '//'MP7.MPBAS'
 WRITE(JU,'(A)') 'GRBDIS    '//'..\GWF_1\MODELINPUT\MODEL_MF6.DIS6.GRB'
 WRITE(JU,'(A)') 'TDIS      '//'..\MFSIM.TDIS6'
 WRITE(JU,'(A)') 'HEAD      '//'..\GWF_1\MODELOUTPUT\HEAD\HEAD.HED'
 WRITE(JU,'(A)') 'BUDGET    '//'..\GWF_1\MODELOUTPUT\BUDGET\BUDGET.CBC'
 CLOSE(JU)
 
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7.MPSIM',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') 'MP7.MPNAM'
 WRITE(JU,'(A)') 'MP7.MPLIST'
 WRITE(JU,'(A)') '2 2 1 1 0 0' !## pathlines(2),backward(2),pass weaksinks(1),pass weaksources(1),no checks(0),no detailed info(0)
 WRITE(JU,'(A)') 'MP7.ENDPOINT7'
 WRITE(JU,'(A)') 'MP7.PATHLINE7'
! WRITE(JU,'(A)') 'MP7.TIMESERIES7'
 WRITE(JU,'(A)') '0'   !## no balance checking
 WRITE(JU,'(A)') '1'   !## reference time
 WRITE(JU,'(A)') '0.0' !## initial time
 WRITE(JU,'(A)') '2'   !## steady-state tracking simulation
 WRITE(JU,'(A)') '1'   !## no stoppping zone
 WRITE(JU,'(A)') '1'   !## no retardation
 WRITE(JU,'(A)') '1'   !## particle group count
 WRITE(JU,'(A)') 'PG1' !## particle group
 WRITE(JU,'(A)') '1'   !## single value of particle release time'
 WRITE(JU,'(A)') '0.0' !## release time'
 WRITE(JU,'(A)') 'EXTERNAL MP7.SLOC'
 CLOSE(JU)
 
 !## read the master of idf
 MODELIDF%FNAME=TRIM(MF6DIR)//'\GWF_1\MODELINPUT\DIS6\BND_L1.IDF'
 IF(.NOT.IDFREAD(MODELIDF,MODELIDF%FNAME,0))STOP

 CALL UTL_CREATEDIR(OUTDIR)
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7.MPBAS',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') '0' !## facecount
 IF(.NOT.IDFALLOCATEX(MODELIDF))STOP
 !## read and save porosity
 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('POR_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MODELIDF%FNAME; WRITE(*,'(A)') 'POR_L'//TRIM(ITOS(I))//'='//TRIM(MODELIDF%FNAME)
  READ(MODELIDF%FNAME,*,IOSTAT=IOS) X
  IF(IOS.EQ.0)THEN
   MODELIDF%X=X
  ELSE
   IF(.NOT.IDFREADSCALE(MODELIDF%FNAME,MODELIDF,2,1,0.0D0,0))RETURN !## scale mean
  ENDIF
  KU=UTL_GETUNIT(); OPEN(KU,FILE=TRIM(MF6DIR)//'\MP7\POR_L'//TRIM(ITOS(I))//'.ARR',STATUS='UNKNOWN',ACTION='WRITE')
  CALL IDFWRITEFREE(KU,MODELIDF,0,'B','*')
  CLOSE(KU)
  WRITE(JU,'(A)') 'OPEN/CLOSE POR_L'//TRIM(ITOS(I))//'.ARR 1.0D0 (FREE) -1'
 ENDDO

 CLOSE(JU)
 
 ALLOCATE(TOP(NLAY),BOT(NLAY))
 !## read all top/bot
 DO I=1,NLAY
  TOP(I)%FNAME=TRIM(MF6DIR)//'\GWF_1\MODELINPUT\DIS6\TOPM_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFREAD(TOP(I),TOP(I)%FNAME,1))STOP
  BOT(I)%FNAME=TRIM(MF6DIR)//'\GWF_1\MODELINPUT\DIS6\BOTM_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFREAD(BOT(I),BOT(I)%FNAME,1))STOP
 ENDDO
 !## copy this into the idf of trace
 CALL TRACE_BRING_IN_DATA(MODELIDF,NLAY,TOP,BOT)
 !## initialize startpoints memory
 CALL TRACE_INIT_SP(1); ISPFNAME=1
 !## read/process particles towards readable format
 IF(.NOT.TRACEPREPARESP(SP(ISPFNAME)%NPART,1,1))RETURN 
 !## read all particle in memory
 CALL TRACE_AL_SP(SP(ISPFNAME)%NPART,1) 
 !## set initial time for each particle to zero
 CALL TRACEREADSP(1,SP(ISPFNAME)%NPART)

 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7.SLOC',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') '1' !## inputstyle
 WRITE(JU,'(A)') '1' !## locationstyle
 WRITE(JU,'(A)') TRIM(ITOS((SP(1)%NPART)))//' 1' !## particlecount,particleidoption
 !## write startpoints
 DO I=1,SP(1)%NPART
  !## compute local coordinates
 CALL IDFGETEDGE(MODELIDF,SP(1)%ILC(I),SP(1)%JLC(I),X1,Y1,X2,Y2)
  XLL=((MODELIDF%XMIN+SP(1)%XLC(I))-X1)/(X2-X1)
  YLL=((MODELIDF%YMIN+SP(1)%YLC(I))-Y1)/(Y2-Y1)
  WRITE(JU,'(A)') TRIM(ITOS(I))//','// &
                  TRIM(ITOS(SP(1)%KLC(I)))//','//TRIM(ITOS(SP(1)%ILC(I)))//','//TRIM(ITOS(SP(1)%JLC(I)))       //','// &
                  TRIM(RTOS(XLL,'F',2))   //','//TRIM(RTOS(YLL,'F',2))   //','//TRIM(RTOS(SP(1)%ZLL(I),'F',2)) //','// &
                  TRIM(RTOS(0.0D0,'F',2)) //','//TRIM(ITOS(0))
 ENDDO
 CLOSE(JU)
 
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7.BAT',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') TRIM(MODPATH7)//' < MP7_ARGUMENT.TXT'
 CLOSE(JU) 
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\MP7_ARGUMENT.TXT',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') 'MP7.MPSIM'
 CLOSE(JU) 
 
 CALL IDFDEALLOCATE(TOP,SIZE(TOP)); CALL IDFDEALLOCATE(BOT,SIZE(BOT))

 CALL IOSDIRCHANGE(TRIM(MF6DIR)//'\MP7')
 CALL IOSCOMMAND(TRIM(MF6DIR)//'\MP7\MP7.BAT',IFLAGS=PROCBLOCKED)

 IU=UTL_GETUNIT(); OPEN(IU,FILE=TRIM(MF6DIR)//'\MP7\MP7.PATHLINE7',STATUS='OLD'    ,ACTION='READ' )
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(MF6DIR)//'\MP7\PATHLINE7.IFF',STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') '6'
 WRITE(JU,'(A)') 'PARTICLE_NUMBER'
 WRITE(JU,'(A)') 'ILAY'
 WRITE(JU,'(A)') 'XCRD.'
 WRITE(JU,'(A)') 'YCRD.'
 WRITE(JU,'(A)') 'ZCRD.'
 WRITE(JU,'(A)') 'TIME(YEARS)'
 DO I=1,3; READ(IU,*); ENDDO; ID=0
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  READ(LINE,*) I,J,K,N
  ID=ID+1
  DO I=1,N
   READ(IU,*) J,X,Y,Z,T,XD,XD,XD,ILAY
   X=X+TOP(1)%XMIN
   Y=Y+TOP(1)%YMIN
   WRITE(JU,'(A)') TRIM(ITOS(ID     ))//','//TRIM(ITOS(ILAY   ))//','//TRIM(RTOS(X,'F',3))//','//TRIM(RTOS(Y,'F',3))//','// &
                   TRIM(RTOS(Z,'F',3))//','//TRIM(RTOS(T,'G',7))//','//TRIM(ITOS(ILAY   ))
  ENDDO
 ENDDO
 CLOSE(IU); CLOSE(JU)
 
 END SUBROUTINE IMODBATCH_IMODPATH7_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IMODPATH_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: RUNFILE,IFFFLOW,IPFFLOW,IDFFLOW,IPFFNAME
 INTEGER :: IPOSTP,IRUN,ICONVERTGEN,IEXTRACT
 INTEGER,DIMENSION(4) :: IPFICOL
 CHARACTER(LEN=256) :: TOPFNAME,BOTFNAME
 LOGICAL :: LEX
 TYPE(IDFOBJ) :: ZOOMIDF
   
 TOPFNAME=''; BOTFNAME=''; IEXTRACT=4; IPFFNAME=''; IFFFLOW=''; IPFFLOW=''
 
 !## default irun=1
 ICONVERTGEN=0; IRUN=1; RUNFILE=''; IF(UTL_READINITFILE('IRUN',LINE,IU,1))READ(LINE,*) IRUN
 IF(IRUN.EQ.1)THEN
  WRITE(*,'(A,I10)') 'IRUN=',IRUN
  IF(.NOT.UTL_READINITFILE('RUNFILE',LINE,IU,0))RETURN
  READ(LINE,*) RUNFILE; WRITE(*,'(A)') 'RUNFILE='//TRIM(RUNFILE)

  ZOOMIDF%XMIN=0.0D0; ZOOMIDF%YMIN=0.0D0; ZOOMIDF%XMAX=0.0D0; ZOOMIDF%YMAX=0.0D0
  IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
   READ(LINE,*) ZOOMIDF%XMIN,ZOOMIDF%YMIN,ZOOMIDF%XMAX,ZOOMIDF%YMAX
   WRITE(*,'(A,4F10.2)') 'WINDOW=',ZOOMIDF%XMIN,ZOOMIDF%YMIN,ZOOMIDF%XMAX,ZOOMIDF%YMAX
  ENDIF
 ENDIF

 IF(UTL_READINITFILE('ICONVERTGEN',LINE,IU,1))READ(LINE,*) ICONVERTGEN
 WRITE(*,'(A,I10)') 'ICONVERTGEN=',ICONVERTGEN

 !## default ipostp=0
 IPOSTP=0; IF(UTL_READINITFILE('IPOSTP',LINE,IU,1))READ(LINE,*) IPOSTP
 WRITE(*,'(A,I10)') 'IPOSTP=',IPOSTP
 IF(IPOSTP.EQ.1)THEN
  IFFFLOW=''; IPFFLOW=''
  IF(UTL_READINITFILE('IFFFLOW',LINE,IU,1))THEN
   READ(LINE,*) IFFFLOW; WRITE(*,'(A)') 'IFFFLOW='//TRIM(IFFFLOW)
  ENDIF
  IF(UTL_READINITFILE('IPFFLOW',LINE,IU,1))THEN
   READ(LINE,*) IPFFLOW; WRITE(*,'(A)') 'IPFFLOW='//TRIM(IPFFLOW)
  ENDIF
  IF(TRIM(IFFFLOW).EQ.''.AND.TRIM(IPFFLOW).EQ.'')THEN
   WRITE(*,*) 'You need to specify IPFFLOW and/or IFFFLOW'; STOP
  ENDIF
  !## read ipf for postprocessing
  IF(UTL_READINITFILE('IPFFNAME',LINE,IU,1))THEN
   READ(LINE,*) IPFFNAME; WRITE(*,'(A)') 'IPFFNAME='//TRIM(IPFFNAME)

   IF(.NOT.UTL_READINITFILE('IDFFLOW',LINE,IU,0))RETURN
   READ(LINE,*) IDFFLOW; WRITE(*,'(A)') 'IDFFLOW='//TRIM(IDFFLOW)

   IF(.NOT.UTL_READINITFILE('IXCOL',LINE,IU,0))RETURN
   READ(LINE,*) IPFICOL(1); WRITE(*,'(A,I10)') 'IXCOL=',IPFICOL(1)

   IF(.NOT.UTL_READINITFILE('IYCOL',LINE,IU,0))RETURN
   READ(LINE,*) IPFICOL(2); WRITE(*,'(A,I10)') 'IYCOL=',IPFICOL(2)

   IF(.NOT.UTL_READINITFILE('ILABELCOL',LINE,IU,0))RETURN
   READ(LINE,*) IPFICOL(3); WRITE(*,'(A,I10)') 'ILABELCOL=',IPFICOL(3)

   IF(.NOT.UTL_READINITFILE('ILAYCOL',LINE,IU,0))RETURN
   READ(LINE,*) IPFICOL(4); WRITE(*,'(A,I10)') 'ILAYCOL=',IPFICOL(4)

  ELSE

   IF(UTL_READINITFILE('TOPFNAME',LINE,IU,1))THEN
    READ(LINE,*) TOPFNAME; WRITE(*,'(A)') 'TOPFNAME='//TRIM(TOPFNAME)
   ENDIF
   IF(UTL_READINITFILE('BOTFNAME',LINE,IU,1))THEN
    READ(LINE,*) BOTFNAME; WRITE(*,'(A)') 'BOTFNAME='//TRIM(BOTFNAME)
   ENDIF
   IF(UTL_READINITFILE('IEXTRACT',LINE,IU,1))READ(LINE,*) IEXTRACT
   WRITE(*,'(A,I1)') 'IEXTRACT=',IEXTRACT
   IF(IEXTRACT.LT.1.OR.IEXTRACT.GT.4)THEN
    WRITE(*,'(A)') 'IEXTRACT needs to be 1,2,3 or 4'; STOP
   ENDIF
  
  ENDIF
 ENDIF 
 
 LEX=.TRUE.; IF(IRUN.EQ.1)LEX=TRACEMAIN(RUNFILE,1,ICONVERTGEN,ZOOMIDF)
 IF(LEX.AND.IPOSTP.EQ.1)CALL TRACEPOSTPROCESSING(IFFFLOW,IPFFLOW,IDFFLOW,IPFFNAME,IPFICOL,ICONVERTGEN,TOPFNAME,BOTFNAME,IEXTRACT) 
 
 !## close all memory
 CALL TRACEDEALLOCATE(1)

 END SUBROUTINE IMODBATCH_IMODPATH_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_LAYERFROMTHICKNESS()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: THK
 TYPE(IDFOBJ) :: MOTHER,TOP,BOT,SUM
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 INTEGER :: NLAY,IOS,I,J,IROW,ICOL
 REAL(KIND=DP_KIND) :: X,MINTHICKNESS,ADDTOPLAYER
 
 !## number of layer to be corrected
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 
 !## minimal thickness
 MINTHICKNESS=0.0D0; IF(UTL_READINITFILE('MINTHICKNESS',LINE,IU,1))READ(LINE,*) MINTHICKNESS
 WRITE(*,'(A,F10.2)') 'MINTHICKNESS=',MINTHICKNESS

 ADDTOPLAYER=0.0D0; IF(UTL_READINITFILE('ADDTOPLAYER',LINE,IU,1))READ(LINE,*) ADDTOPLAYER
 WRITE(*,'(A,F10.2)') 'ADDTOPLAYER=',ADDTOPLAYER

 !## result folder
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

 CALL IDFNULLIFY(MOTHER); CALL IDFNULLIFY(SUM)
 ALLOCATE(THK(NLAY)); DO I=1,SIZE(THK); CALL IDFNULLIFY(THK(I)); ENDDO
  
 IF(.NOT.UTL_READINITFILE('TOP',LINE,IU,0))RETURN
 READ(LINE,*) TOP%FNAME; LINE='TOP='//TRIM(TOP%FNAME); WRITE(*,'(A)') TRIM(LINE)

 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('THK_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) THK(I)%FNAME
  LINE='THK_L'//TRIM(ITOS(I))//'='//TRIM(THK(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 MOTHER%XMIN=0.0D0; MOTHER%XMAX=0.0D0; MOTHER%YMIN=0.0D0; MOTHER%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MOTHER%XMIN,MOTHER%YMIN,MOTHER%XMAX,MOTHER%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MOTHER%XMIN,MOTHER%YMIN,MOTHER%XMAX,MOTHER%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MOTHER%DX; WRITE(*,'(A,4F10.2)') 'CELLSIZE=',MOTHER%DX
  CALL UTL_IDFSNAPTOGRID(MOTHER%XMIN,MOTHER%XMAX,MOTHER%YMIN,MOTHER%YMAX,MOTHER%DX,MOTHER%NCOL,MOTHER%NROW)
  MOTHER%DY=MOTHER%DX
 ELSE
  !## construct mother to be the minimal overlapping gridsize
  THK%NROW=0; THK%NCOL=0
  DO I=1,SIZE(THK)
   READ(THK(I)%FNAME,*,IOSTAT=IOS) X
   IF(IOS.NE.0)THEN; IF(.NOT.IDFREAD(THK(I),THK(I)%FNAME,0))RETURN; ENDIF
  ENDDO 
  !## get maximal extent
  IF(.NOT.IDF_EXTENT(SIZE(THK),THK,MOTHER,1))RETURN
 ENDIF 

 CALL IDFCOPY(MOTHER,TOP)
 WRITE(*,'(A)') ' Reading '//TRIM(TOP%FNAME)
 READ(TOP%FNAME,*,IOSTAT=IOS) X
 IF(IOS.EQ.0)THEN
  IF(.NOT.IDFALLOCATEX(TOP))RETURN; TOP%X=X; TOP%NODATA=X
 ELSE
  IF(.NOT.IDFREADSCALE(TOP%FNAME,TOP,2,1,0.0D0,0))RETURN
 ENDIF
 CALL IDFCOPY(TOP,BOT); CALL IDFCOPY(TOP,SUM)
 IF(ADDTOPLAYER.GT.0.0D0)BOT%X=BOT%X-ADDTOPLAYER
 
 IF(ADDTOPLAYER.GT.0.0D0)THEN
  TOP%FNAME=TRIM(OUTPUTFOLDER)//'\TOP_L1.IDF'
  IF(.NOT.IDFWRITE(TOP,TOP%FNAME,1))RETURN
  BOT%FNAME=TRIM(OUTPUTFOLDER)//'\BOT_L1.IDF'
  IF(.NOT.IDFWRITE(BOT,BOT%FNAME,1))RETURN
  TOP%X=BOT%X
 ENDIF
 
 SUM%X=0.0D0
 
 DO I=1,SIZE(THK)
  CALL IDFCOPY(MOTHER,THK(I))
  WRITE(*,'(A)') ' Reading '//TRIM(THK(I)%FNAME)
  READ(THK(I)%FNAME,*,IOSTAT=IOS) X
  IF(IOS.EQ.0)THEN
   IF(.NOT.IDFALLOCATEX(THK(I)))RETURN; THK(I)%X=X; THK(I)%NODATA=X
  ELSE
   IF(.NOT.IDFREADSCALE(THK(I)%FNAME,THK(I),2,1,0.0D0,0))RETURN
  ENDIF
 
  !## compute top and bottom
  DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
   IF(TOP%X(ICOL,IROW).NE.TOP%NODATA)THEN
    TOP%X(ICOL,IROW)=BOT%X(ICOL,IROW)
    IF(THK(I)%X(ICOL,IROW).LT.MINTHICKNESS)THK(I)%X(ICOL,IROW)=0.0D0
    
    !## added enough thickness to start filling in a layer
    IF(SUM%X(ICOL,IROW).LT.ADDTOPLAYER)THEN
     SUM%X(   ICOL,IROW)=SUM%X(   ICOL,IROW)+THK(I)%X(ICOL,IROW)
!     MAJ%X(   ICOL,IROW)=REAL(I,8)
     THK(I)%X(ICOL,IROW)=THK(I)%X(ICOL,IROW)-ADDTOPLAYER
     THK(I)%X(ICOL,IROW)=MAX(0.0D0,THK(I)%X(ICOL,IROW))
    ENDIF
    
    BOT%X(ICOL,IROW)=TOP%X(ICOL,IROW)-THK(I)%X(ICOL,IROW)
   ENDIF
  ENDDO; ENDDO
 
  J=0; IF(ADDTOPLAYER.GT.0.0D0)J=1
  TOP%FNAME=TRIM(OUTPUTFOLDER)//'\TOP_L'//TRIM(ITOS(I+J))//'.IDF'
  IF(.NOT.IDFWRITE(TOP,TOP%FNAME,1))RETURN
  BOT%FNAME=TRIM(OUTPUTFOLDER)//'\BOT_L'//TRIM(ITOS(I+J))//'.IDF'
  IF(.NOT.IDFWRITE(BOT,BOT%FNAME,1))RETURN
  
 ENDDO
 
 END SUBROUTINE IMODBATCH_LAYERFROMTHICKNESS

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFCONSISTENCY()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF
 INTEGER,ALLOCATABLE,DIMENSION(:) :: CNTL
 TYPE(IDFOBJ) :: MOTHER
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 INTEGER :: NLAY,I,J,K,ICOL,IROW,ICLEAN,IOS
 INTEGER :: IL1,IL2,IL,MINTHICK_OPT
 REAL(KIND=DP_KIND) :: X,MINTHICK,TD,CD,MT,TT1,TT2
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: THICK1,THICK2

 ICLEAN=0; MINTHICK=0.0D0; MINTHICK_OPT=0
 
 !## number of layer to be corrected
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 !## result folder
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 !## iclean is type of "cleaning"
 IF(UTL_READINITFILE('ICLEAN',LINE,IU,1))READ(LINE,*) ICLEAN
 WRITE(*,'(A,I10)') 'ICLEAN=',ICLEAN
 WRITE(*,'(1X,A)') 'Applies consistency only for active cells'
 SELECT CASE (ICLEAN)
  CASE (0)  
  CASE (1)
   WRITE(*,'(1X,A)') 'Removes all data in all files whenever at least a single nodata value is found among them.'
  CASE (2)
   WRITE(*,'(1X,A)') 'Removes all data whenever at least a nodata value is found for the first and second idf file.'
  CASE (3)
   WRITE(*,'(1X,A)') 'Fill nodata values from first active layer below inactive location.'
  CASE DEFAULT
   WRITE(*,'(A)') 'ICLEAN need to be 0-3'
 END SELECT
 
 ALLOCATE(IDF(NLAY*2)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 CALL IDFNULLIFY(MOTHER)
  
 J=0; DO I=1,NLAY
  J=J+1
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IDF(J)%FNAME
  LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(IDF(J)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  J=J+1
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IDF(J)%FNAME; LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(IDF(J)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 MOTHER%XMIN=0.0D0; MOTHER%XMAX=0.0D0; MOTHER%YMIN=0.0D0; MOTHER%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MOTHER%XMIN,MOTHER%YMIN,MOTHER%XMAX,MOTHER%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MOTHER%XMIN,MOTHER%YMIN,MOTHER%XMAX,MOTHER%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MOTHER%DX; WRITE(*,'(A,4F10.2)') 'CELLSIZE=',MOTHER%DX
  CALL UTL_IDFSNAPTOGRID(MOTHER%XMIN,MOTHER%XMAX,MOTHER%YMIN,MOTHER%YMAX,MOTHER%DX,MOTHER%NCOL,MOTHER%NROW)
  MOTHER%DY=MOTHER%DX
 ELSE
  !## construct mother to be the minimal overlapping gridsize
  IDF%NROW=0; IDF%NCOL=0
  DO I=1,SIZE(IDF)
   READ(IDF(I)%FNAME,*,IOSTAT=IOS) X
   IF(IOS.NE.0)THEN; IF(.NOT.IDFREAD(IDF(I),IDF(I)%FNAME,0))RETURN; ENDIF
  ENDDO 
  !## get maximal extent
  IF(.NOT.IDF_EXTENT(SIZE(IDF),IDF,MOTHER,1))RETURN
 ENDIF 

 !## get minimal layer thickness to be applied
 IF(UTL_READINITFILE('MINLAY_THICKNESS',LINE,IU,1))THEN 
  READ(LINE,*) MINTHICK
  IF(UTL_READINITFILE('MINLTZERO_OPT',LINE,IU,1))THEN
   READ(LINE,*) MINTHICK_OPT
  ENDIF
 ENDIF
     
 DO J=1,SIZE(IDF)
  CALL IDFCOPY(MOTHER,IDF(J))
  WRITE(*,'(A)') ' Reading '//TRIM(IDF(J)%FNAME)
  READ(IDF(J)%FNAME,*,IOSTAT=IOS) X
  IF(IOS.EQ.0)THEN
   IF(.NOT.IDFALLOCATEX(IDF(J)))RETURN; IDF(J)%X=X; IDF(J)%NODATA=X
  ELSE
   IF(.NOT.IDFREADSCALE(IDF(J)%FNAME,IDF(J),2,1,0.0D0,0))RETURN
  ENDIF
 ENDDO
 
 ALLOCATE(CNTL(SIZE(IDF)))
 !## convert top nodata whenever a single layer is nodata
 DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
  
  CNTL=0
  DO I=1,SIZE(IDF)
   IF(IDF(I)%X(ICOL,IROW).EQ.IDF(I)%NODATA)CNTL(I)=1
  ENDDO

  J=0
  IF(ICLEAN.EQ.1)THEN
   IF(SUM(CNTL).NE.0)J=1
  ELSEIF(ICLEAN.EQ.2)THEN
   IF(CNTL(1).EQ.1.OR.CNTL(SIZE(IDF)).EQ.1)J=1
  ENDIF
  
  IF(J.EQ.1)THEN
   DO I=1,SIZE(IDF); IDF(I)%X(ICOL,IROW)=IDF(I)%NODATA; ENDDO
  ENDIF

 ENDDO; ENDDO
 DEALLOCATE(CNTL)
  
 IF(ICLEAN.NE.0)THEN
  !## correct base to be at least below top elevation
  DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
   IF(IDF(1)%X(ICOL,IROW)        .EQ.IDF(1)%NODATA)CYCLE
   IF(IDF(SIZE(IDF))%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE
   IDF(SIZE(IDF))%X(ICOL,IROW)=MIN(IDF(1)%X(ICOL,IROW),IDF(SIZE(IDF))%X(ICOL,IROW))
  ENDDO; ENDDO
 ENDIF
 
 IF(ICLEAN.EQ.2)THEN
  !## correct top->bottom and apply vertical shift
  DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
   DO J=1,SIZE(IDF)
    !## value available - if not search for next one in row
    IF(IDF(J)%X(ICOL,IROW).NE.IDF(J)%NODATA)CYCLE
    DO K=J+1,SIZE(IDF)
     IF(IDF(K)%X(ICOL,IROW).NE.IDF(K)%NODATA)THEN
      IDF(J)%X(ICOL,IROW)=IDF(K)%X(ICOL,IROW); EXIT
     ENDIF
    ENDDO
   ENDDO
  ENDDO; ENDDO
 ENDIF
 
 IF(ICLEAN.EQ.3)THEN
  !## correct top->bottom and apply vertical shift
  DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
   DO I=1,SIZE(IDF)
    IF(IDF(I)%X(ICOL,IROW).NE.IDF(I)%NODATA)CYCLE
    DO J=I+1,SIZE(IDF)
     !## value available - if not search for next one in row
     IF(IDF(J)%X(ICOL,IROW).EQ.IDF(J)%NODATA)CYCLE
     IDF(I)%X(ICOL,IROW)=IDF(J)%X(ICOL,IROW); EXIT
    ENDDO
   ENDDO
  ENDDO; ENDDO
 ENDIF

 !## correct idf->top
 DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
  DO I=2,SIZE(IDF)
   !## adjust whenever it crosses higher idf-files
   IF(IDF(I)%X(ICOL,IROW).EQ.IDF(I)%NODATA)CYCLE
   DO J=I-1,1,-1
    IF(IDF(J)%X(ICOL,IROW).NE.IDF(J)%NODATA)THEN
     IDF(I)%X(ICOL,IROW)=MIN(IDF(I)%X(ICOL,IROW),IDF(J)%X(ICOL,IROW)); EXIT
    ENDIF 
   ENDDO 
  ENDDO  
 ENDDO; ENDDO
 
 !## correct, based on given minimal thickness
 ALLOCATE(THICK1(NLAY)); THICK1=0.0D0
 ALLOCATE(THICK2(NLAY-1)); THICK2=0.0D0
  
 DO IROW=1,MOTHER%NROW; DO ICOL=1,MOTHER%NCOL
  THICK1=0.0D0; THICK2=0.0D0
  !## compute thicknesses aquifers
  I=1
  DO IL=1,NLAY*2,2
   THICK1(I)=IDF(IL)%X(ICOL,IROW)-IDF(IL+1)%X(ICOL,IROW)
   I=I+1
  ENDDO

  !## compute thicknesses aquitards
  I=1
  DO IL=2,(NLAY-1)*2,2
   THICK2(I)=IDF(IL)%X(ICOL,IROW)-IDF(IL+1)%X(ICOL,IROW)
   I=I+1
  ENDDO
 
  TT1=SUM(THICK1)
  TT2=SUM(THICK2)
   
  IL1=1
  DO
   DO IL=IL1,NLAY-1
    !## found aquitard
    IF(THICK2(IL).GT.0.0D0)EXIT
   ENDDO
   IL2=IL
   TD=SUM(THICK1(IL1:IL2))
   N=((IL2-IL1)+1)
   MT=MIN(MINTHICK,TD/REAL(N))
   !## correct also layers with tickness == 0.0D0
   IF(MINTHICK_OPT.EQ.1.AND.MT.EQ.0.0D0)MT=MINTHICK
   CD=0.0D0 !## total correction term
   DO IL=IL1,IL2
    IF(THICK1(IL).LT.MT)THEN
     CD=CD+MT-THICK1(IL); THICK1(IL)=MT
    ENDIF     
   ENDDO
   !## correction needed
   IF(CD.GT.0.0D0)THEN
    N=0
    DO IL=IL1,IL2
     IF(THICK1(IL).GT.MT)N=N+1
    ENDDO
    IF(N.GT.0)CD=CD/REAL(N)
    DO IL=IL1,IL2
     IF(THICK1(IL).GT.MT)THEN
      THICK1(IL)=THICK1(IL)-CD
     ENDIF
    ENDDO
   ENDIF
    IL1=IL2+1
    IF(IL1.GE.NLAY)EXIT
  ENDDO

  !## adjust all top/bottom according to thick
  I=1; J=1
  DO IL=1,NLAY*2
   IF(MOD(IL,2))THEN
    IDF(IL+1)%X(ICOL,IROW)=IDF(IL)%X(ICOL,IROW)-THICK1(I)
    I=I+1
   ELSE
    IF(J.LE.NLAY-1)THEN
     IDF(IL+1)%X(ICOL,IROW)=IDF(IL)%X(ICOL,IROW)-THICK2(J)
     J=J+1
    ENDIF 
   ENDIF 
  ENDDO
  
 ENDDO; ENDDO
  
 I=1; DO J=1,SIZE(IDF)
  READ(IDF(J)%FNAME,*,IOSTAT=IOS) X
  IF(IOS.EQ.0)THEN 
   IF(MOD(J,2).EQ.0)THEN
    IDF(J)%FNAME=TRIM(OUTPUTFOLDER)//'\BOT_L'//TRIM(ITOS(I))//'.IDF'
   ELSE
    IDF(J)%FNAME=TRIM(OUTPUTFOLDER)//'\TOP_L'//TRIM(ITOS(I))//'.IDF'
   ENDIF
  ELSE
   IDF(J)%FNAME=TRIM(OUTPUTFOLDER)//'\'//TRIM(IDF(J)%FNAME(INDEX(IDF(J)%FNAME,'\',.TRUE.)+1:))
  ENDIF
  IF(.NOT.IDFWRITE(IDF(J),IDF(J)%FNAME,1))RETURN
  IF(MOD(J,2).EQ.0)I=I+1
 ENDDO
 
 END SUBROUTINE IMODBATCH_IDFCONSISTENCY
 
  !###======================================================================
 SUBROUTINE IMODBATCH_RESAMPLELAYERS()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:,:) :: MDL1,MDL2
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 INTEGER :: NLY1,NLY2,I,J,NROW,NCOL,IROW,ICOL,IWINDOW
 REAL(KIND=DP_KIND) :: TOP1,TOP2,BOT1,BOT2,T,B
  
 IWINDOW=0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IWINDOW=1
  READ(LINE,*) IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) IDF%DX; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',IDF%DX
  IDF%DY=IDF%DX
  CALL UTL_IDFSNAPTOGRID(IDF%XMIN,IDF%XMAX,IDF%YMIN,IDF%YMAX,IDF%DX,IDF%NCOL,IDF%NROW)
  IF(.NOT.IDFALLOCATEX(IDF))RETURN
  IDF%ITYPE=4
 ENDIF

 !## number of layer to be corrected
 IF(.NOT.UTL_READINITFILE('NLAY1',LINE,IU,0))RETURN; READ(LINE,*) NLY1; WRITE(*,'(A,I10)') 'NLAY1=',NLY1
 IF(.NOT.UTL_READINITFILE('NLAY2',LINE,IU,0))RETURN; READ(LINE,*) NLY2; WRITE(*,'(A,I10)') 'NLAY2=',NLY2
 
 !## top,bot,khv,kva,kvv
 ALLOCATE(MDL1(1,6),MDL2(NLY2,5))
 
 DO I=1,SIZE(MDL1,1); DO J=1,SIZE(MDL1,2); CALL IDFNULLIFY(MDL1(I,J)); ENDDO; ENDDO
 DO I=1,SIZE(MDL2,1); DO J=1,SIZE(MDL2,2); CALL IDFNULLIFY(MDL2(I,J)); ENDDO; ENDDO

 !## result folder
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

 DO I=1,NLY2

  IF(.NOT.UTL_READINITFILE('TOP2_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL2(I,1)%FNAME; LINE='TOP2_L'//TRIM(ITOS(I))//'='//TRIM(MDL2(I,1)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(IWINDOW.EQ.0)THEN
   IF(.NOT.IDFREAD(MDL2(I,1),MDL2(I,1)%FNAME,1))RETURN
   CALL IDFCOPY(MDL2(I,1),IDF)
  ELSE
   CALL IDFCOPY(IDF,MDL2(I,1)); IF(.NOT.IDFREADSCALE(MDL2(I,1)%FNAME,MDL2(I,1),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'
  ENDIF

  IF(.NOT.UTL_READINITFILE('BOT2_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL2(I,2)%FNAME; LINE='BOT2_L'//TRIM(ITOS(I))//'='//TRIM(MDL2(I,2)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL2(I,2)); IF(.NOT.IDFREADSCALE(MDL2(I,2)%FNAME,MDL2(I,2),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  CALL IDFCOPY(IDF,MDL2(I,3)); CALL IDFCOPY(IDF,MDL2(I,4)); CALL IDFCOPY(IDF,MDL2(I,5))

 ENDDO

 NROW=MDL2(1,1)%NROW; NCOL=MDL2(1,1)%NCOL
 DO I=1,NLY2; MDL2(I,3)%X=0.0; MDL2(I,4)%X=0.0; MDL2(I,5)%X=0.0; ENDDO
  
 DO I=1,NLY1 
 
  DO J=1,SIZE(MDL1,2); CALL IDFDEALLOCATEX(MDL1(1,J)); ENDDO
  
  IF(.NOT.UTL_READINITFILE('TOP1_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL1(1,1)%FNAME; LINE='TOP1_L'//TRIM(ITOS(I))//'='//TRIM(MDL1(1,1)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL1(1,1)); IF(.NOT.IDFREADSCALE(MDL1(1,1)%FNAME,MDL1(1,1),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  IF(.NOT.UTL_READINITFILE('BOT1_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL1(1,2)%FNAME; LINE='BOT1_L'//TRIM(ITOS(I))//'='//TRIM(MDL1(1,2)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL1(1,2)); IF(.NOT.IDFREADSCALE(MDL1(1,2)%FNAME,MDL1(1,2),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  IF(.NOT.UTL_READINITFILE('KHV1_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL1(1,3)%FNAME; LINE='KHV1_L'//TRIM(ITOS(I))//'='//TRIM(MDL1(1,3)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL1(1,3)); IF(.NOT.IDFREADSCALE(MDL1(1,3)%FNAME,MDL1(1,3),3,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  IF(.NOT.UTL_READINITFILE('KVA1_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL1(1,4)%FNAME; LINE='KVA1_L'//TRIM(ITOS(I))//'='//TRIM(MDL1(1,4)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL1(1,4)); IF(.NOT.IDFREADSCALE(MDL1(1,4)%FNAME,MDL1(1,4),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  IF(.NOT.UTL_READINITFILE('KVV1_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MDL1(1,5)%FNAME; LINE='KVV1_L'//TRIM(ITOS(I))//'='//TRIM(MDL1(1,5)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  CALL IDFCOPY(IDF,MDL1(1,5)); IF(.NOT.IDFREADSCALE(MDL1(1,5)%FNAME,MDL1(1,5),3,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'

  IF(I.LT.NLY1)THEN
   IF(.NOT.UTL_READINITFILE('TOP1_L'//TRIM(ITOS(I+1)),LINE,IU,0))RETURN
   READ(LINE,*) MDL1(1,6)%FNAME; LINE='TOP1_L'//TRIM(ITOS(I+1))//'='//TRIM(MDL1(1,6)%FNAME); WRITE(*,'(A)') TRIM(LINE)
   CALL IDFCOPY(IDF,MDL1(1,6)); IF(.NOT.IDFREADSCALE(MDL1(1,6)%FNAME,MDL1(1,6),2,1,0.0D0,0))STOP 'Cannot read data for IDF(1)'
  ENDIF

  DO IROW=1,NROW; DO ICOL=1,NCOL
   
   TOP1=MDL1(1,1)%X(ICOL,IROW); BOT1=MDL1(1,2)%X(ICOL,IROW); IF(TOP1-BOT1.LE.0.0)CYCLE
   DO J=1,NLY2
    TOP2=MDL2(J,1)%X(ICOL,IROW); BOT2=MDL2(J,2)%X(ICOL,IROW)
    !## fill in horizontal/vertical transmissivity
    IF(TOP1.GT.BOT2.AND.BOT1.LT.TOP2)THEN
     T=MIN(TOP1,TOP2); B=MAX(BOT1,BOT2)
     !## sum of kd
     MDL2(J,3)%X(ICOL,IROW)=MDL2(J,3)%X(ICOL,IROW)+(T-B)* MDL1(1,3)%X(ICOL,IROW)
     !## sum of c
     MDL2(J,4)%X(ICOL,IROW)=MDL2(J,4)%X(ICOL,IROW)+(T-B)/(MDL1(1,3)%X(ICOL,IROW)*MDL1(1,4)%X(ICOL,IROW))
    ENDIF
   ENDDO
  
   !## fill in aquitards
   IF(I.LE.NLY2)THEN
    TOP1=MDL1(1,2)%X(ICOL,IROW); BOT1=MDL1(1,6)%X(ICOL,IROW); IF(TOP1-BOT1.LE.0.0)CYCLE
    DO J=1,NLY2-1
     TOP2=MDL2(J,2)%X(ICOL,IROW); BOT2=MDL2(J+1,2)%X(ICOL,IROW)
     IF(TOP1.GT.BOT2.AND.BOT1.LT.TOP2)THEN
      T=MIN(TOP1,TOP2); B=MAX(BOT1,BOT2)
      !## sum of c
      MDL2(I,5)%X(ICOL,IROW)=MDL2(I,5)%X(ICOL,IROW)+(T-B)/MDL1(1,5)%X(ICOL,IROW)
     ENDIF
    ENDDO
   ENDIF

  ENDDO; ENDDO
 ENDDO
 
 !## convert to k-values and anisotropy
 DO J=1,NLY2
  DO IROW=1,NROW; DO ICOL=1,NCOL

   TOP2=MDL2(J,1)%X(ICOL,IROW); BOT2=MDL2(J,2)%X(ICOL,IROW)
   IF(TOP2.GT.BOT2)THEN
    IF(MDL2(J,3)%X(ICOL,IROW).GT.0.0D0)THEN
     MDL2(J,3)%X(ICOL,IROW)=MDL2(J,3)%X(ICOL,IROW)/(TOP2-BOT2)
     MDL2(J,5)%X(ICOL,IROW)=(TOP2-BOT2)/MDL2(J,4)%X(ICOL,IROW)
     MDL2(J,4)%X(ICOL,IROW)=MDL2(J,5)%X(ICOL,IROW)/MDL2(J,3)%X(ICOL,IROW)
    ELSE
     MDL2(J,1)%X(ICOL,IROW)=MDL2(J,1)%NODATA
     MDL2(J,2)%X(ICOL,IROW)=MDL2(J,2)%NODATA
     MDL2(J,3)%X(ICOL,IROW)=MDL2(J,3)%NODATA
     MDL2(J,4)%X(ICOL,IROW)=MDL2(J,4)%NODATA
    ENDIF
   ENDIF
   IF(J.LT.NLY2)THEN
    TOP2=MDL2(J,2)%X(ICOL,IROW); BOT2=MDL2(J+1,1)%X(ICOL,IROW)
    IF(TOP2.GT.BOT2)THEN
     IF(MDL2(J,5)%X(ICOL,IROW).GT.0.0D0)THEN
      MDL2(J,5)%X(ICOL,IROW)=(TOP2-BOT2)/MDL2(J,5)%X(ICOL,IROW)
     ELSE
      MDL2(J,5)%X(ICOL,IROW)=MDL2(J,5)%NODATA
     ENDIF
    ENDIF
   ENDIF
  ENDDO; ENDDO
 ENDDO 
 
 DO I=1,NLY2
  MDL2(I,1)%FNAME=TRIM(OUTPUTFOLDER)//'\TOP_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(MDL2(I,1),MDL2(I,1)%FNAME,1))RETURN
  MDL2(I,2)%FNAME=TRIM(OUTPUTFOLDER)//'\BOT_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(MDL2(I,2),MDL2(I,2)%FNAME,1))RETURN
  MDL2(I,3)%FNAME=TRIM(OUTPUTFOLDER)//'\KHV_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(MDL2(I,3),MDL2(I,3)%FNAME,1))RETURN
  MDL2(I,4)%FNAME=TRIM(OUTPUTFOLDER)//'\KVA_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(MDL2(I,4),MDL2(I,4)%FNAME,1))RETURN
  MDL2(I,5)%FNAME=TRIM(OUTPUTFOLDER)//'\KVV_L'//TRIM(ITOS(I))//'.IDF'
  IF(.NOT.IDFWRITE(MDL2(I,5),MDL2(I,5)%FNAME,1))RETURN
 ENDDO
 
 END SUBROUTINE IMODBATCH_RESAMPLELAYERS

 !###======================================================================
 SUBROUTINE IMODBATCH_CUS()
 !###======================================================================
 USE MOD_CUS_PAR, ONLY : REGISTOP,REGISBOT,OUTPUTFOLDER,MDLIDF,TOPIDF,  &
                         BOTIDF,ZIDF,ZCRIT,ZINFO,FDISTANCES,NFORM,   &
                         TOPSYSTEM,BOTSYSTEM,PERCENTAGE,CRIT_THICKNESS, &
                         ICPOINTERS,NLAY,CLIPIDF,NCLIP,ICLIP,IEXPZONE,  &
                         MIN_THICKNESS,MINEXTENT
 IMPLICIT NONE
 INTEGER :: I,IOS
 
 FDISTANCES=''; ICPOINTERS=1; NCLIP=0; IEXPZONE=0; MIN_THICKNESS=0.0D0; CRIT_THICKNESS=0.0D0

 ALLOCATE(MDLIDF(5)); DO I=1,SIZE(MDLIDF); CALL IDFNULLIFY(MDLIDF(I)); ENDDO
 MDLIDF(1)%XMIN=0.0D0; MDLIDF(1)%YMIN=0.0D0; MDLIDF(1)%XMAX=0.0D0; MDLIDF(1)%YMAX=0.0D0

 IF(UTL_READINITFILE('ICPOINTERS',LINE,IU,1))READ(LINE,*) ICPOINTERS
 WRITE(*,'(A,I1)') 'ICPOINTERS=',ICPOINTERS
 
 !## read predefined number of modellayers
 IF(ICPOINTERS.EQ.0)THEN
  IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
  READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 ELSE
  IF(UTL_READINITFILE('FDISTANCES',LINE,IU,1))THEN
   READ(LINE,*) FDISTANCES; WRITE(*,'(A)') 'FDISTANCES='//TRIM(FDISTANCES)
  ELSE
   IF(UTL_READINITFILE('CRIT_THICKNESS',LINE,IU,1))READ(LINE,*) CRIT_THICKNESS
   WRITE(*,'(A,F10.2)') 'CRIT_THICKNESS=',CRIT_THICKNESS
   IF(UTL_READINITFILE('MIN_THICKNESS',LINE,IU,1))READ(LINE,*) MIN_THICKNESS
   WRITE(*,'(A,F10.2)') 'MIN_THICKNESS=',MIN_THICKNESS
   MINEXTENT=0; IF(UTL_READINITFILE('MINEXTENT',LINE,IU,1))READ(LINE,*) MINEXTENT
   WRITE(*,'(A,I10)') 'MINEXTENT=',MINEXTENT
   IF(UTL_READINITFILE('ICLIP',LINE,IU,1))THEN
    CALL IDFNULLIFY(CLIPIDF); NCLIP=1
    READ(LINE,*) CLIPIDF%FNAME
    LINE='ICLIP='//TRIM(CLIPIDF%FNAME); WRITE(*,'(A)') TRIM(LINE)
   ENDIF
   IF(UTL_READINITFILE('IEXPZONE',LINE,IU,1))READ(LINE,*) IEXPZONE
   LINE='IEXPZONE='//TRIM(ITOS(IEXPZONE)); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  ZCRIT=0.0D0; IF(UTL_READINITFILE('ZCRIT',LINE,IU,1))READ(LINE,*) ZCRIT
  WRITE(*,'(A,F10.2)') 'ZCRIT=',ZCRIT
  PERCENTAGE=95; IF(UTL_READINITFILE('PERCENTAGE',LINE,IU,1))READ(LINE,*) PERCENTAGE
  LINE='PERCENTAGE'//'='//TRIM(RTOS(PERCENTAGE,'F',2)); WRITE(*,'(A)') TRIM(LINE)
 ENDIF

 IF(TRIM(FDISTANCES).EQ.'')THEN
  IF(UTL_READINITFILE('NFORM',LINE,IU,1))THEN
   READ(LINE,*) NFORM; WRITE(*,'(A,I10)') 'NFORM=',NFORM
   ALLOCATE(TOPIDF(NFORM),BOTIDF(NFORM),ZIDF(NFORM),ZINFO(NFORM),ICLIP(NFORM,2))
   DO I=1,NFORM
    CALL IDFNULLIFY(TOPIDF(I)); CALL IDFNULLIFY(BOTIDF(I)); CALL IDFNULLIFY(ZIDF(I))
    NULLIFY(ZINFO(I)%NP); ZINFO(I)%NZ=0

    IF(ICPOINTERS.EQ.0)THEN
     IF(.NOT.UTL_READINITFILE('PNT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) ZIDF(I)%FNAME
     LINE='PNT_L'//TRIM(ITOS(I))//'='//TRIM(ZIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
    ENDIF
    
    IF(.NOT.UTL_READINITFILE('FORMTOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
    READ(LINE,*,IOSTAT=IOS) TOPIDF(I)%FNAME,ICLIP(I,1)
    IF(IOS.NE.0)THEN; READ(LINE,*) TOPIDF(I)%FNAME; ICLIP(I,1)=0; ENDIF
    LINE='FORMTOP_L'//TRIM(ITOS(I))//'='//TRIM(TOPIDF(I)%FNAME)//'(CLIP='//TRIM(ITOS(ICLIP(I,1)))//')'; WRITE(*,'(A)') TRIM(LINE)
    
    IF(.NOT.UTL_READINITFILE('FORMBOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
    READ(LINE,*,IOSTAT=IOS) BOTIDF(I)%FNAME,ICLIP(I,2)
    IF(IOS.NE.0)THEN; READ(LINE,*) BOTIDF(I)%FNAME; ICLIP(I,2)=0; ENDIF
    LINE='FORMBOT_L'//TRIM(ITOS(I))//'='//TRIM(BOTIDF(I)%FNAME)//'(CLIP='//TRIM(ITOS(ICLIP(I,2)))//')'; WRITE(*,'(A)') TRIM(LINE)
   ENDDO
  ELSE
   IF(.NOT.UTL_READINITFILE('FORMTOP',LINE,IU,0))RETURN
   READ(LINE,*) REGISTOP; WRITE(*,'(A)') 'FORMTOP='//TRIM(REGISTOP)
   IF(.NOT.UTL_READINITFILE('FORMBOT',LINE,IU,0))RETURN
   READ(LINE,*) REGISBOT; WRITE(*,'(A)') 'FORMBOT='//TRIM(REGISBOT)
  ENDIF
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MDLIDF(1)%XMIN,MDLIDF(1)%YMIN,MDLIDF(1)%XMAX,MDLIDF(1)%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MDLIDF(1)%XMIN,MDLIDF(1)%YMIN,MDLIDF(1)%XMAX,MDLIDF(1)%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MDLIDF(1)%DX; WRITE(*,'(A,F10.2)') 'CELLSIZE=',MDLIDF(1)%DX
  MDLIDF(1)%DY=MDLIDF(1)%DX
  CALL UTL_IDFSNAPTOGRID(MDLIDF(1)%XMIN,MDLIDF(1)%XMAX,MDLIDF(1)%YMIN,MDLIDF(1)%YMAX,MDLIDF(1)%DX,MDLIDF(1)%NCOL,MDLIDF(1)%NROW)
 ENDIF

 IF(.NOT.UTL_READINITFILE('TOPSYSTEM',LINE,IU,0))RETURN
 READ(LINE,*) TOPSYSTEM; WRITE(*,'(A)') 'TOPSYSTEM='//TRIM(TOPSYSTEM)
 IF(.NOT.UTL_READINITFILE('BOTSYSTEM',LINE,IU,0))RETURN
 READ(LINE,*) BOTSYSTEM; WRITE(*,'(A)') 'BOTSYSTEM='//TRIM(BOTSYSTEM)

 IF(CUS_MAIN())THEN; ENDIF
 CALL CUS_DEALLOCATE()
 
 END SUBROUTINE IMODBATCH_CUS

 !###======================================================================
 SUBROUTINE IMODBATCH_GEOTOP()
 !###======================================================================
 USE MOD_SOLID_PAR, ONLY : NLAYG,NLAYM,KHG,KVG,MDLIDF,KHM,KAM,KVM,SHM,IBM,TPM, &
        BTM,RESULTFOLDER
 IMPLICIT NONE
 INTEGER :: I
 
 !## results folder
 IF(.NOT.UTL_READINITFILE('RESULTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) RESULTFOLDER; WRITE(*,'(A)') 'RESULTFOLDER='//TRIM(RESULTFOLDER)

 !## number of modellayers
 IF(.NOT.UTL_READINITFILE('NLAYG',LINE,IU,0))RETURN
 READ(LINE,*) NLAYG; WRITE(*,'(A,I10)') 'NLAYG=',NLAYG
 IF(.NOT.UTL_READINITFILE('NLAYM',LINE,IU,0))RETURN
 READ(LINE,*) NLAYM; WRITE(*,'(A,I10)') 'NLAYM=',NLAYM

 !## read geotop-files (voxels)
 ALLOCATE(KHG(NLAYG),KVG(NLAYG))
 DO I=1,NLAYG
  CALL IDFNULLIFY(KHG(I)); CALL IDFNULLIFY(KVG(I))
  IF(.NOT.UTL_READINITFILE('KHG_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) KHG(I)%FNAME
  LINE='KHG_L'//TRIM(ITOS(I))//'='//TRIM(KHG(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('KVG_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) KVG(I)%FNAME
  LINE='KVG_L'//TRIM(ITOS(I))//'='//TRIM(KVG(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 
 !## read model-files
 ALLOCATE(KHM(NLAYM),TPM(NLAYM),BTM(NLAYM),SHM(NLAYM),IBM(NLAYM),KVM(NLAYM),KAM(NLAYM))
 
 DO I=1,NLAYM
  CALL IDFNULLIFY(KHM(I)); CALL IDFNULLIFY(TPM(I)); CALL IDFNULLIFY(BTM(I))
  CALL IDFNULLIFY(SHM(I)); CALL IDFNULLIFY(IBM(I)); CALL IDFNULLIFY(KVM(I))
  CALL IDFNULLIFY(KAM(I))
  IF(.NOT.UTL_READINITFILE('IBM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) IBM(I)%FNAME
  LINE='IBM_L'//TRIM(ITOS(I))//'='//TRIM(IBM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('SHM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) SHM(I)%FNAME
  LINE='SHM_L'//TRIM(ITOS(I))//'='//TRIM(SHM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('TPM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) TPM(I)%FNAME
  LINE='TPM_L'//TRIM(ITOS(I))//'='//TRIM(TPM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BTM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) BTM(I)%FNAME
  LINE='BTM_L'//TRIM(ITOS(I))//'='//TRIM(BTM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('KHM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) KHM(I)%FNAME
  LINE='KHM_L'//TRIM(ITOS(I))//'='//TRIM(KHM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('KAM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) KAM(I)%FNAME
  LINE='KAM_L'//TRIM(ITOS(I))//'='//TRIM(KAM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(I.LT.NLAYM)THEN
   IF(.NOT.UTL_READINITFILE('KVM_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) KVM(I)%FNAME
   LINE='KVM_L'//TRIM(ITOS(I))//'='//TRIM(KVM(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
 ENDDO

 MDLIDF%XMIN=0.0D0; MDLIDF%YMIN=0.0D0; MDLIDF%XMAX=0.0D0; MDLIDF%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MDLIDF%DX; WRITE(*,'(A,F10.2)') 'CELLSIZE=',MDLIDF%DX
  MDLIDF%DY=MDLIDF%DX
 ENDIF

 IF(.NOT.SOLID_GEOTOP())RETURN
 CALL SOLID_GEOTOP_DEALLOCATE()
 
 END SUBROUTINE IMODBATCH_GEOTOP

 !###======================================================================
 SUBROUTINE IMODBATCH_IPFSPOTIFY()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: NLAY,I
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: TOPIDF,BOTIDF
 CHARACTER(LEN=256),DIMENSION(2) :: IPFFNAME,REGIS
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 INTEGER,DIMENSION(6) :: IXCOL
 
 IPFFNAME=''; OUTPUTFOLDER=''; IXCOL=0
 IF(UTL_READINITFILE('IPFFILE_IN',LINE,IU,1))THEN
  READ(LINE,*) IPFFNAME(1); WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFFNAME(1))

  IXCOL(1)=1; IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IXCOL(1)
  WRITE(*,'(A,I2)') 'IXCOL=',IXCOL(1)
  IXCOL(2)=2; IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IXCOL(2)
  WRITE(*,'(A,I2)') 'IYCOL=',IXCOL(2)
  IXCOL(3)=3; IF(UTL_READINITFILE('IFCOL',LINE,IU,1))READ(LINE,*) IXCOL(3)
  WRITE(*,'(A,I2)') 'IFCOL=',IXCOL(3)
  IXCOL(4)=1; IF(UTL_READINITFILE('IZ1COL',LINE,IU,1))READ(LINE,*) IXCOL(4)
  WRITE(*,'(A,I2)') 'IZ1COL=',IXCOL(4)
  IXCOL(5)=1; IF(UTL_READINITFILE('IZ2COL',LINE,IU,1))READ(LINE,*) IXCOL(5)
  WRITE(*,'(A,I2)') 'IZ2COL=',IXCOL(5)
  IXCOL(6)=6; IF(UTL_READINITFILE('ILCOL',LINE,IU,1))READ(LINE,*) IXCOL(6)
  WRITE(*,'(A,I2)') 'ILCOL=',IXCOL(6) 

  IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
  READ(LINE,*) IPFFNAME(2); WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFFNAME(2))
 
 ELSE
  IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
  READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 ENDIF
 
 !## number of modellayers
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 
 ALLOCATE(TOPIDF(NLAY),BOTIDF(NLAY))
 DO I=1,SIZE(TOPIDF); CALL IDFNULLIFY(TOPIDF(I)); ENDDO
 DO I=1,SIZE(BOTIDF); CALL IDFNULLIFY(BOTIDF(I)); ENDDO
 
 !## try to read all idf's
 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) TOPIDF(I)%FNAME
  LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(TOPIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) BOTIDF(I)%FNAME
  LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(BOTIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 
 IF(.NOT.UTL_READINITFILE('FORMTOP',LINE,IU,0))RETURN
 READ(LINE,*) REGIS(1); WRITE(*,'(A)') 'FORMTOP='//TRIM(REGIS(1))
 IF(.NOT.UTL_READINITFILE('FORMBOT',LINE,IU,0))RETURN
 READ(LINE,*) REGIS(2); WRITE(*,'(A)') 'FORMBOT='//TRIM(REGIS(2))
 
 CALL IPFSPOTIFY(IPFFNAME,TOPIDF,BOTIDF,IXCOL,REGIS,OUTPUTFOLDER)
 
 END SUBROUTINE IMODBATCH_IPFSPOTIFY

 !###======================================================================
 SUBROUTINE IMODBATCH_IPFSUM()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: NFILE
 TYPE(IDFOBJ) :: ZONEIDF
 CHARACTER(LEN=256),DIMENSION(:),ALLOCATABLE :: IPFFILE
 CHARACTER(LEN=256) :: OUTPUTFILE,FNAME
 CHARACTER(LEN=5) :: EXT
 CHARACTER(LEN=52) :: CID
 CHARACTER(LEN=52),DIMENSION(3) :: STRING
 INTEGER :: I,J,K,N,M,NN,JU,KU,IEXT,IDATE,IY,IM,ID,IBAL,IROW,ICOL,IPER,DD,NYR,IZONE,DDATE,IYR,IMH,IDY,IHR,IMT,ISC,SDATE,EDATE,D1,D2
 INTEGER, ALLOCATABLE,DIMENSION(:) :: IP,JDATES,JDATE
 INTEGER(KIND=DP_KIND) :: IDATED
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: Q
 REAL(KIND=DP_KIND) :: X,Y
 TYPE BALOBJ
  CHARACTER(LEN=52) :: LABEL
  REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: Q=>NULL()
 END TYPE BALOBJ
 TYPE(BALOBJ),DIMENSION(:),ALLOCATABLE :: BAL
 
 IZONE=0
 
 IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
 READ(LINE,*) SDATE; WRITE(*,'(A,I10)') 'SDATE=',SDATE
 IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
 READ(LINE,*) EDATE; WRITE(*,'(A,I10)') 'EDATE=',EDATE
 IF(.NOT.UTL_READINITFILE('DDATE',LINE,IU,0))RETURN
 READ(LINE,*) DDATE
 SELECT CASE (DDATE)
  CASE(1); WRITE(*,'(A,I1,A)') 'DDATE=',DDATE,' (daily)'
  CASE(2); WRITE(*,'(A,I1,A)') 'DDATE=',DDATE,' (weekly)'
  CASE(3); WRITE(*,'(A,I1,A)') 'DDATE=',DDATE,' (monthly)'
  CASE(4); WRITE(*,'(A,I1,A)') 'DDATE=',DDATE,' (yearly)'
  CASE DEFAULT; WRITE(*,'(A)') 'Wrong DDATA value, need to be 1 <= DDATE <= 4'
 END SELECT 

 NYR=UTL_DIFFDATE(SDATE,EDATE,DDATE) 
 WRITE(*,'(A,I10,A)') 'Defined ',NYR,' periods'
 ALLOCATE(JDATES(0:NYR)); JDATES(0)=UTL_IDATETOJDATE(SDATE)
 DO I=1,NYR
  SELECT CASE (DDATE)
   !## day
   CASE (1); JDATES(I)=JDATES(I-1)+1
   !## week
   CASE (2); JDATES(I)=JDATES(I-1)+7
   !## month
   CASE (3);
    IDATE=UTL_JDATETOIDATE(JDATES(I-1)); CALL IDATETOGDATE(IDATE,IY,IM,ID); IM=IM+1; IF(IM.GT.12)THEN; IM=1; IY=IY+1; ENDIF; JDATES(I)=JD(IY,IM,ID)
   !## year
   CASE (4);
    IDATE=UTL_JDATETOIDATE(JDATES(I-1)); CALL IDATETOGDATE(IDATE,IY,IM,ID); IY=IY+1; JDATES(I)=JD(IY,IM,ID)
  END SELECT
 ENDDO

 DO I=0,NYR
  IDATE=UTL_JDATETOIDATE(JDATES(I)); CALL IDATETOGDATE(IDATE,IY,IM,ID)
  WRITE(*,'(I10,A1,I2.2,A1,I2.2,A1,I4)') JDATES(I),' ',ID,'-',IM,'-',IY
 ENDDO
   
 IF(.NOT.UTL_READINITFILE('NFILE',LINE,IU,0))RETURN
 READ(LINE,*) NFILE; WRITE(*,'(A,I10)') 'NFILE=',NFILE
 
 ALLOCATE(IPFFILE(NFILE))
 
 DO I=1,NFILE

  IF(.NOT.UTL_READINITFILE('IPFFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IPFFILE(I); LINE='IPFFILE'//TRIM(ITOS(I))//'='//TRIM(IPFFILE(I))
  WRITE(*,'(A)') TRIM(LINE)
 
 ENDDO
 
 IF(UTL_READINITFILE('ZONEIDF',LINE,IU,1))THEN

  IZONE=1
  READ(LINE,*) ZONEIDF%FNAME; WRITE(*,'(A)') 'ZONEIDF='//TRIM(ZONEIDF%FNAME)

  !## read zones
  IF(.NOT.IDFREAD(ZONEIDF,ZONEIDF%FNAME,1))STOP
  !## get number of zones
  ALLOCATE(IP(ZONEIDF%NCOL*ZONEIDF%NROW)); IBAL=0; DO IROW=1,ZONEIDF%NROW; DO ICOL=1,ZONEIDF%NCOL; IBAL=IBAL+1; IP(IBAL)=INT(ZONEIDF%X(ICOL,IROW)); ENDDO; ENDDO
  CALL UTL_GETUNIQUE_INT(IP,ZONEIDF%NCOL*ZONEIDF%NROW,N,INT(ZONEIDF%NODATA))
  WRITE(*,'(/1X,A,I10,A)') 'Found ',N,' unique zones'
 
 ELSE

  N=1
 
 ENDIF
 
 ALLOCATE(BAL(N))
 DO IBAL=1,SIZE(BAL); ALLOCATE(BAL(IBAL)%Q(NYR)); BAL(IBAL)%Q=0.0D0; ENDDO
 DO IBAL=1,SIZE(BAL)
  IF(IZONE.EQ.0)THEN
   WRITE(BAL(IBAL)%LABEL,'(A)') 'ZONE1'
  ELSE
   !## try to read label for balance
   IF(UTL_READINITFILE('LABEL'//TRIM(ITOS(IBAL)),LINE,IU,1))THEN
    READ(LINE,*) BAL(IBAL)%LABEL
   ELSE
    WRITE(BAL(IBAL)%LABEL,'(A)') 'ZONE'//TRIM(ITOS(IP(IBAL)))
   ENDIF
   WRITE(*,'(A)') 'LABEL'//TRIM(ITOS(IBAL))//'='//TRIM(BAL(IBAL)%LABEL)
  ENDIF
 ENDDO

 !## process all ipf files
 DO I=1,NFILE
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=IPFFILE(I),ACTION='READ',FORM='FORMATTED',STATUS='OLD')
  WRITE(*,'(A)') 'Reading '//TRIM(IPFFILE(I))//' ...'
  READ(JU,*) N; READ(JU,*) M; DO J=1,M; READ(JU,*); ENDDO; READ(JU,*) IEXT,EXT
  DO J=1,N
   READ(JU,*) (STRING(K),K=1,3)
   READ(STRING(1),*) X
   READ(STRING(2),*) Y
   CID=STRING(3)

   IF(IZONE.EQ.1)THEN
    CALL IDFIROWICOL(ZONEIDF,IROW,ICOL,X,Y)
    !## outside zone idf
    IF(IROW.LE.0.OR.ICOL.LE.0)CYCLE
    !## skip nodata
    IF(ZONEIDF%X(ICOL,IROW).EQ.ZONEIDF%NODATA)CYCLE
    !## skip outside zones
    DO IBAL=1,SIZE(BAL)
     IF(INT(ZONEIDF%X(ICOL,IROW)).EQ.IP(IBAL))EXIT
    ENDDO
    IF(IBAL.GT.SIZE(BAL))CYCLE
   ELSE
    IBAL=1
   ENDIF
   
   FNAME=IPFFILE(I)(:INDEX(IPFFILE(I),'\',.TRUE.))//TRIM(CID)//'.'//TRIM(EXT)
   KU=UTL_GETUNIT(); CALL OSD_OPEN(KU,FILE=FNAME,ACTION='READ',FORM='FORMATTED',STATUS='OLD')
   READ(KU,*) NN; READ(KU,*) M; DO K=1,M; READ(KU,*); ENDDO

   ALLOCATE(JDATE(0:NN+1),Q(0:NN+1)); JDATE=0; Q=0.0D0
   JDATE(0)=UTL_IDATETOJDATE(SDATE)
   DO K=1,NN
    READ(KU,*) IDATED,Q(K); IF(IDATED.LT.99999999)IDATED=IDATED*1000000
    CALL ITIMETOGDATE(IDATED,IYR,IMH,IDY,IHR,IMT,ISC)
    JDATE(K)=IYR*10000+IMH*100+IDY; JDATE(K)=UTL_IDATETOJDATE(JDATE(K))
   ENDDO
   JDATE(NN+1)=UTL_IDATETOJDATE(EDATE)+1
   
   DO K=0,NN
    !## fill in all periods
    DO IPER=1,NYR
     IF(JDATES(IPER-1).LT.JDATE(K+1).AND.JDATES(IPER).GT.JDATE(K))THEN
      D1=MAX(JDATES(IPER-1),JDATE(K))
      D2=MIN(JDATES(IPER)  ,JDATE(K+1))
      DD=D2-D1
      BAL(IBAL)%Q(IPER)=BAL(IBAL)%Q(IPER)+Q(K)*DD
     ENDIF
    ENDDO
   ENDDO
   DEALLOCATE(JDATE,Q); CLOSE(KU)
  ENDDO
  CLOSE(JU)
 ENDDO

 IF(.NOT.UTL_READINITFILE('OUTPUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFILE; WRITE(*,'(A)') 'OUTPUTFILE='//TRIM(OUTPUTFILE)

 JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=OUTPUTFILE,ACTION='WRITE',FORM='FORMATTED',STATUS='UNKNOWN')

 WRITE(JU,'(99A)') 'Location Names',(','//TRIM(BAL(J)%LABEL),J=1,SIZE(BAL))
 WRITE(JU,'(99A)') 'Date,Duration',(',Q_m3/d',J=1,SIZE(BAL))

 DO IPER=1,NYR

  IDATE=UTL_JDATETOIDATE(JDATES(IPER-1)); CALL IDATETOGDATE(IDATE,IY,IM,ID)
  DD= (JDATES(IPER)-JDATES(IPER-1)) !+1
  WRITE(JU,'(I4.4,2I2.2,1X,I4.4,1X,(99F10.2,1X))') IY,IM,ID,DD,(BAL(J)%Q(IPER)/REAL(DD,8),J=1,SIZE(BAL))

 ENDDO

 CLOSE(JU)
 DO I=1,SIZE(BAL); DEALLOCATE(BAL(I)%Q); ENDDO
  
 END SUBROUTINE IMODBATCH_IPFSUM
 
 !###======================================================================
 SUBROUTINE  IMODBATCH_CREATEWELBORELOG()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IPFNAME,DIR
 CHARACTER(LEN=52) :: ID
 TYPE(IDFOBJ) :: SURFLEVEL
 INTEGER :: I,JU,KU
 REAL(KIND=DP_KIND) :: XC,YC,TP,BT,SL
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFNAME)
 IF(.NOT.UTL_READINITFILE('SURFLEVEL',LINE,IU,0))RETURN
 READ(LINE,*) SURFLEVEL%FNAME; WRITE(*,'(A)') 'SURFLEVEL='//TRIM(SURFLEVEL%FNAME)
 IF(.NOT.IDFREAD(SURFLEVEL,SURFLEVEL%FNAME,0))STOP
 
 NIPF=1; CALL IPFALLOCATE()
 !## read twice
 DO I=1,NIPF
  IPF(I)%FNAME=IPFNAME; IPF(I)%XCOL=1; IPF(I)%YCOL=2; IPF(I)%ZCOL=4; IPF(I)%Z2COL=5; IPF(I)%QCOL=1;
  IF(.NOT.IPFREAD2(I,1,1))RETURN
 ENDDO

 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFNAME)
 DIR=IPFNAME(:INDEX(IPFNAME,'\',.TRUE.)-1)
 
 JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFNAME,STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,'(A)') TRIM(ITOS(IPF(1)%NROW))
 WRITE(JU,'(A)') '6'
 WRITE(JU,'(A)') 'XC'
 WRITE(JU,'(A)') 'YC'
 WRITE(JU,'(A)') 'ID'
 WRITE(JU,'(A)') 'TP'
 WRITE(JU,'(A)') 'BT'
 WRITE(JU,'(A)') 'SL'
 WRITE(JU,'(A)') '3,TXT'
 DO I=1,IPF(1)%NROW
  XC=IPF(1)%XYZ(1,I)
  YC=IPF(1)%XYZ(2,I)
  TP=IPF(1)%XYZ(3,I)
  BT=IPF(1)%XYZ(4,I)
  SL=IDFGETXYVAL(SURFLEVEL,XC,YC)
  IF(SL.NE.SURFLEVEL%NODATA)THEN
   ID='WELLOC_'//TRIM(ITOS(I))
   KU=UTL_GETUNIT(); OPEN(KU,FILE=TRIM(DIR)//'\'//TRIM(ID)//'.TXT',STATUS='UNKNOWN',ACTION='WRITE')
   WRITE(KU,'(A)') '3'
   WRITE(KU,'(A)') '2,2'
   WRITE(KU,'(A)') 'Z,-999.0'
   WRITE(KU,'(A)') 'L,-999.0'
   WRITE(KU,'(A)') TRIM(RTOS(SL,'F',2))//',P'
   WRITE(KU,'(A)') TRIM(RTOS(TP,'F',2))//',F'
   WRITE(KU,'(A)') TRIM(RTOS(BT,'F',2))//',-'
   CLOSE(KU)
   WRITE(JU,'(A)') TRIM(RTOS(XC,'F',2))//','//TRIM(RTOS(YC,'F',2))//','//TRIM(ID)//','//TRIM(RTOS(TP,'F',2))//','//TRIM(RTOS(BT,'F',2))//','//TRIM(RTOS(SL,'F',2))
  ELSE
   WRITE(JU,'(A)') TRIM(RTOS(XC,'F',2))//','//TRIM(RTOS(YC,'F',2))//',NONE,'//TRIM(RTOS(TP,'F',2))//','//TRIM(RTOS(BT,'F',2))//','//TRIM(RTOS(SL,'F',2))
  ENDIF
 ENDDO
 CLOSE(JU)
 
 END SUBROUTINE  IMODBATCH_CREATEWELBORELOG
 
 !###======================================================================
 SUBROUTINE IMODBATCH_IPFEDIT()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IPFNAME
 INTEGER :: NCOL,I,J
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IC
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFNAME)

 NIPF=2; CALL IPFALLOCATE()
 !## read twice
 DO I=1,NIPF
  IPF(I)%FNAME=IPFNAME; IPF(I)%XCOL =1; IPF(I)%YCOL=2; IPF(I)%ZCOL=2; IPF(I)%Z2COL=2; IPF(I)%QCOL=2;
  IF(.NOT.IPFREAD2(I,1,1))RETURN
 ENDDO

 IF(.NOT.UTL_READINITFILE('NCOLUMNS',LINE,IU,0))RETURN
 READ(LINE,*) NCOL; WRITE(*,'(A,I10)') 'NCOLUMNS=',NCOL
 ALLOCATE(IC(NCOL)); IC=0
 DO I=1,NCOL
  IF(.NOT.UTL_READINITFILE('ICOL'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IC(I); WRITE(*,'(A,I10)') 'ICOL'//TRIM(ITOS(I)),IC(I)
  IF(IC(I).LE.0.OR.IC(I).GT.IPF(1)%NCOL)THEN
   WRITE(*,'(/A/)') 'ERROR COLUMN NUMBER NEED TO BE >0 AND <='//TRIM(ITOS(IPF(1)%NCOL)); STOP
  ENDIF
 ENDDO
  
 !## shuffle columns
 DO I=1,NCOL; IPF(2)%ATTRIB(I)=IPF(1)%ATTRIB(IC(I)); ENDDO
 IPF(2)%NCOL=NCOL
 DO J=1,IPF(1)%NROW; DO I=1,NCOL
  IPF(2)%INFO(I,J)=IPF(1)%INFO(IC(I),J)
 ENDDO; ENDDO
 IPF(2)%ACOL=0; DO I=1,NCOL; IF(IPF(1)%ACOL.EQ.IC(I))THEN; IPF(2)%ACOL=I; EXIT; ENDIF; ENDDO
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFNAME)
 CALL UTL_CREATEDIR(IPFNAME(:INDEX(IPFNAME,'\',.TRUE.)-1))
 IPF(2)%FNAME=IPFNAME; IF(.NOT.IPFWRITE(2))THEN; ENDIF; CALL IPFDEALLOCATE()
 
 END SUBROUTINE IMODBATCH_IPFEDIT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_AGGREGATE()
 !###======================================================================
 USE MOD_AGGREGATE_PAR
 IMPLICIT NONE
 INTEGER :: OBSIROW,OBSICOL
 
 IPRJ=0; IWINDOW=0
 
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IWINDOW=1; READ(LINE,*) XMIN,YMIN,XMAX,YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',XMIN,YMIN,XMAX,YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) CELLSIZE; WRITE(*,'(A,F10.2)') 'CELLSIZE=',CELLSIZE
 ENDIF

 !## read ini-file
 IF(.NOT.UTL_READINITFILE('SORTFILE',LINE,IU,0))RETURN
 READ(LINE,*) SORTFILE; WRITE(*,'(A)') 'SORTFILE='//TRIM(SORTFILE)

 IF(.NOT.UTL_READINITFILE('INDIR',LINE,IU,0))RETURN
 READ(LINE,*) INDIR; WRITE(*,'(A)') 'INDIR='//TRIM(INDIR)
 
 IF(.NOT.UTL_READINITFILE('IMODE',LINE,IU,0))RETURN
 READ(LINE,*) IMODE; WRITE(*,'(A)') 'IMODE='//TRIM(ITOS(IMODE))

 SELECT CASE (IMODE)
  CASE (1)
   !##  make consistent model
  CASE (2)
   !## include iwhb maps
   IF(.NOT.UTL_READINITFILE('IWHBFILE',LINE,IU,0))RETURN
   READ(LINE,*) IWHBFILE; WRITE(*,'(A)') 'IWHBFILE='//TRIM(IWHBFILE)
   IF(.NOT.UTL_READINITFILE('IWHBDIR',LINE,IU,0))RETURN
   READ(LINE,*) IWHBDIR; WRITE(*,'(A)') 'IWHBDIR='//TRIM(IWHBDIR)
   OBSIROW=0; IF(UTL_READINITFILE('OBSIROW',LINE,IU,1))THEN
    READ(LINE,*) OBSIROW; WRITE(*,'(A)') 'OBSIROW='//TRIM(ITOS(OBSIROW))
   ENDIF
   OBSICOL=0; IF(UTL_READINITFILE('OBSICOL',LINE,IU,1))THEN
    READ(LINE,*) OBSICOL; WRITE(*,'(A)') 'OBSICOL='//TRIM(ITOS(OBSICOL))
   ENDIF
  CASE (3)
   !## aggregate
   IF(UTL_READINITFILE('IPRJ',LINE,IU,1))READ(LINE,*) IPRJ
   WRITE(*,'(A)') 'IPRJ='//TRIM(ITOS(IPRJ))
   IF(.NOT.UTL_READINITFILE('CMIN',LINE,IU,0))RETURN
   READ(LINE,*) CMIN; WRITE(*,'(A)') 'CMIN='//TRIM(RTOS(CMIN,'F',3))
 END SELECT
 
 !## output folder
 IF(.NOT.UTL_READINITFILE('OUTDIR',LINE,IU,0))RETURN
 READ(LINE,*) OUTDIR; WRITE(*,'(A)') 'OUTDIR='//TRIM(OUTDIR)

 CALL LHM_CONVERTREGIS_MAIN(OBSICOL,OBSIROW)

 END SUBROUTINE IMODBATCH_AGGREGATE
 
 !###======================================================================
 SUBROUTINE IMODBATCH_IPFEDITWEIGHT()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=256) :: IPFNAME,POINTERIDF
 INTEGER :: WCOL,IOS,I
 REAL(KIND=DP_KIND) :: PVAL,FACTOR_IN,FACTOR_OUT,X,WEIGHT
 
 !## read ini-file
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFNAME)

 NIPF=2; CALL IPFALLOCATE()
 !## read in ipf-file
 !## read twice to be able to write new ipf-file
 DO I=1,NIPF
  IPF(I)%FNAME=IPFNAME; IPF(I)%XCOL =1; IPF(I)%YCOL=2; IPF(I)%ZCOL=2; IPF(I)%Z2COL=2; IPF(I)%QCOL=2;
  IF(.NOT.IPFREAD2(I,1,1))RETURN
 ENDDO
 
 !## get column with weight factor from ipf file
 IF(.NOT.UTL_READINITFILE('WCOL',LINE,IU,0))RETURN
 READ(LINE,*) WCOL; WRITE(*,'(A,I10)') 'WCOL=',WCOL
 
 !## read in pointer-file and pointer value to be used
 !## default=1.0 for pointer value
 IF(.NOT.UTL_READINITFILE('PVAL',LINE,IU,0))RETURN
 PVAL=1.0; READ(LINE,*) PVAL; WRITE(*,'(A,F10.3)') 'PVAL=',PVAL
 IF(.NOT.UTL_READINITFILE('POINTERIDF',LINE,IU,0))RETURN
 READ(LINE,*) POINTERIDF; WRITE(*,'(A)') 'POINTERIDF='//TRIM(POINTERIDF)
 IF(.NOT.IDFREAD(IDF,POINTERIDF,0))THEN; WRITE(*,'(A)') 'Cannot read '//TRIM(POINTERIDF); STOP; ENDIF
     
 !## read factor to be applied to locations outside of pointer grid
 !## default=1.0
 IF(.NOT.UTL_READINITFILE('FACTOR_IN',LINE,IU,0))RETURN
 FACTOR_IN=1.0; READ(LINE,*) FACTOR_IN; WRITE(*,'(A,F10.3)') 'FACTOR_IN=',FACTOR_IN
 
 !## read factor to be applied to locations inside of pointer grid
 !## default=1.0
 IF(.NOT.UTL_READINITFILE('FACTOR_OUT',LINE,IU,0))RETURN
 FACTOR_OUT=1.0; READ(LINE,*) FACTOR_OUT; WRITE(*,'(A,F10.3)') 'FACTOR_OUT=',FACTOR_OUT
 
 !## main routine
 !## loop over cells in pointer idf (if not equal to nodata and equal to pval)
 DO I=1,IPF(1)%NROW
  X=IDFGETXYVAL(IDF,IPF(1)%XYZ(1,I),IPF(1)%XYZ(2,I))
  READ(IPF(2)%INFO(WCOL,I),*,IOSTAT=IOS) WEIGHT
  IF(IOS.EQ.0)THEN
   IF(X.NE.IDF%NODATA.AND.X.EQ.PVAL)THEN
    !## location lays inside pointer area
    IPF(2)%INFO(WCOL,I)=RTOS(FACTOR_IN*WEIGHT,'F',3)
   ELSE
    !## location lays outside pointer area
    IPF(2)%INFO(WCOL,I)=RTOS(FACTOR_OUT*WEIGHT,'F',3)
   ENDIF
  ELSE
   WRITE(*,*) "Column "//TRIM(ITOS(WCOL))//" does not contain a weight value. Please check your input ipf-file!"; STOP
  ENDIF
 ENDDO
 
 !## write new ipf file
 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFNAME)
 CALL UTL_CREATEDIR(IPFNAME(:INDEX(IPFNAME,'\',.TRUE.)-1))
 IPF(2)%FNAME=IPFNAME; IF(.NOT.IPFWRITE(2))THEN; ENDIF; CALL IPFDEALLOCATE()
 
 END SUBROUTINE IMODBATCH_IPFEDITWEIGHT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEIZONE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,NFORMATIONS,NLAY,IZONEOFFSET,IGROUPOFFSET
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: FIDF 
 CHARACTER(LEN=256) :: PFOLDER,OFOLDER,TPARAMETER
 REAL(KIND=DP_KIND) :: MINF
  
 IF(.NOT.UTL_READINITFILE('OFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OFOLDER; WRITE(*,'(A)') 'OFOLDER='//TRIM(OFOLDER)
 IF(.NOT.UTL_READINITFILE('PFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) PFOLDER; WRITE(*,'(A)') 'PFOLDER='//TRIM(PFOLDER)
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 IF(.NOT.UTL_READINITFILE('MINF',LINE,IU,0))RETURN
 READ(LINE,*) MINF; WRITE(*,'(A,F10.3)') 'MINF=',MINF

 IZONEOFFSET=0
 IF(UTL_READINITFILE('IZONEOFFSET',LINE,IU,1))THEN
  READ(LINE,*) IZONEOFFSET; WRITE(*,'(A,I10)') 'IZONEOFFSET=',IZONEOFFSET
 ENDIF
 IGROUPOFFSET=0
 IF(UTL_READINITFILE('IGROUPOFFSET',LINE,IU,1))THEN
  READ(LINE,*) IGROUPOFFSET; WRITE(*,'(A,I10)') 'IGROUPOFFSET=',IGROUPOFFSET
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('NFORMATIONS',LINE,IU,0))RETURN
 READ(LINE,*) NFORMATIONS; WRITE(*,'(A,I10)') 'NFORMATIONS=',NFORMATIONS
 ALLOCATE(FIDF(NFORMATIONS))
 DO I=1,NFORMATIONS
  IF(.NOT.UTL_READINITFILE('FORMATION'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) FIDF(I)
  LINE='FORMATION'//TRIM(ITOS(I))//'='//TRIM(FIDF(I)); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 IF(.NOT.UTL_READINITFILE('TPARAMETER',LINE,IU,0))RETURN
 READ(LINE,*) TPARAMETER; WRITE(*,'(A)') 'TPARAMETER='//TRIM(TPARAMETER)

 CALL CREATEIZONE_MAIN(FIDF,PFOLDER,OFOLDER,TPARAMETER,NLAY,MINF,IZONEOFFSET,IGROUPOFFSET)
 
 DEALLOCATE(FIDF)
 
 END SUBROUTINE IMODBATCH_CREATEIZONE
 
 !###======================================================================
 SUBROUTINE IMODBATCH_ASSIGNWELL()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,NFORMATIONS
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: TOPIDF,BOTIDF
 CHARACTER(LEN=256),DIMENSION(2) :: IPFFNAME
 INTEGER,DIMENSION(6) :: IXCOL
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IFCOL
 
 IPFFNAME=''
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,'(A256)') IPFFNAME(1); WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFFNAME(1))

 IXCOL(1)=1; IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) IXCOL(1)
 WRITE(*,'(A,I2)') 'IXCOL=',IXCOL(1)
 IXCOL(2)=2; IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) IXCOL(2)
 WRITE(*,'(A,I2)') 'IYCOL=',IXCOL(2)
 IXCOL(3)=3; IF(UTL_READINITFILE('IDCOL',LINE,IU,1))READ(LINE,*) IXCOL(3)
 WRITE(*,'(A,I2)') 'IDCOL=',IXCOL(3)
 IXCOL(4)=1; IF(UTL_READINITFILE('IZ1COL',LINE,IU,1))READ(LINE,*) IXCOL(4)
 WRITE(*,'(A,I2)') 'IZ1COL=',IXCOL(4)
 IXCOL(5)=1; IF(UTL_READINITFILE('IZ2COL',LINE,IU,1))READ(LINE,*) IXCOL(5)
 WRITE(*,'(A,I2)') 'IZ2COL=',IXCOL(5)

 IF(.NOT.UTL_READINITFILE('NFORMATIONS',LINE,IU,0))RETURN
 READ(LINE,*) NFORMATIONS; WRITE(*,'(A,I10)') 'NFORMATIONS=',NFORMATIONS
 ALLOCATE(IFCOL(NFORMATIONS))
 DO I=1,NFORMATIONS
  IF(.NOT.UTL_READINITFILE('FORMATION'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) IFCOL(I)
  LINE='FORMATION'//TRIM(ITOS(I))//'='//TRIM(ITOS(IFCOL(I))); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
  
 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,'(A256)') IPFFNAME(2); WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFFNAME(2))
 
 ALLOCATE(TOPIDF(NFORMATIONS),BOTIDF(NFORMATIONS))
 DO I=1,SIZE(TOPIDF); CALL IDFNULLIFY(TOPIDF(I)); ENDDO
 DO I=1,SIZE(BOTIDF); CALL IDFNULLIFY(BOTIDF(I)); ENDDO
 
 !## try to read all idf's
 DO I=1,NFORMATIONS
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) TOPIDF(I)%FNAME
  LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(TOPIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) BOTIDF(I)%FNAME
  LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(BOTIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
 ENDDO
 
 CALL IPFASSIGNWELL(IPFFNAME,TOPIDF,BOTIDF,IXCOL,IFCOL)
 
 END SUBROUTINE IMODBATCH_ASSIGNWELL

 !###======================================================================
 SUBROUTINE IMODBATCH_WVP()
 !###======================================================================
 USE MOD_SOLID_PAR, ONLY : TOPIDF,BOTIDF,CIDF,MINC,OUTPUTFOLDER,MDLIDF
 IMPLICIT NONE
 INTEGER :: NLAY,I
 
 !## number of modellayers
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
 IF(.NOT.UTL_READINITFILE('MINC',LINE,IU,0))RETURN
 READ(LINE,*) MINC; WRITE(*,'(A,F10.2)') 'MINC=',MINC
 
 ALLOCATE(TOPIDF(NLAY),BOTIDF(NLAY),CIDF(NLAY-1))
 DO I=1,SIZE(TOPIDF); CALL IDFNULLIFY(TOPIDF(I)); ENDDO
 DO I=1,SIZE(BOTIDF); CALL IDFNULLIFY(BOTIDF(I)); ENDDO
 DO I=1,SIZE(CIDF  ); CALL IDFNULLIFY(CIDF  (I)); ENDDO
 
 !## try to read all idf's
 DO I=1,NLAY
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) TOPIDF(I)%FNAME
  LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(TOPIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) BOTIDF(I)%FNAME
  LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(BOTIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  IF(I.LT.NLAY)THEN
   IF(.NOT.UTL_READINITFILE('C_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) CIDF(I)%FNAME
   LINE='C_L'//TRIM(ITOS(I))//'='//TRIM(CIDF(I)%FNAME); WRITE(*,'(A)') TRIM(LINE)
  ENDIF
 ENDDO

 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)

 MDLIDF%XMIN=0.0D0; MDLIDF%YMIN=0.0D0; MDLIDF%XMAX=0.0D0; MDLIDF%YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MDLIDF%DX; WRITE(*,'(A,F10.2)') 'CELLSIZE=',MDLIDF%DX
  MDLIDF%DY=MDLIDF%DX
 ENDIF

 IF(SOLID_WVP())THEN; ENDIF
 
 END SUBROUTINE IMODBATCH_WVP

 !###======================================================================
 SUBROUTINE IMODBATCH_SOLID()
 !###======================================================================
 USE MOD_SOLID_PAR 
 IMPLICIT NONE
 INTEGER :: IHYPO,ICKDC,I,J,FNLAY
 REAL(KIND=DP_KIND) :: ZOFFSET
 
 IWINDOW=0; HCLOSE=0.01D0; MICNVG=5; FMIDELEV=1.0D0; IBNDCHK=0; SOL_IINT_IDF=1 !## usage of top/bottom aquitards
 
 CALL SOLID_INITSLD(1)

 !## number of modellayers
 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) SLD(1)%NINT; WRITE(*,'(A,I10)') 'NLAY=',SLD(1)%NINT
 
 SLD(1)%NINT=2*SLD(1)%NINT
 CALL SOLID_INITSLDPOINTER(1,SLD(1)%NINT)

 !## try to read all idf's
 J=0
 DO I=1,SLD(1)%NINT/2
  IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  J=J+1
  READ(LINE,*) SLD(1)%INTNAME(J)
  LINE='TOP_L'//TRIM(ITOS(I))//'='//TRIM(SLD(1)%INTNAME(J)); WRITE(*,'(A)') TRIM(LINE)
  SLD(1)%ICLC(J)=0; IF(UTL_READINITFILE('ICLC_TL'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) SLD(1)%ICLC(J)
  LINE='ICLC_TL'//TRIM(ITOS(I))//'='//TRIM(ITOS(SLD(1)%ICLC(J))); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  J=J+1
  READ(LINE,*) SLD(1)%INTNAME(J) 
  LINE='BOT_L'//TRIM(ITOS(I))//'='//TRIM(SLD(1)%INTNAME(J)); WRITE(*,'(A)') TRIM(LINE)
  SLD(1)%ICLC(J)=0; IF(UTL_READINITFILE('ICLC_BL'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) SLD(1)%ICLC(J)
  LINE='ICLC_BL'//TRIM(ITOS(I))//'='//TRIM(ITOS(SLD(1)%ICLC(J))); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 CALL UTL_CREATEDIR(TRIM(OUTPUTFOLDER))
 
 MDLIDF%XMIN=0.0D0; MDLIDF%YMIN=0.0D0; MDLIDF%XMAX=0.0D0; MDLIDF%YMAX=0.0D0; IWINDOW=0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MDLIDF%XMIN,MDLIDF%YMIN,MDLIDF%XMAX,MDLIDF%YMAX
  IF(.NOT.UTL_READINITFILE('CELLSIZE',LINE,IU,0))RETURN
  READ(LINE,*) MDLIDF%DX; WRITE(*,'(A,F10.2)') 'CELLSIZE=',MDLIDF%DX
  IWINDOW=1; MDLIDF%DY=MDLIDF%DX
 ENDIF

 IF(.NOT.UTL_READINITFILE('IMASK',LINE,IU,0))RETURN; READ(LINE,*) IMASK
 IF(.NOT.UTL_READINITFILE('IHYPO',LINE,IU,0))RETURN; READ(LINE,*) IHYPO
 IF(.NOT.UTL_READINITFILE('ICKDC',LINE,IU,0))RETURN; READ(LINE,*) ICKDC

 WRITE(*,'(A,I10)')   'IMASK='   ,IMASK
 WRITE(*,'(A,I10)')   'IHYPO='   ,IHYPO
 WRITE(*,'(A,I10)')   'ICKDC='   ,ICKDC

 IF(IMASK.EQ.1)THEN
  IF(.NOT.UTL_READINITFILE('ZOFFSET',LINE,IU,0))RETURN
  READ(LINE,*) ZOFFSET; WRITE(*,'(A,F10.2)') 'ZOFFSET=',ZOFFSET
 ENDIF
 
 IF(ICKDC.EQ.1)THEN
  
  IF(UTL_READINITFILE('FNLAY',LINE,IU,1))THEN
   READ(LINE,*) FNLAY; WRITE(*,'(A,I10)') 'FNLAY=',FNLAY
   ALLOCATE(REGISFILES_TOP(FNLAY),REGISFILES_BOT(FNLAY),REGISFILES_KHV(FNLAY),REGISFILES_KVV(FNLAY))
   REGISFILES_TOP=''; REGISFILES_BOT=''; REGISFILES_KHV=''; REGISFILES_KVV=''
   DO I=1,FNLAY
    !## read top formation
    IF(.NOT.UTL_READINITFILE('FTOP_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
    READ(LINE,*) REGISFILES_TOP(I)
    LINE='FTOP_L'//TRIM(ITOS(I))//'='//TRIM(REGISFILES_TOP(I)); WRITE(*,'(A)') TRIM(LINE)
    !## read bot formation
    IF(.NOT.UTL_READINITFILE('FBOT_L'//TRIM(ITOS(I)),LINE,IU,0))RETURN
    READ(LINE,*) REGISFILES_BOT(I)
    LINE='FBOT_L'//TRIM(ITOS(I))//'='//TRIM(REGISFILES_BOT(I)); WRITE(*,'(A)') TRIM(LINE)
    !## read optional khv formation
    IF(UTL_READINITFILE('FKHV_L'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) REGISFILES_KHV(I)
    LINE='FKHV_L'//TRIM(ITOS(I))//'='//TRIM(REGISFILES_KHV(I)); WRITE(*,'(A)') TRIM(LINE)
    !## read optional kvv formation
    IF(UTL_READINITFILE('FKVV_L'//TRIM(ITOS(I)),LINE,IU,1))READ(LINE,*) REGISFILES_KVV(I)
    LINE='FKVV_L'//TRIM(ITOS(I))//'='//TRIM(REGISFILES_KVV(I)); WRITE(*,'(A)') TRIM(LINE)
   ENDDO

  ELSE

   !## use wildcards
   IF(.NOT.UTL_READINITFILE('FOLDERTOP',LINE,IU,0))RETURN
   READ(LINE,*) REGISTOP; WRITE(*,'(A)') 'FOLDERTOP='//TRIM(REGISTOP)
   IF(.NOT.UTL_READINITFILE('FOLDERBOT',LINE,IU,0))RETURN
   READ(LINE,*) REGISBOT; WRITE(*,'(A)') 'FOLDERBOT='//TRIM(REGISBOT)
   IF(.NOT.UTL_READINITFILE('FOLDERKHV',LINE,IU,0))RETURN
   READ(LINE,*) REGISKHV; WRITE(*,'(A)') 'FOLDERKHV='//TRIM(REGISKHV)
   IF(.NOT.UTL_READINITFILE('FOLDERKVV',LINE,IU,0))RETURN
   READ(LINE,*) REGISKVV; WRITE(*,'(A)') 'FOLDERKVV='//TRIM(REGISKVV)

  ENDIF
 ENDIF 

 IF(IHYPO.EQ.1)THEN

  ALLOCATE(DZ(SLD(1)%NINT)); DZ=0.0D0
  IF(UTL_READINITFILE('DZ',LINE,IU,0))READ(LINE,*) DZ(1:SLD(1)%NINT/2)
  WRITE(*,'(99F8.2)') DZ(1:SLD(1)%NINT/2)
  !## copy dz for each interface
  DO I=SLD(1)%NINT,1,-2
   DZ(I)  =DZ(I/2) 
   DZ(I-1)=0.0D0
  ENDDO

  !## try to go through the mid
  IF(UTL_READINITFILE('IMIDELEV',LINE,IU,1))READ(LINE,*) FMIDELEV
  WRITE(*,'(A,F10.2)') 'IMIDELEV=',FMIDELEV
  !## include top/bottom in interpolation
  IF(UTL_READINITFILE('IINT_IDF',LINE,IU,1))READ(LINE,*) SOL_IINT_IDF
  WRITE(*,'(A,I1)') 'IINT_IDF=',SOL_IINT_IDF
  !## check isolated boundary cells
  IF(UTL_READINITFILE('IBNDCHK',LINE,IU,1))READ(LINE,*) IBNDCHK
  WRITE(*,'(A,I1)') 'IBNDCHK=',IBNDCHK
  !## hclosure criterium
  IF(UTL_READINITFILE('HCLOSE',LINE,IU,1))READ(LINE,*) HCLOSE
  WRITE(*,'(A,F15.7)') 'HCLOSE=',HCLOSE
  !## max. inner convergences
  IF(UTL_READINITFILE('MICNVG',LINE,IU,1))READ(LINE,*) MICNVG
  WRITE(*,'(A,I10)') 'MICNVG=',MICNVG

  NGENSOL=0; IF(UTL_READINITFILE('NGEN',LINE,IU,1))READ(LINE,*) NGENSOL
  WRITE(*,'(A,I10)') 'NGEN=',NGENSOL
  IF(NGENSOL.GT.0)THEN
   ALLOCATE(GENSOL(NGENSOL))
   DO I=1,NGENSOL
    IF(.NOT.UTL_READINITFILE('GEN_FNAME_'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) GENSOL(I)%FNAME
    LINE='GEN_FNAME_'//TRIM(ITOS(I))//'='//TRIM(GENSOL(I)%FNAME)
    WRITE(*,'(A)') TRIM(LINE)
    IF(.NOT.UTL_READINITFILE('GEN_LAYER_'//TRIM(ITOS(I)),LINE,IU,0))RETURN; READ(LINE,*) GENSOL(I)%ILAY
    LINE='GEN_LAYER_'//TRIM(ITOS(I))//'='//TRIM(ITOS(GENSOL(I)%ILAY))
    WRITE(*,'(A)') TRIM(LINE)
   ENDDO
  ENDIF
  
 ENDIF
 
 IBATCH=1
 !## compute masks
 IF(IMASK.EQ.1)THEN
  IF(.NOT.SOLID_NEWMASKS(ZOFFSET))RETURN
 ENDIF
 !## compute solid
 IF(IHYPO.EQ.1)CALL SOLID_CALC_HYPO()
 !## compute kd/c
 IF(ICKDC.EQ.1)THEN
  IF(.NOT.SOLID_CALC_KDC(IHYPO))THEN; ENDIF
  CALL SOLID_CALC_KDC_DEALLOCATE()
 ENDIF
 IF(ASSOCIATED(REGISFILES_TOP))DEALLOCATE(REGISFILES_TOP)
 IF(ASSOCIATED(REGISFILES_BOT))DEALLOCATE(REGISFILES_BOT)
 IF(ASSOCIATED(REGISFILES_KHV))DEALLOCATE(REGISFILES_KHV)
 IF(ASSOCIATED(REGISFILES_KVV))DEALLOCATE(REGISFILES_KVV)
 IF(ALLOCATED(DZ))DEALLOCATE(DZ)
 
 END SUBROUTINE IMODBATCH_SOLID

 !###======================================================================
 SUBROUTINE IMODBATCH_MODELCOPY_MAIN()
 !###======================================================================
 USE MOD_MODEL_PAR, ONLY : RUNFILE,RESDIR,SIMBOX,CLIPDIR,SIMCSIZE
 IMPLICIT NONE

 IF(.NOT.UTL_READINITFILE('RUNFILE',LINE,IU,0))RETURN
 READ(LINE,*) RUNFILE; WRITE(*,'(A)') 'RUNFILE='//TRIM(RUNFILE)
 IF(.NOT.UTL_READINITFILE('TARGETDIR',LINE,IU,0))RETURN
 READ(LINE,*) RESDIR; WRITE(*,'(A)') 'TARGETDIR='//TRIM(RESDIR)
 SIMBOX=0.0D0; SIMCSIZE=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) SIMBOX(1),SIMBOX(2),SIMBOX(3),SIMBOX(4)
  WRITE(*,'(A,4F10.2)') 'WINDOW=',SIMBOX(1),SIMBOX(2),SIMBOX(3),SIMBOX(4)
  IF(.NOT.UTL_READINITFILE('CELL_SIZE',LINE,IU,0))RETURN
  READ(LINE,*) SIMCSIZE; WRITE(*,'(A,F10.2)') 'CELL_SIZE=',SIMCSIZE
  IF(SIMCSIZE.LE.0.0D0)STOP 'SIMCSIZE NEED TO BE LARGER THAN ZERO !'
 ENDIF
 CLIPDIR=''
 IF(UTL_READINITFILE('CLIPDIR',LINE,IU,1))THEN
  READ(LINE,*) CLIPDIR; WRITE(*,'(A)') 'CLIPDIR='//TRIM(CLIPDIR)
 ENDIF

 CALL MODEL1COPYRUNFILE(1)
 CALL IPFDEALLOCATE()

 END SUBROUTINE IMODBATCH_MODELCOPY_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IPFSTAT_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IPFNAME_IN,IPFNAME_OUT,FNAME,DIR
 INTEGER :: I,J,JJ,KU,JU,LU,NVARS,MINMEASURE,M,N,NPERC,ITXTFILE,IC
 INTEGER(KIND=SP_KIND) :: SDATE,EDATE,NGXG,DIFFDAY,ICLUSTER,WCOLUMN,NW,IACOL
 INTEGER,POINTER,DIMENSION(:) :: IVARS
 REAL(KIND=DP_KIND) :: X,GHG,GLG,NODATA,W,TW
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: MSR
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: PERC
 INTEGER,ALLOCATABLE,DIMENSION(:) :: JDT,JDP,ILIST
 CHARACTER(LEN=3),DIMENSION(5) :: CVARS
 DATA CVARS/'MIN','MAX','AVG','GXG','PER'/
 TYPE(IDFOBJ) :: SURFACELEVEL
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XPERC
 
 MINMEASURE=24; DIFFDAY=5; NODATA=-999.99D0; ICLUSTER=0; ITXTFILE=0; RANGE=0.0D0; WCOLUMN=0;IACOL=2
 
 IF(.NOT.UTL_READINITFILE('IPFFILE_IN',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME_IN; WRITE(*,'(A)') 'IPFFILE_IN='//TRIM(IPFNAME_IN)
 DIR=IPFNAME_IN(:INDEX(IPFNAME_IN,'\',.TRUE.)-1)

 IF(.NOT.UTL_READINITFILE('IPFFILE_OUT',LINE,IU,0))RETURN
 READ(LINE,*) IPFNAME_OUT; WRITE(*,'(A)') 'IPFFILE_OUT='//TRIM(IPFNAME_OUT)

 IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
 READ(LINE,*) SDATE; WRITE(*,'(A)') 'SDATE='//TRIM(ITOS(SDATE))
 IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
 READ(LINE,*) EDATE; WRITE(*,'(A)') 'EDATE='//TRIM(ITOS(EDATE))
 SDATE=UTL_IDATETOJDATE(SDATE); EDATE=UTL_IDATETOJDATE(EDATE)

 IF(UTL_READINITFILE('ICLUSTER',LINE,IU,1))READ(LINE,*) ICLUSTER
 WRITE(*,'(A)') 'ICLUSTER='//TRIM(ITOS(ICLUSTER))
 IF(ICLUSTER.EQ.1)THEN
  IF(UTL_READINITFILE('RANGE',LINE,IU,1))READ(LINE,*) RANGE
  WRITE(*,'(A)') 'RANGE='//TRIM(RTOS(RANGE,'F',3))
  IF(UTL_READINITFILE('IWCOL',LINE,IU,1))READ(LINE,*) WCOLUMN
  WRITE(*,'(A)') 'IWCOL='//TRIM(ITOS(WCOLUMN))
 ENDIF
 IF(UTL_READINITFILE('IACOL',LINE,IU,1))READ(LINE,*) IACOL 
 WRITE(*,'(A)') 'IACOL='//TRIM(ITOS(IACOL))
 IF(IACOL.LE.1)THEN; WRITE(*,'(A)')'It is not allowed to use IACOL=1 for processing'; STOP; ENDIF

 IF(.NOT.UTL_READPOINTER(IU,NVARS,IVARS,'IVARS',0))RETURN
 DO I=1,NVARS; WRITE(*,'(1X,I3,A4)') I,','//CVARS(I); ENDDO
 
 !## check for duplicates for ivars
 DO I=1,NVARS
  J=IVARS(I)
  DO JJ=I+1,NVARS
   IF(IVARS(I).EQ.IVARS(JJ))THEN; WRITE(*,'(A)') 'Duplicate IVARS='//TRIM(ITOS(IVARS(I)))//' given'; STOP; ENDIF
  ENDDO
 ENDDO
 
 NGXG=0; NPERC=0
 DO I=1,NVARS
  IF(IVARS(I).EQ.5)THEN
   IF(.NOT.UTL_READPOINTER_REAL(IU,NPERC,PERC,'PERC',0,EXCLVALUE=-999.99D0))RETURN
   DO J=1,SIZE(PERC)
    IF(PERC(J).LT.0.0D0.OR.PERC(J).GT.100.0D0)THEN
     LINE='PERC('//TRIM(ITOS(J))//')='//TRIM(RTOS(PERC(J),'F',3)); WRITE(*,'(A)') TRIM(LINE)//' which is not allowed'; STOP
    ENDIF
   ENDDO
   ALLOCATE(XPERC(NPERC),JDP(0:NPERC)); XPERC=0.0D0; JDP=0
   IF(UTL_READINITFILE('ITXTFILE',LINE,IU,1))THEN
    READ(LINE,*) ITXTFILE; WRITE(*,'(A)') 'ITXTFILE='//TRIM(ITOS(ITXTFILE))
   ENDIF
   JDP(0)=JD(2000,12,31); DO J=1,NPERC; JDP(J)=JDP(J-1)+INT(PERC(J)); ENDDO
  ELSEIF(IVARS(I).EQ.4)THEN
   NGXG=NGXG+1
   IF(UTL_READINITFILE('SURFACELEVEL',LINE,IU,1))THEN
    READ(LINE,*) SURFACELEVEL%FNAME; WRITE(*,'(A)') 'SURFACELEVEL=',TRIM(SURFACELEVEL%FNAME)
   ENDIF
   IF(UTL_READINITFILE('MINMEASURE',LINE,IU,1))READ(LINE,*) MINMEASURE
   WRITE(*,'(A)') 'MINMEASURE='//TRIM(ITOS(MINMEASURE))
   IF(UTL_READINITFILE('DIFFDAY',LINE,IU,1))READ(LINE,*) DIFFDAY
   WRITE(*,'(A)') 'DIFFDAY='//TRIM(ITOS(DIFFDAY))
  ENDIF
 ENDDO
 
 NIPF=1; CALL IPFALLOCATE(); IPF(1)%FNAME=IPFNAME_IN
 IPF(1)%XCOL =1; IPF(1)%YCOL=2; IPF(1)%ZCOL=2; IPF(1)%Z2COL=2; IPF(1)%QCOL=2
 IF(.NOT.IPFREAD2(1,1,1))RETURN
 
 !## open new file
 JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFNAME_OUT,STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(JU,*) IPF(1)%NROW
 
 N=IPF(1)%NCOL+NVARS+1+NGXG; IF(NPERC.GT.1)N=N+(NPERC-1)
 WRITE(JU,*) N

 DO I=1,IPF(1)%NCOL; WRITE(JU,'(A)') TRIM(IPF(1)%ATTRIB(I)); ENDDO
 DO I=1,NVARS
  SELECT CASE (IVARS(I))
   CASE(4)
    WRITE(JU,'(A)') 'GHG'; WRITE(JU,'(A)') 'GLG'
   CASE(5)
    DO JJ=1,NPERC; WRITE(JU,'(A)') 'P'//TRIM(RTOS(PERC(JJ),'F',3)); ENDDO
   CASE DEFAULT
    WRITE(JU,'(A)') TRIM(CVARS(I))
  END SELECT
 ENDDO
 IF(ICLUSTER.EQ.0)WRITE(JU,'(A)') 'N'
 IF(ICLUSTER.GE.1)WRITE(JU,'(A)') 'WEIGHT'
 WRITE(JU,*) IPF(1)%ACOL,','//TRIM(IPF(1)%FEXT) 
 
 !## store each drill in memory for picking purposes
 CALL IPFASSFILEALLOCATE(1)

 !## proces locations
 DO I=1,IPF(1)%NROW 
  !## read dimensions of associated file
  FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
  IF(IPFOPENASSFILE(KU,1,FNAME))THEN
   !## raise error if iacol > then amount of columns available in associated text-file and stop loop
   IF(IACOL.GT.ASSF(1)%NCASS)THEN; WRITE(*,*) 'Error: IACOL ('//TRIM(ITOS(IACOL))//') > the amount of available columns ('//TRIM(ITOS(ASSF(1)%NCASS))//') in associated text files'; RETURN; ENDIF
   !## not measurements found
   IF(ASSF(1)%ITOPIC.NE.1)CYCLE
   IF(IPFREADASSFILELABEL(KU,1,FNAME).AND.IPFREADASSFILE(KU,1,FNAME))THEN
    !## look for overlapping dates
    ALLOCATE(JDT(ASSF(1)%NRASS),MSR(ASSF(1)%NRASS))
    N=0
    DO JJ=1,ASSF(1)%NRASS
     IF(ASSF(1)%IDATE(JJ).GE.SDATE.AND.ASSF(1)%IDATE(JJ).LE.EDATE)THEN
      IF(ASSF(1)%MEASURE(IACOL-1,JJ) .NE.ASSF(1)%NODATA(2))THEN
       N=N+1
       JDT(N)=ASSF(1)%IDATE(JJ)
       MSR(N)=ASSF(1)%MEASURE(IACOL-1,JJ)
      ENDIF
     ENDIF
    ENDDO
    !## process statistics
    LINE=''
    DO J=1,NVARS
     IF(N.EQ.0)THEN
      X=NODATA
      SELECT CASE (IVARS(J))
       !## gxg
       CASE (4)
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
       !## perc
       CASE (5)
        DO JJ=1,NPERC; LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3)); ENDDO 
        !## write txt file
        IF(ITXTFILE.EQ.1)THEN
         FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'_PERCENTILES.'//TRIM(ADJUSTL(IPF(1)%FEXT))
         LU=UTL_GETUNIT(); OPEN(LU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
         WRITE(LU,'(A)') '0'
         WRITE(LU,'(A)') '2,1'
         WRITE(LU,'(A)') 'DATE,-999.99'
         WRITE(LU,'(A)') 'OBS,-999.99'
         CLOSE(LU)
        ENDIF
       CASE DEFAULT
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
      END SELECT
     ELSE
      SELECT CASE (IVARS(J))
       !## min
       CASE (1)
        X=HUGE(1.0D0); DO JJ=1,N; X=MIN(X,MSR(JJ)); ENDDO;
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
       !## max
       CASE (2)
        X=-1.0D0*HUGE(1.0D0); DO JJ=1,N; X=MAX(X,MSR(JJ)); ENDDO;
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
       !## avg
       CASE (3)
        X=0.0D0; DO JJ=1,N; X=X+MSR(JJ); ENDDO; X=X/REAL(N,8)
        LINE=TRIM(LINE)//','//TRIM(RTOS(X,'F',3))
       !## gxg
       CASE (4)
        CALL GXG_COMPUTE_SERIE(JDT(:N),MSR(:N),GHG,GLG,MINMEASURE,DIFFDAY,NODATA)
        LINE=TRIM(LINE)//','//TRIM(RTOS(GHG,'F',3))
        LINE=TRIM(LINE)//','//TRIM(RTOS(GLG,'F',3))
       !## per
       CASE (5)
        CALL UTL_GETMED(MSR,N,-999.99D0,PERC,NPERC,M,XPERC)
        DO JJ=1,NPERC; LINE=TRIM(LINE)//','//TRIM(RTOS(XPERC(JJ),'F',3)); ENDDO
        !## write txt file
        IF(ITXTFILE.EQ.1)THEN
         FNAME=TRIM(DIR)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'_PERCENTILES.'//TRIM(ADJUSTL(IPF(1)%FEXT))
         LU=UTL_GETUNIT(); OPEN(LU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
         WRITE(LU,'(I10)') NPERC
         WRITE(LU,'(A)') '2,1'
         WRITE(LU,'(A)') 'DATE,-999.99'
         WRITE(LU,'(A)') 'OBS,-999.99'
         DO JJ=1,NPERC
          WRITE(LU,'(A,F15.3)') JDATETOGDATE(JDP(JJ),2),XPERC(JJ)
         ENDDO
         CLOSE(LU)
        ENDIF
      END SELECT
     ENDIF
    ENDDO
    IF(ICLUSTER.EQ.0)THEN
     LINE=TRIM(LINE)//','//TRIM(ITOS(N))
    ELSE
     W=SQRT(REAL(N,8))
     LINE=TRIM(LINE)//','//TRIM(RTOS(W,'G',7))
    ENDIF
    IF(ITXTFILE.EQ.1)IPF(1)%INFO(IPF(1)%ACOL,I)=TRIM(IPF(1)%INFO(IPF(1)%ACOL,I))//'_PERCENTILES'
    WRITE(JU,'(99A)') ('"'//TRIM(IPF(1)%INFO(J,I))//'",',J=1,IPF(1)%NCOL-1),'"'//TRIM(IPF(1)%INFO(IPF(1)%NCOL,I))//'"',TRIM(LINE)
    DEALLOCATE(JDT,MSR)
   ENDIF
   CLOSE(KU)
  ELSE
   WRITE(*,'(A)') 'Cannot open '//TRIM(FNAME); PAUSE
  ENDIF
  WRITE(6,'(A)') '+Progress '//TRIM(RTOS(REAL(I,8)/REAL(IPF(1)%NROW,8)*100.D0,'F',3))//' %              '
 ENDDO
 IF(ALLOCATED(JDP))DEALLOCATE(JDP); IF(ALLOCATED(XPERC))DEALLOCATE(XPERC); IF(ASSOCIATED(PERC))DEALLOCATE(PERC)
 CLOSE(JU)
 
 IF(ICLUSTER.EQ.1)THEN
  !## reread file
  NIPF=1; CALL IPFALLOCATE(); IPF(1)%FNAME=IPFNAME_OUT
  IPF(1)%XCOL =1; IPF(1)%YCOL=2; IPF(1)%ZCOL=2; IPF(1)%Z2COL=2; IPF(1)%QCOL=2;
  IF(.NOT.IPFREAD2(1,1,1))RETURN
  ALLOCATE(ILIST(IPF(1)%NROW)); ILIST=0
  
  IF(WCOLUMN.EQ.0)WCOLUMN=IPF(1)%NCOL
  
  DO
   M=0; IC=0; DO I=1,IPF(1)%NROW
    IF(ILIST(I).EQ.1)CYCLE
     N=0; DO J=1,IPF(1)%NROW
     IF(ILIST(J).EQ.1)CYCLE
     IF(UTL_DIST(IPF(1)%XYZ(1,I),IPF(1)%XYZ(2,I),IPF(1)%XYZ(1,J),IPF(1)%XYZ(2,J)).LE.RANGE)THEN
      N=N+1
     ENDIF
    ENDDO
    IF(N.GT.M)THEN; M=N; IC=I; ENDIF
   ENDDO
   !## finished
   IF(IC.EQ.0)EXIT
   !## set clusters for ic
   TW=0.0D0; NW=0
   DO J=1,IPF(1)%NROW
    IF(ILIST(J).EQ.1)CYCLE
    IF(UTL_DIST(IPF(1)%XYZ(1,IC),IPF(1)%XYZ(2,IC),IPF(1)%XYZ(1,J),IPF(1)%XYZ(2,J)).LE.RANGE)THEN
     ILIST(J)=2
     READ(IPF(1)%INFO(WCOLUMN,J),*) W
     TW=TW+W
     NW=NW+1
    ENDIF
   ENDDO
   NW=MAX(NW,1)
   DO J=1,IPF(1)%NROW
    !## incurrent cycle
    IF(ILIST(J).EQ.2)THEN
     READ(IPF(1)%INFO(WCOLUMN,J),*) W
     W=W/REAL(NW,8)
     WRITE(IPF(1)%INFO(WCOLUMN,J),*) W
     ILIST(J)=1
    ENDIF
   ENDDO
  ENDDO
  
  DEALLOCATE(ILIST)
  IPF(1)%FNAME=IPFNAME_OUT(:INDEX(IPFNAME_OUT,'.',.TRUE.)-1)//'_CLUSTER.IPF'
  IF(.NOT.IPFWRITE(1))RETURN
 ENDIF
 
 END SUBROUTINE IMODBATCH_IPFSTAT_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFMEAN_MAIN()
 !###======================================================================
 USE MOD_MEAN_PAR
 IMPLICIT NONE
 INTEGER :: I,J,N,SY,EY

 IBATCH=1; MEAN_FYR=0; MEAN_TYR=0
 
 !## read mean ilay (optional)
 IF(.NOT.UTL_READPOINTER(IU,MEAN_NLAYER,MEAN_ILAYER,'ILAYER',1))THEN; ENDIF
 !## if layer specified, SDATE and EDATE are obliged
 IF(MEAN_NLAYER.GT.0)THEN
  !## read start date (optional)
  IF(.NOT.UTL_READINITFILE('SDATE',LINE,IU,0))RETURN
  READ(LINE,*) MEAN_FYR; WRITE(*,'(A,I8)') 'SDATE=',MEAN_FYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') SY
  !## read end date (obliged)
  IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
  READ(LINE,*) MEAN_TYR; WRITE(*,'(A,I8)') 'EDATE=',MEAN_TYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') EY
  IF(.NOT.IMODBATH_READYEAR(MEAN_NYEAR,MEAN_IYEAR,SYEAR=SY,EYEAR=EY))RETURN
  IF(.NOT.IMODBATH_READPERIOD(MEAN_NPERIOD,MEAN_IPERIOD))RETURN
 ENDIF

 ! Read ISEL parameter
 IF(.NOT.IMODBATCH_AREAINFO(MEAN_ISEL,MEAN_IDFNAME,MEAN_GENFNAME))RETURN

 CFUNC='MEAN'   ! default function
 IF(UTL_READINITFILE('CFUNC',LINE,IU,1))READ(LINE,*) CFUNC
 CFUNC=UTL_CAP(CFUNC,'U')
 SELECT CASE (TRIM(CFUNC))
  CASE('MIN','MAX','MEAN','SUM')
  CASE('PERC')
   IF(.NOT.UTL_READINITFILE('PERCVALUE',LINE,IU,0))RETURN
   READ(LINE,*) PERCVALUE; WRITE(*,'(A,F8.4)') 'PERCVALUE=',PERCVALUE   
  CASE DEFAULT
   WRITE(*,'(A)') 'CFUNC should be equal to MEAN,MIN,MAX,SUM,PERC'; STOP
 END SELECT
 WRITE(*,'(A)') 'CFUNC='//TRIM(CFUNC)
 
 IF(.NOT.UTL_READINITFILE('NDIR',LINE,IU,0))RETURN
 READ(LINE,*) N; WRITE(*,'(A,I4)') 'NDIR=',N

 !## read output file name to overrule default names (optional)
 MEAN_OUTFILE=""
 IF(UTL_READINITFILE('OUTFILE',LINE,IU,1))READ(LINE,*) MEAN_OUTFILE
 IF(LEN_TRIM(MEAN_OUTFILE).GT.0) MEAN_OUTFILE=MEAN_OUTFILE(:INDEX(MEAN_OUTFILE,'.',.TRUE.)-1)

 ALLOCATE(MEAN_FMEAN(MAX(1,MEAN_NLAYER)),MEAN_FTOTAL(MAX(1,MEAN_NLAYER)))
 DO I=1,N
  !## read idfname
  IF(.NOT.UTL_READINITFILE('SOURCEDIR'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) MEAN_RESDIR
  IF(MEAN_NLAYER.GT.0)THEN
   !## remove "*" and "." if beyond "\" - in case sdate/edate/ilay will be used
   J=INDEX(MEAN_RESDIR,'\',.TRUE.)
   IF(INDEX(MEAN_RESDIR,'*',.TRUE.).GT.J)MEAN_RESDIR=MEAN_RESDIR(:INDEX(MEAN_RESDIR,'*',.TRUE.)-1)
   IF(INDEX(MEAN_RESDIR,'.',.TRUE.).GT.J)MEAN_RESDIR=MEAN_RESDIR(:INDEX(MEAN_RESDIR,'.',.TRUE.)-1)
  ENDIF
  LINE='SOURCEDIR'//TRIM(ITOS(I))//'='; WRITE(*,'(A)') TRIM(LINE)//TRIM(MEAN_RESDIR)
  !## start computing
  IF(.NOT.MEAN1COMPUTE())THEN
  ENDIF
 END DO

 CALL MEAN1ABORT()
 IF(ALLOCATED(MEAN_FTOTAL))DEALLOCATE(MEAN_FTOTAL)
 IF(ALLOCATED(MEAN_FMEAN))DEALLOCATE(MEAN_FMEAN)
 IF(ASSOCIATED(MEAN_IPERIOD))DEALLOCATE(MEAN_IPERIOD)
 IF(ASSOCIATED(MEAN_IYEAR))DEALLOCATE(MEAN_IYEAR)
 IF(ASSOCIATED(MEAN_ILAYER))DEALLOCATE(MEAN_ILAYER)

 END SUBROUTINE IMODBATCH_IDFMEAN_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_WBALANCE_MAIN()
 !###======================================================================
 USE MOD_WBAL_PAR
 USE IMODVAR, ONLY : DP_KIND,SP_KIND 
 IMPLICIT NONE
 INTEGER :: I,J,K,N,SY,EY,NBAL,IOPT
 CHARACTER(LEN=256) :: FNAME,DIR,OUTPUTFNAME
 
 IBATCH=1
 !## default no exchange fluxes
 WBAL_WBEX=0
 
 !## all off
 TP%IACT=0
 DO I=1,SIZE(TP)
  TP(I)%NSYS=1
  ALLOCATE(TP(I)%ISYS(1)); TP(I)%ISYS=0
 ENDDO
 
 !## check whether the function need to be used for plotting purposes
 IF(UTL_READINITFILE('CSVFNAME',LINE,IU,1))THEN

  READ(LINE,*) FNAME; WRITE(*,'(A)') 'CSVFNAME='//TRIM(FNAME)
  !## imod need to read the csv first to continue
  WRITE(*,'(A)') 'Reading the CSV file ...'

  CALL WINDOWOPEN(FLAGS=SYSMENUON+HIDEWINDOW+STATUSBAR)
  CALL WINDOWSTATUSBARPARTS(4,(/2000,2000,750,-1/),(/1,1,1,1/))
  CALL WMENU(ID_MAINMENU1,0)
  CALL WMENUTOOLBAR(ID_TOOLBAR1,0,1)
  CALL IGRCOLOURMODEL(24)
  CALL PREFCOLOURSINIT(.FALSE.)

  !## read the file - stop if there is a problem - fill in the dialog (in the back)
  CALL WBAL_ANALYSE_INIT(FNAME,1)
 
  IF(WBAL_ANALYSE_READCONFIG(IU,1,IOPT))THEN
   CALL UTL_CREATEDIR(DIR)
   IF(IOPT.EQ.4)THEN
    IF(.NOT.UTL_READINITFILE('OUTPUTFNAME',LINE,IU,0))RETURN
    READ(LINE,*) OUTPUTFNAME; WRITE(*,'(A)') 'OUTPUTFNAME='//TRIM(OUTPUTFNAME)
    !## imod need to read the csv first to continue
    WRITE(*,'(A)') 'Reading the CSV file ...'
   ENDIF
   CALL WBAL_ANALYSE_PLOT(ID_GRAPHICS,1,OUTPUTFNAME)
  ENDIF
  
  RETURN
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('NBAL',LINE,IU,0))RETURN
 READ(LINE,*) NBAL; WRITE(*,'(A,I4)') 'NBAL=',NBAL
 IF(NBAL.LE.0)STOP 'NBAL SHOULD BE > 0!'
 ALLOCATE(WCTP(NBAL)); WCTP%NSYS=0
 DO I=1,NBAL
  IF(.NOT.UTL_READINITFILE('BAL'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) WCTP(I)%BDGNAME;
  !## make them capitals
  WCTP(I)%BDGNAME=UTL_CAP(WCTP(I)%BDGNAME,'U')
  LINE='BAL'//TRIM(ITOS(I))//'='//TRIM(WCTP(I)%BDGNAME) 
  WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READPOINTER(IU,WCTP(I)%NSYS,WCTP(I)%ISYS,'BAL'//TRIM(ITOS(I))//'ISYS',1))RETURN
  IF(WCTP(I)%NSYS.EQ.0)THEN
   WCTP(I)%NSYS=1
   LINE='- no system notation applied'; WRITE(*,'(A)') TRIM(LINE)
  ELSE
   LINE='- systems'
   DO K=1,WCTP(I)%NSYS; LINE=TRIM(LINE)//', '//TRIM(ITOS(WCTP(I)%ISYS(K))); ENDDO; WRITE(*,'(A)') TRIM(LINE)
  ENDIF
 ENDDO

 WBAL_ISTEADY=1
 !## read start date (optional
 IF(UTL_READINITFILE('SDATE',LINE,IU,1))THEN
  READ(LINE,*) WBAL_FYR; IF(WBAL_FYR.LT.99999999)WBAL_FYR=WBAL_FYR*1000000
  WRITE(*,'(A,I16)') 'SDATE=',WBAL_FYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') SY

  !## read end date
  IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
  READ(LINE,*) WBAL_TYR; IF(WBAL_TYR.LT.99999999)WBAL_TYR=WBAL_TYR*1000000
  WRITE(*,'(A,I16)') 'EDATE=',WBAL_TYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') EY

  IF(.NOT.IMODBATH_READYEAR(WBAL_NYEAR,WBAL_IYEAR,SYEAR=SY,EYEAR=EY))RETURN
  IF(.NOT.IMODBATH_READPERIOD(WBAL_NPERIOD,WBAL_IPERIOD))RETURN
  WBAL_ISTEADY=0
 ELSE
  WRITE(*,'(/1A/)') 'COMPUTING WATERBALANCE FOR STEADY-STATE SIMULATION'
 ENDIF

 IF(.NOT.UTL_READPOINTER(IU,WBAL_NLAYER,WBAL_ILAYER,'ILAYER',0))RETURN
 !## make sure layers are not defined multiple times
 DO I=1,WBAL_NLAYER
  N=0; J=WBAL_ILAYER(I)
  DO K=1,WBAL_NLAYER
   IF(WBAL_ILAYER(K).EQ.J)N=N+1
  ENDDO
  IF(N.GT.1)THEN
   WRITE(*,'(/1X,A,I3,A)') 'Layer ',J,' defined more than once'; STOP
  ENDIF
 ENDDO
 IF(.NOT.IMODBATCH_AREAINFO(WBAL_ISEL,WBAL_IDFNAME,WBAL_GENFNAME))RETURN

 IF(UTL_READINITFILE('WBEX',LINE,IU,1))READ(LINE,*) WBAL_WBEX
 WRITE(*,'(A,I1)') 'WBEX=',WBAL_WBEX

 IF(.NOT.UTL_READINITFILE('NDIR',LINE,IU,0))RETURN
 READ(LINE,*) N; WRITE(*,'(A,I4)') 'NDIR=',N

 DO I=1,N
  !## read idfname
  IF(.NOT.UTL_READINITFILE('SOURCEDIR'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) WBAL_RESDIR
  LINE='SOURCEDIR'//TRIM(ITOS(I))//'='
  WRITE(*,'(A)') TRIM(LINE)//TRIM(WBAL_RESDIR)

  IF(.NOT.UTL_READINITFILE('OUTPUTNAME'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) WBAL_OUTFNAME
  LINE='OUTPUTNAME'//TRIM(ITOS(I))//'='
  WRITE(*,'(A)') TRIM(LINE)//TRIM(WBAL_OUTFNAME)

  IF(.NOT.WBALCOMPUTE())THEN; ENDIF

  WRITE(*,'(/A)') 'Successfully completed waterbalance, results written in:'
  WRITE(*,'(A/)') TRIM(WBAL_OUTFNAME)

 END DO

 !## release waterbalance-related memory again
 CALL WBALABORT()

 END SUBROUTINE IMODBATCH_WBALANCE_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IDFSTAT_MAIN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IOS,I,N,JU,IFORMAT
 CHARACTER(LEN=256) :: SOURCEDIR,OUTFILE,ROOT
 CHARACTER(LEN=1000) :: STRING
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: IDFNAMES
 CHARACTER(LEN=50) :: WC

 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) SOURCEDIR; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(SOURCEDIR)
 IF(.NOT.UTL_READINITFILE('OUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) OUTFILE; WRITE(*,'(A)') 'OUTFILE='//TRIM(OUTFILE)
 IFORMAT=0; IF(UTL_READINITFILE('IFORMAT',LINE,IU,1))READ(LINE,*) IFORMAT
 WRITE(*,'(A,I1)') 'IFORMAT=',IFORMAT

 JU=UTL_GETUNIT()
 CALL OSD_OPEN(JU,FILE=OUTFILE,STATUS='UNKNOWN',IOSTAT=IOS)
 IF(IOS.NE.0)THEN; WRITE(*,*) 'Error opening file '//TRIM(OUTFILE); RETURN; ENDIF

 I=INDEX(SOURCEDIR,'\',.TRUE.); ROOT=SOURCEDIR(:I-1); WC=TRIM(SOURCEDIR(I+1:))
 CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOT),TRIM(WC),N)
 IF(N.EQ.0)THEN; WRITE(*,'(A)') 'No files found in: '//TRIM(SOURCEDIR); RETURN; ENDIF
 ALLOCATE(IDFNAMES(N))
 CALL UTL_DIRINFO(TRIM(ROOT),TRIM(WC),IDFNAMES,N,'F')

 SELECT CASE (IFORMAT)
  CASE (0)
   DO I=1,SIZE(IDFNAMES); WRITE(JU,'(I5,A)') I,','//TRIM(IDFNAMES(I)); ENDDO
   WRITE(STRING,'(A6,3(A16))') 'File,','Population,','Mean,','St.Dev.,'
   DO I=1,21
    IF(I.NE.21)WRITE(STRING,'(A,11X,A2,I2,A2)') TRIM(STRING),'P(',(I-1)*5,'),'
    IF(I.EQ.21)WRITE(STRING,'(A,10X,A2,I3,A1)') TRIM(STRING),'P(',(I-1)*5,')'
   ENDDO
  CASE (1)
   WRITE(STRING,'(A20,6(A16))') 'File,','Population,','Mean,','St.Dev.,','Min,','Max,','Median'
  CASE DEFAULT
   WRITE(*,'(A)') 'Wrong format chosen'
 END SELECT
 WRITE(JU,'(A)') TRIM(STRING)

 DO I=1,SIZE(IDFNAMES)
  WRITE(*,'(A)') 'Busy with: '//TRIM(IDFNAMES(I))
  IDFNAMES(I)=TRIM(ROOT)//'\'//TRIM(IDFNAMES(I))
  CALL INFOSTAT(IDFNAMES(I:I),JU,IFORMAT) !,XMIN,YMIN,XMAX,YMAX) <--- OPTIONAL
 ENDDO
 CLOSE(JU)

 END SUBROUTINE IMODBATCH_IDFSTAT_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_IMPORTMODFLOW_MAIN()
 !###======================================================================
 USE MOD_IMPORT_PAR, ONLY : IVERSION,FNAME_MDL,XMIN,YMIN,SDATE,RUNFILE,DIR_DBS,ISUMPCK,IRIV5,IBATCH
 IMPLICIT NONE
 CHARACTER(LEN=4) :: MVERSION

 IF(.NOT.UTL_READINITFILE('MVERSION',LINE,IU,0))RETURN
 READ(LINE,*) MVERSION; WRITE(*,'(A)') 'MVERSION='//TRIM(MVERSION)

 SELECT CASE (MVERSION)
  CASE ('1988')
   IF(UTL_READINITFILE('BASFILE',LINE,IU,1))THEN
    READ(LINE,*) FNAME_MDL; WRITE(*,'(A)') 'BASFILE='//TRIM(FNAME_MDL)
   ELSE   
    IF(.NOT.UTL_READINITFILE('NAMFILE',LINE,IU,0))RETURN
    READ(LINE,*) FNAME_MDL; WRITE(*,'(A)') 'NAMFILE='//TRIM(FNAME_MDL)
   ENDIF
   IVERSION=1
  CASE ('1996')
   IF(.NOT.UTL_READINITFILE('NAMFILE',LINE,IU,0))RETURN
   READ(LINE,*) FNAME_MDL; WRITE(*,'(A)') 'NAMFILE='//TRIM(FNAME_MDL)
   IVERSION=2
  CASE ('2000')
   IF(.NOT.UTL_READINITFILE('NAMFILE',LINE,IU,0))RETURN
   READ(LINE,*) FNAME_MDL; WRITE(*,'(A)') 'NAMFILE='//TRIM(FNAME_MDL)
   IVERSION=3
  CASE ('2005')
   IF(.NOT.UTL_READINITFILE('NAMFILE',LINE,IU,0))RETURN
   READ(LINE,*) FNAME_MDL; WRITE(*,'(A)') 'NAMFILE='//TRIM(FNAME_MDL)
   IVERSION=4
  CASE DEFAULT
   WRITE(*,'(A)') 'Only 1988,1996,2000 or 2005 are sustained behind MODFLOWVERSION='
   STOP
 END SELECT

 XMIN=0.0D0
 YMIN=0.0D0
 IF(UTL_READINITFILE('LLCORNER',LINE,IU,1))READ(LINE,*) XMIN,YMIN
 WRITE(*,'(A,2F10.2)') 'LLCORNER=',XMIN,YMIN
 SDATE=20110101
 IF(UTL_READINITFILE('SDATE',LINE,IU,1))READ(LINE,*) SDATE
 WRITE(*,'(A,I8)') 'SDATE=',SDATE
 SDATE=UTL_IDATETOJDATE(SDATE)

 DIR_DBS='.'
 IF(UTL_READINITFILE('OUTDIR',LINE,IU,1))READ(LINE,*) DIR_DBS
 IF(INDEX(DIR_DBS,'\',.TRUE.).EQ.LEN_TRIM(DIR_DBS))DIR_DBS(LEN_TRIM(DIR_DBS):LEN_TRIM(DIR_DBS))=' '
 RUNFILE =TRIM(DIR_DBS)//'\model.run'
 WRITE(*,'(A)') 'OUTDIR='//TRIM(DIR_DBS)

 ISUMPCK=0
 IF(UTL_READINITFILE('PACKAGESUM',LINE,IU,1))READ(LINE,*) ISUMPCK
 IRIV5=0
 IF(UTL_READINITFILE('RIV5TH',LINE,IU,1))READ(LINE,*) IRIV5
 WRITE(*,'(A,I8)') 'PACKAGESUM=',ISUMPCK
 WRITE(*,'(A,I8)') 'RIV5TH=',IRIV5

 ISUMPCK=ABS(ISUMPCK-1)
 IBATCH=1

 IF(IMPORT_CALC(1))THEN; ENDIF

 END SUBROUTINE IMODBATCH_IMPORTMODFLOW_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_CALC_MAIN()
 !###======================================================================
 USE MOD_MATH_PAR
 IMPLICIT NONE
 INTEGER :: I,N
 INTEGER,DIMENSION(3) :: IG
 CHARACTER(LEN=256) :: SOURCEDIRA,SOURCEDIRB,SOURCEDIRC,ROOT,ROOTA,ROOTB,ROOTC
 CHARACTER(LEN=52) :: WC,WCA,WCB,WCC,SUBSTR
  
 CHARACTER(LEN=80) :: PARSEDFUNC,DUMMYFUNC
 INTEGER :: IEFUNC                        
 INTEGER,DIMENSION(3) :: IOP
 REAL(KIND=DP_KIND),DIMENSION(3) :: CLC
 
 !## get scale type (1=upscaling;2=downscaling)
 IF(.NOT.UTL_READINITFILE('FUNC',LINE,IU,0))RETURN
 READ(LINE,*) FUNC
 FUNC=UTL_CAP(FUNC,'U'); WRITE(*,'(A)') 'FUNC='//TRIM(FUNC)

 !## interrupt when parsing fails or parsed function doesn't match
 DUMMYFUNC=FUNC
 IF(.NOT.MATH1GETFUNC(DUMMYFUNC,1,IG,IOP,CLC,IEFUNC,PARSEDFUNC)) RETURN 
 IF(PARSEDFUNC.NE.FUNC) THEN
  WRITE(*,'(A)') 'Input formula could not be parsed.&
     & Did you use the correct order of operands, e.g. 0.5*A instead of A/2?'    
  RETURN
 ENDIF
 
 !## reduce indices to 0 or 1 for absent or present, resp.
 DO I=1,3; IG(I)=MIN(1,MAX(IG(I),0)); ENDDO  
    
 IF(SUM(IG).LE.1)THEN
  WRITE(*,'(A)') 'ERROR, enter function with at least C and A and/or B'
  WRITE(*,'(A)') 'FUNC='//TRIM(FUNC)
  RETURN
 ENDIF

 IIEXT=2
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IIEXT=3
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
 ENDIF
 IGEN=0
 IF(UTL_READINITFILE('GENFILE',LINE,IU,1))THEN
  READ(LINE,*) GENNAME
  WRITE(*,'(A)') 'GENFILE='//TRIM(GENNAME)
  IGEN=1
 ENDIF

 TRIM_VALUE=0.0D0; IF(UTL_READINITFILE('TRIM_VALUE',LINE,IU,1))READ(LINE,*) TRIM_VALUE
 WRITE(*,'(A,F10.3)') 'TRIM_VALUE=',TRIM_VALUE

 INODATA=0 !## ignore default
 NODATA_VALUE=0.0D0
 IF(UTL_READINITFILE('USENODATA',LINE,IU,1))THEN
  READ(LINE,*) INODATA
  IF(INODATA.EQ.1)THEN
   IF(.NOT.UTL_READINITFILE('NODATAVALUE',LINE,IU,0))RETURN
   READ(LINE,*) NODATA_VALUE
  ENDIF
 ENDIF
 IF(INODATA.EQ.0)WRITE(*,'(A,I1)') 'USENODATA=',INODATA,'(cell with nodata values will be LEFT OUT)'
 IF(INODATA.EQ.1)THEN
  WRITE(*,'(A,I1)')    'USENODATA=',INODATA,'(cell with nodata values will be translated into NODATA_VALUE)'
  WRITE(*,'(A,F10.3)') 'NODATAVALUE=',NODATA_VALUE
 ENDIF
 IEQUI=0
 IF(UTL_READINITFILE('IEQUI',LINE,IU,1))READ(LINE,*) IEQUI
 WRITE(*,'(A,I1)') 'IEQUI=',IEQUI

 N=0; IF(UTL_READINITFILE('NREPEAT',LINE,IU,1))READ(LINE,*) N

 !## given names
 IF(N.GT.0)THEN

  WRITE(*,'(A,I10)') 'NREPEAT=',N
  ALLOCATE(IDFNAMES(N,3))
  IDFNAMES=''

  DO I=1,N
   !## get idfnames
   IF(SUM(IG).EQ.3)THEN
    IF(.NOT.UTL_READINITFILE('ABC'//TRIM(ITOS(I)),LINE,IU,0))RETURN
    READ(LINE,*) IDFNAMES(I,1),IDFNAMES(I,2),IDFNAMES(I,3)
    LINE='A'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,1))
    WRITE(*,'(A)') TRIM(LINE)
    LINE='B'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,2))
    WRITE(*,'(A)') TRIM(LINE)
    LINE='C'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,3))
    WRITE(*,'(A)') TRIM(LINE)
   ELSE
    IF(IG(1).EQ.1)THEN
     IF(.NOT.UTL_READINITFILE('AC'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) IDFNAMES(I,1),IDFNAMES(I,3)
     LINE='A'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,1))
     WRITE(*,'(A)') TRIM(LINE)
     LINE='C'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,3))
     WRITE(*,'(A)') TRIM(LINE)
    ELSE
     IF(.NOT.UTL_READINITFILE('BC'//TRIM(ITOS(I)),LINE,IU,0))RETURN
     READ(LINE,*) IDFNAMES(I,2),IDFNAMES(I,3)
     LINE='B'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,2))
     WRITE(*,'(A)') TRIM(LINE)
     LINE='C'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,3))
     WRITE(*,'(A)') TRIM(LINE)
    ENDIF
   ENDIF
  ENDDO

 !## wildcard mode
 ELSE

  IF(IG(1).GT.0)THEN
   IF(.NOT.UTL_READINITFILE('SOURCEDIRA',LINE,IU,0))RETURN
   READ(LINE,*) SOURCEDIRA
   WRITE(*,'(A)') 'SOURCEDIRA='//TRIM(SOURCEDIRA)
   I=INDEX(SOURCEDIRA,'\',.TRUE.); ROOTA=SOURCEDIRA(:I-1); WCA=TRIM(SOURCEDIRA(I+1:))
   CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOTA),TRIM(WCA),N)
   ROOT=ROOTA; WC=WCA
  ENDIF
  IF(IG(2).GT.0)THEN
   IF(.NOT.UTL_READINITFILE('SOURCEDIRB',LINE,IU,0))RETURN
   READ(LINE,*) SOURCEDIRB
   WRITE(*,'(A)') 'SOURCEDIRB='//TRIM(SOURCEDIRB)
   I=INDEX(SOURCEDIRB,'\',.TRUE.); ROOTB=SOURCEDIRB(:I-1); WCB=TRIM(SOURCEDIRB(I+1:))
   IF(IG(1).EQ.0)THEN
    CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOTB),TRIM(WCB),N)
    ROOT=ROOTB; WC=WCB
   ENDIF
  ENDIF

  IF(N.EQ.0)THEN; WRITE(*,*) 'No files found in: '//TRIM(ROOT)//'\'//TRIM(WC); RETURN; ENDIF

  WRITE(*,'(A,I10)') 'NREPEAT=',N
  ALLOCATE(IDFNAMES(N,3))
  CALL UTL_DIRINFO(TRIM(ROOT),TRIM(WC),IDFNAMES(:,1),N,'F')

  IF(.NOT.UTL_READINITFILE('SOURCEDIRC',LINE,IU,0))RETURN
  READ(LINE,*) SOURCEDIRC
  WRITE(*,'(A)') 'SOURCEDIRC='//TRIM(SOURCEDIRC)
  I=INDEX(SOURCEDIRC,'\',.TRUE.); ROOTC=SOURCEDIRC(:I-1); WCC=TRIM(SOURCEDIRC(I+1:))

  WCA=UTL_CAP(WCA,'U')
  WCB=UTL_CAP(WCB,'U')
  WCC=UTL_CAP(WCC,'U')

  DO I=1,SIZE(IDFNAMES,1)
   IDFNAMES(I,1)=UTL_CAP(IDFNAMES(I,1),'U')
   CALL IMODBATCH_CALC_SUBST(IDFNAMES(I,1),WCA,SUBSTR)
   IDFNAMES(I,1)=TRIM(ROOTA)//'\'//TRIM(IDFNAMES(I,1))
   IDFNAMES(I,2)=TRIM(ROOTB)//'\'//TRIM(WCB)
   IDFNAMES(I,3)=TRIM(ROOTC)//'\'//TRIM(WCC)
   IDFNAMES(I,2)=UTL_SUBST(IDFNAMES(I,2),'*',SUBSTR)
   IDFNAMES(I,3)=UTL_SUBST(IDFNAMES(I,3),'*',SUBSTR)
   IF(IG(1).GT.0)THEN
    LINE='A'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,1))
    WRITE(*,'(A)') TRIM(LINE)
   ENDIF
   IF(IG(2).GT.0)THEN
    LINE='B'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,2))
    WRITE(*,'(A)') TRIM(LINE)
   ENDIF
   LINE='C'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I,3))
   WRITE(*,'(A)') TRIM(LINE)
  ENDDO

 ENDIF

 IF(MATH1CALC(1,ROOTC))THEN; ENDIF

 CALL MATH1CALCCLOSE(1)

 END SUBROUTINE IMODBATCH_CALC_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_CALC_SUBST(FNAME,WC,SUBSTR)
 !###======================================================================
 CHARACTER(LEN=*),INTENT(IN) :: WC,FNAME
 CHARACTER(LEN=*),INTENT(OUT) :: SUBSTR
 INTEGER :: I,J

 !## get in-between-string
 I=INDEX(FNAME,WC(1:INDEX(WC,'*')-1))
 I=I+(INDEX(WC,'*')-1)
 J=INDEX(FNAME,WC(INDEX(WC,'*')+1:))-1
 IF(I.EQ.0.OR.J.EQ.0)THEN
  SUBSTR=FNAME
 ELSE
  SUBSTR=FNAME(I:J)
 ENDIF

 END SUBROUTINE IMODBATCH_CALC_SUBST

 !###======================================================================
 SUBROUTINE IMODBATCH_SCALE_MAIN()
 !###======================================================================
 USE MOD_MATH_SCALE_PAR
 IMPLICIT NONE
 INTEGER :: I
 
 !## initialize optional arguments
 IINT=4
 SFCT=1.0D0
 IBUFFER=0
 !## intial values if not specified, overuled by iMOD
 HCLOSE=-999.99D0
 RCLOSE=-999.99D0

 !## get scale type (1=upscaling;2=downscaling)
 IF(.NOT.UTL_READINITFILE('SCALESIZE',LINE,IU,0))RETURN
 READ(LINE,*) SCLSIZE; WRITE(*,'(A,F10.2)') 'SCALESIZE=',SCLSIZE

 !## default scltype_up=2 (mean)
 SCLTYPE_UP=2; IF(UTL_READINITFILE('SCLTYPE_UP',LINE,IU,1))THEN
 READ(LINE,*) SCLTYPE_UP; WRITE(*,'(A,I2)') 'SCLTYPE_UP=',SCLTYPE_UP; ENDIF
 SCLTYPE_DOWN=0; IF(UTL_READINITFILE('SCLTYPE_DOWN',LINE,IU,1))THEN
 READ(LINE,*) SCLTYPE_DOWN; WRITE(*,'(A,I2)') 'SCLTYPE_DOWN=',SCLTYPE_DOWN; ENDIF
 
 IF(SCLTYPE_UP.EQ.0.AND.SCLTYPE_DOWN.EQ.0)THEN
  WRITE(*,'(/1X,A/)') 'You should specify SCLTYPE_UP and/or SCLTYPE_DOWN'; STOP
 ENDIF
 
 !## upscaling
 IF(SCLTYPE_UP.GT.0)THEN
  SELECT CASE (SCLTYPE_UP)
   CASE (9)
    IF(.NOT.UTL_READINITFILE('PERCENTILE',LINE,IU,0))RETURN
    READ(LINE,*) SFCT  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'SFCT=',SFCT
   CASE (1,3,4,5,6,8)
    IF(UTL_READINITFILE('WEIGHFACTOR',LINE,IU,1))READ(LINE,*) SFCT  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'SFCT=',SFCT
   CASE (14)
    HOR_FCT=1.0D0
    VER_FCT=1.0D0
    MAXK=250.0D0 !## grof zand
    DHX=0.0D0
    DHY=0.0D0
    DHZ=0.0D0
    QRATE=0.0D0
    FILLNODATA=0
    AQFR_KD=250.0D0  !## m/day
    ILGROUP=1  !## vertical box to average k-value
    KMIN=1.0D0 !## k-value to become clay
    IF(UTL_READINITFILE('ANI_X',LINE,IU,1))READ(LINE,*) HOR_FCT  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'ANI_X=',HOR_FCT
    IF(UTL_READINITFILE('ANI_Z',LINE,IU,1))READ(LINE,*) VER_FCT  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'ANI_Z=',VER_FCT
    IF(UTL_READINITFILE('DH_X',LINE,IU,1))READ(LINE,*) DHX  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'DH_X=',DHX
    IF(UTL_READINITFILE('DH_Y',LINE,IU,1))READ(LINE,*) DHY  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'DH_Y=',DHY
    IF(UTL_READINITFILE('DH_Z',LINE,IU,1))READ(LINE,*) DHZ  !## <>1.0D0
    WRITE(*,'(A,F10.2)') 'DH_Z=',DHZ
    IF(UTL_READINITFILE('QRATE',LINE,IU,1))THEN
     READ(LINE,*) QRATE  !## extraction rate m3/day
     WRITE(*,'(A,F10.2)') 'QRATE=',QRATE
     IF(UTL_READINITFILE('AQFR_KD',LINE,IU,1))READ(LINE,*) AQFR_KD  !## transmissivity of aquifer
     WRITE(*,'(A,F10.2)') 'AQFR_KD=',AQFR_KD
    ENDIF
    IF(UTL_READINITFILE('FILLNODATA',LINE,IU,1))THEN
     READ(LINE,*) FILLNODATA  !## >> apply surface water to nodata column
     WRITE(*,'(A,I1)') 'FILLNODATA=',FILLNODATA
     IF(UTL_READINITFILE('MAX_K',LINE,IU,1))READ(LINE,*) MAXK  !## >>
     WRITE(*,'(A,F10.2)') 'MAX_K=',MAXK
    ENDIF
    IF(UTL_READINITFILE('KMIN',LINE,IU,1))READ(LINE,*) KMIN  !## minimal k-value to become clay
    WRITE(*,'(A,F10.2)') 'KMIN=',KMIN
    IF(UTL_READINITFILE('ILGROUP',LINE,IU,1))READ(LINE,*) ILGROUP  !## >> vertical number of layers to aggregrate to get k-value average
    WRITE(*,'(A,I1)') 'ILGROUP=',ILGROUP
    IF(UTL_READINITFILE('HCLOSE',LINE,IU,1))READ(LINE,*) HCLOSE  
    IF(UTL_READINITFILE('RCLOSE',LINE,IU,1))READ(LINE,*) RCLOSE  

  END SELECT
 !## downscaling
 ENDIF
 IF(SCLTYPE_DOWN.GT.0)THEN
  SELECT CASE (SCLTYPE_DOWN)
   CASE (1)
    IF(UTL_READINITFILE('BLOCK',LINE,IU,1))READ(LINE,*) IINT  !## 4,16,32,64,100
    SELECT CASE (TRIM(LINE))
     CASE ('4','16','32','64','100')
      STOP 'BLOCK should be in {4,16,32,64,100}' 
     CASE DEFAULT
    END SELECT
    WRITE(*,'(A,I1)') 'IINT=',IINT
  END SELECT
 ENDIF
 IIEXT=2 !## given idf
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  IIEXT=3 !## given window
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
 ENDIF

 ALLOCATE(IDFNAMES(1),OUTNAMES(1)); OUTNAMES=''
 
 !## get idfnames
 SELECT CASE (SCLTYPE_UP)
  CASE (14)
   IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
   READ(LINE,*) IDFNAMES(1)
   WRITE(*,'(A)') 'SOURCEDIR='//TRIM(IDFNAMES(1))
   ALLOCATE(TRIMIDF(2)); DO I=1,2; CALL IDFNULLIFY(TRIMIDF(I)); ENDDO; TRIMIDF%FNAME=''
   ITRIM=0
   IF(UTL_READINITFILE('TOPTRIMIDF',LINE,IU,1))THEN
    READ(LINE,*) TRIMIDF(1)%FNAME; WRITE(*,'(A)') 'TOPTRIMIDF='//TRIM(TRIMIDF(1)%FNAME)
    IF(.NOT.IDFREAD(TRIMIDF(1),TRIMIDF(1)%FNAME,0))RETURN
    ITRIM(1)=1
   ENDIF
   IF(UTL_READINITFILE('BOTTRIMIDF',LINE,IU,1))THEN
    READ(LINE,*) TRIMIDF(2)%FNAME; WRITE(*,'(A)') 'BOTTRIMIDF='//TRIM(TRIMIDF(2)%FNAME)
    IF(.NOT.IDFREAD(TRIMIDF(2),TRIMIDF(2)%FNAME,0))RETURN
    ITRIM(2)=1
   ENDIF
  CASE DEFAULT
   IF(.NOT.UTL_READINITFILE('SOURCEIDF',LINE,IU,0))RETURN
   READ(LINE,*) IDFNAMES(1)
   WRITE(*,'(A)') 'SOURCEIDF='//TRIM(IDFNAMES(1))
 END SELECT

 !## get buffersize
 SELECT CASE (SCLTYPE_UP)
  CASE (11,12,13,14) 
   IF(UTL_READINITFILE('BUFFER',LINE,IU,1))READ(LINE,*) IBUFFER
   WRITE(*,'(A,I3)') 'BUFFER=',IBUFFER
 END SELECT

 IF(.NOT.UTL_READINITFILE('OUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) OUTNAMES(1)
 WRITE(*,'(A)') 'OUTFILE='//TRIM(OUTNAMES(1))

 IF(HCLOSE.LT.0.0D0)HCLOSE=MAX(DHX,DHY,DHZ)/1000.0D0
 
 IF(MATH1SCALE(1,HCLOSE,RCLOSE))THEN; ENDIF
 CALL MATH1SCALECLOSE(1)

 END SUBROUTINE IMODBATCH_SCALE_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_MERGE_MAIN()
 !###======================================================================
 USE MOD_MATH_MERGE_PAR
 IMPLICIT NONE
 INTEGER :: I,N
 CHARACTER(LEN=256) :: SOURCEDIR,ROOT
 CHARACTER(LEN=50) :: WC

 !## get number of files to be merged
 IF(UTL_READINITFILE('NMERGE',LINE,IU,1))THEN
  READ(LINE,*) N; WRITE(*,'(A,I10)') 'NMERGE=',N
  ALLOCATE(IDFNAMES(N))
  DO I=1,N
   IF(.NOT.UTL_READINITFILE('SOURCEIDF'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) IDFNAMES(I)
   LINE='SOURCEIDF'//TRIM(ITOS(I))//'='//TRIM(IDFNAMES(I))
   WRITE(*,'(A)') TRIM(LINE)
  ENDDO
 ELSE
  IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
  READ(LINE,*) SOURCEDIR
  I=INDEX(SOURCEDIR,'\',.TRUE.); ROOT=SOURCEDIR(:I-1); WC=TRIM(SOURCEDIR(I+1:))
  CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(TRIM(ROOT),TRIM(WC),N)
  IF(N.EQ.0)THEN
   WRITE(*,'(A)') 'No files found in: '//TRIM(SOURCEDIR)
   RETURN
  ENDIF
  ALLOCATE(IDFNAMES(N))
  CALL UTL_DIRINFO(TRIM(ROOT),TRIM(WC),IDFNAMES,N,'F')
  DO I=1,N; IDFNAMES(I)=TRIM(ROOT)//'\'//TRIM(IDFNAMES(I)); ENDDO
 ENDIF

 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  WRITE(*,'(A,4F10.2)') 'WINDOW=',MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX
  IEXT=1
 ELSE
  WRITE(*,'(A)') 'no window given'; IEXT=2
 ENDIF
 IMASK=0
 IF(UTL_READINITFILE('MASKIDF',LINE,IU,1))THEN
  IMASK=1
  READ(LINE,*) MSKNAME; WRITE(*,'(A)') 'MASKIDF='//TRIM(MSKNAME)
 ELSE
  WRITE(*,'(A)') 'no mask given'
 ENDIF

 IF(.NOT.UTL_READINITFILE('TARGETIDF',LINE,IU,0))RETURN
 READ(LINE,*) OUTNAME; WRITE(*,'(A)') 'TARGETIDF='//TRIM(OUTNAME)

 CLOSE(IU)

 IF(MATH1MERGE(1))THEN; ENDIF
 CALL MATH1MERGECLOSE(1)

 END SUBROUTINE IMODBATCH_MERGE_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEIDF_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: DIRNAME
 CHARACTER(LEN=52) :: TOPWC
 REAL(KIND=DP_KIND) :: BOTEL,MULT,ADD

 !## get number of files to be imported
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)

 TOPWC=''; BOTEL=0.0D0; MULT =1.0D0; ADD=0.0D0
 IF(UTL_READINITFILE('TOPWC',LINE,IU,1))THEN
  READ(LINE,*) TOPWC;  WRITE(*,'(A)') 'TOPWC='//TRIM(TOPWC)
  IF(.NOT.UTL_READINITFILE('BOTEL',LINE,IU,0))RETURN
  READ(LINE,*) BOTEL; WRITE(*,'(A,F10.2)') 'BOTEL=',BOTEL
  IF(UTL_READINITFILE('MULT',LINE,IU,1))THEN
   READ(LINE,*) MULT; WRITE(*,'(A,F10.2)') 'MULT=',MULT
  ENDIF
  IF(UTL_READINITFILE('ADD',LINE,IU,1))THEN
   READ(LINE,*) ADD; WRITE(*,'(A,F10.2)') 'ADD=',ADD
  ENDIF
 ENDIF
 
 CLOSE(IU)

 CALL ASC2IDF_IMPORTASC_MAIN(DIRNAME,TOPWC,BOTEL,MULT,ADD,1)

 END SUBROUTINE IMODBATCH_CREATEIDF_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_CREATEASC_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: DIRNAME
 
 !## get number of files to be exported
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)

 CLOSE(IU)

 CALL ASC2IDF_EXPORTASC_MAIN(DIRNAME)

 END SUBROUTINE IMODBATCH_CREATEASC_MAIN

! !###======================================================================
! SUBROUTINE IMODBATCH_CREATEIVF_MAIN()
! !###======================================================================
! IMPLICIT NONE
! CHARACTER(LEN=256) :: DIRNAME
! CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:,:) :: TBNAME
! CHARACTER(LEN=52) :: DATE
! INTEGER :: NLAY,I
!  
! !## get number of files to be exported
! IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
! READ(LINE,*) DIRNAME; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(DIRNAME)
! IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
! READ(LINE,*) NLAY; WRITE(*,'(A,I10)') 'NLAY=',NLAY
! IF(.NOT.UTL_READINITFILE('DATE',LINE,IU,0))RETURN
! READ(LINE,*) DATE; WRITE(*,'(A)') 'DATE='//TRIM(DATE)
! 
! ALLOCATE(TBNAME(NLAY,2))
! DO I=1,NLAY
!  IF(.NOT.UTL_READINITFILE('TOP'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) TBNAME(I,1); WRITE(*,'(A)') 'TOP'//TRIM(ITOS(I))//'='//TRIM(TBNAME(I,1))
!  IF(.NOT.UTL_READINITFILE('BOT'//TRIM(ITOS(I)),LINE,IU,0))RETURN
!  READ(LINE,*) TBNAME(I,2); WRITE(*,'(A)') 'BOT'//TRIM(ITOS(I))//'='//TRIM(TBNAME(I,2))
! ENDDO
!  
! IF(.NOT.IDFCREATEIVF(TRIM(DIRNAME),TRIM(DATE),TBNAME,NLAY))THEN; ENDIF
! 
! DEALLOCATE(TBNAME)
! 
! CLOSE(IU)
!
! END SUBROUTINE IMODBATCH_CREATEIVF_MAIN
!
 !###======================================================================
 SUBROUTINE IMODBATCH_AHNFILTER_MAIN()
 !###======================================================================
 USE MOD_AHNFILTER_PAR
 IMPLICIT NONE
 INTEGER :: I,NWINDOW

 !## read idfname
 IF(.NOT.UTL_READINITFILE('NAHN',LINE,IU,0))RETURN
 READ(LINE,*) NAHN; IF(NAHN.LE.0)STOP 'NAHN.LE.0'
 WRITE(*,'(A,I10)') 'NAHN=',NAHN

 ALLOCATE(AHN(NAHN))
 DO I=1,NAHN
  !## read surface name
  IF(.NOT.UTL_READINITFILE('IDFFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) AHN(I)
  LINE='IDFFILE'//TRIM(ITOS(I))//'='//TRIM(AHN(I)); WRITE(*,'(A)') TRIM(LINE)
 ENDDO

 NSCRIT   =1500  !## surface yes/no (cells!)
 LOCCRIT  =2.00  !## no local depression/upconing whenever max-min>loccrit (m)
 XCRIT    =0.50  !## building/strong edge (m)
 DPW      =5     !## size window upconing
 DP1      =30.0D0  !## depression percentile
 DP2      =90.0D0  !## upconing percentile
 CORXCRIT =0.10  !## max. change to become surf.level (m)
 CORCRIT  =50    !## max. number of cells corrected during interpolation outer loop (-)
 INTXCRIT =0.05D0  !## stop criterion max. change interpolation (m)

 INTNODATA=1     !## ignore nodata
 BUFFER   =0.0D0   !## buffer
 IAGGREGATEY=0   !## aggregrate y

 IF(UTL_READINITFILE('IAGGREGATEY',LINE,IU,1))READ(LINE,*) IAGGREGATEY
 IF(UTL_READINITFILE('IGNORENODATA',LINE,IU,1))READ(LINE,*) INTNODATA
 IF(UTL_READINITFILE('NSCRIT',LINE,IU,1))READ(LINE,*) NSCRIT
 IF(UTL_READINITFILE('LOCCRIT',LINE,IU,1))READ(LINE,*) LOCCRIT
 IF(UTL_READINITFILE('XCRIT',LINE,IU,1))READ(LINE,*) XCRIT
 IF(UTL_READINITFILE('DPW',LINE,IU,1))READ(LINE,*) DPW
 IF(UTL_READINITFILE('DP1',LINE,IU,1))READ(LINE,*) DP1
 IF(UTL_READINITFILE('DP2',LINE,IU,1))READ(LINE,*) DP2
 IF(UTL_READINITFILE('CORXCRIT',LINE,IU,1))READ(LINE,*) CORXCRIT
 IF(UTL_READINITFILE('NCORXCRIT',LINE,IU,1))READ(LINE,*) CORCRIT
 IF(UTL_READINITFILE('INTXCRIT',LINE,IU,1))READ(LINE,*) INTXCRIT
 IF(UTL_READINITFILE('BUFFER',LINE,IU,1))READ(LINE,*) BUFFER
 WRITE(*,'(A,I1)')    'IAGGREGATEY=',IAGGREGATEY
 WRITE(*,'(A,I1)')    'IGNORENODATA=',INTNODATA
 WRITE(*,'(A,I10)')   'NSCRIT=',NSCRIT
 WRITE(*,'(A,F10.2,A)') 'LOCCRIT=',LOCCRIT,' [unit of idf]'
 WRITE(*,'(A,F10.2,A)') 'XCRIT=',XCRIT,' [unit of idf]'
 WRITE(*,'(A,I10)')   'DPW=',DPW
 WRITE(*,'(A,F10.2,A)') 'DP1=',DP1,' [%]'
 WRITE(*,'(A,F10.2,A)') 'DP2=',DP2,' [%]'
 WRITE(*,'(A,F10.2,A)') 'CORXCRIT=',CORXCRIT,' [unit of idf]'
 WRITE(*,'(A,I10)')   'NCORXCRIT=',CORCRIT
 WRITE(*,'(A,F10.2,A)') 'INTXCRIT=',INTXCRIT,' [unit of idf]'
 WRITE(*,'(A,F10.2,A)') 'BUFFER=',BUFFER,' [size of idf]'

 NWINDOW=0; AHN_IWINDOW=0
 IF(UTL_READINITFILE('NWINDOW',LINE,IU,1))THEN
  READ(LINE,*) NWINDOW; AHN_IWINDOW=1
 ENDIF

 DO I=1,MAX(1,NWINDOW)
  IF(NWINDOW.GT.0)THEN
   IF(.NOT.UTL_READINITFILE('WINDOW'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) AHN_XMIN,AHN_YMIN,AHN_XMAX,AHN_YMAX
   LINE='WINDOW'//TRIM(ITOS(I))//'='
   WRITE(*,'(A,4F10.2)') TRIM(LINE),AHN_XMIN,AHN_YMIN,AHN_XMAX,AHN_YMAX
   IF(.NOT.UTL_READINITFILE('OUTFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) OUTFILE
   LINE='OUTFILE'//TRIM(ITOS(I))//'='//TRIM(OUTFILE)
   WRITE(*,'(A)') TRIM(LINE)
  ELSE
   IF(.NOT.UTL_READINITFILE('OUTFILE',LINE,IU,0))RETURN
   READ(LINE,*) OUTFILE
   LINE='OUTFILE='//TRIM(OUTFILE)
   WRITE(*,'(A)') TRIM(LINE)
  ENDIF
  IF(.NOT.AHNFILTER_MAIN(I))RETURN
 ENDDO

 DEALLOCATE(AHN)

 END SUBROUTINE IMODBATCH_AHNFILTER_MAIN

 !###======================================================================
 SUBROUTINE IMODBATCH_GXG_MAIN()
 !###======================================================================
 USE MOD_GXG_PAR
 IMPLICIT NONE
 INTEGER :: I,J,N

 IBATCH=1
 GXG_RESDIR=''; GXG_MVIDFNAME=''

 !## read layer (optional)
 IF(.NOT.UTL_READPOINTER(IU,GXG_NLAYER,GXG_ILAYER,'ILAYER',0))RETURN

 !## read surface name
 IF(UTL_READINITFILE('SURFACEIDF',LINE,IU,1))THEN
  READ(LINE,*) GXG_MVIDFNAME; WRITE(*,'(A)') 'SURFACEIDF='//TRIM(GXG_MVIDFNAME)
 ENDIF

 IF(.NOT.IMODBATH_READYEAR(GXG_NYEAR,GXG_IYEAR))RETURN

 ALLOCATE(GXG_IPERIOD(12,2))
 GXG_IPERIOD=1
 IF(UTL_READINITFILE('IPERIOD',LINE,IU,1))THEN
  READ(LINE,'(24I1)') ((GXG_IPERIOD(I,J),J=1,2),I=1,12)
  WRITE(*,'(24I1)') ((GXG_IPERIOD(I,J),J=1,2),I=1,12)
 ENDIF

 IF(.NOT.IMODBATCH_AREAINFO(ISEL,GXG_IDFNAME,GXG_GENFNAME))RETURN

 IF(.NOT.UTL_READINITFILE('NDIR',LINE,IU,0))RETURN
 READ(LINE,*) N; WRITE(*,'(A,I4)') 'NDIR=',N

 GXG_STARTMONTH=4 !## default starting month april
 IF(UTL_READINITFILE('STARTMONTH',LINE,IU,1))READ(LINE,*) GXG_STARTMONTH
 WRITE(*,'(A,I4)') 'STARTMONTH=',GXG_STARTMONTH
 
 GXG_HGLG3=0
 IF(UTL_READINITFILE('HGLG3',LINE,IU,1))READ(LINE,*) GXG_HGLG3
 WRITE(*,'(A,I1)') 'HGLG3=',GXG_HGLG3 
 
 DO I=1,N
  !## read idfname
  IF(.NOT.UTL_READINITFILE('SOURCEDIR'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) GXG_RESDIR; LINE='SOURCEDIR='//TRIM(ITOS(I))//'='//TRIM(GXG_RESDIR)
  WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.GXG1_COMPUTEGXG())WRITE(*,'(/A/)') 'ERROR OCCURED!'
 END DO

 IF(ASSOCIATED(GXG_IPERIOD))DEALLOCATE(GXG_IPERIOD)
 IF(ASSOCIATED(GXG_IYEAR))  DEALLOCATE(GXG_IYEAR)
 IF(ASSOCIATED(GXG_ILAYER)) DEALLOCATE(GXG_ILAYER)

 !## clean memory
 CALL GXG1_ABORT()

 END SUBROUTINE IMODBATCH_GXG_MAIN

 !###======================================================================
 LOGICAL FUNCTION IMODBATH_READYEAR(NYEAR,IYEAR,SYEAR,EYEAR)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),OPTIONAL :: SYEAR,EYEAR
 INTEGER,INTENT(OUT) :: NYEAR
 INTEGER,POINTER,DIMENSION(:) :: IYEAR
 INTEGER :: IOS,I,EY,SY

 IMODBATH_READYEAR=.FALSE.

 IF(.NOT.PRESENT(SYEAR))THEN
  !## read begin year
  IF(.NOT.UTL_READINITFILE('SYEAR',LINE,IU,0))RETURN
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') SY; WRITE(*,'(A,I4)') 'SYEAR=',SY
 ELSE
  SY=SYEAR
 ENDIF

 IF(.NOT.PRESENT(EYEAR))THEN
  !## read end year
  IF(.NOT.UTL_READINITFILE('EYEAR',LINE,IU,0))RETURN
  READ(LINE,*) EY; WRITE(*,'(A,I4)') 'EYEAR=',EY
 ELSE
  EY=EYEAR
 ENDIF

 !## read nyear (optional)
 NYEAR=EY-SY+1
 ALLOCATE(IYEAR(NYEAR))

 IF(UTL_READINITFILE('IYEAR',LINE,IU,1))THEN
  DO
   IYEAR=0
   READ(LINE,*,IOSTAT=IOS) (IYEAR(I),I=1,NYEAR)
   IF(IOS.EQ.0)EXIT
   NYEAR=NYEAR-1
  ENDDO
  WRITE(*,'(A,99(I4,A1))') 'IYEAR=',(IYEAR(I),',',I=1,NYEAR)
 ELSE
  NYEAR=0; DO I=SY,EY; NYEAR=NYEAR+1; IYEAR(NYEAR)=I; ENDDO
 ENDIF

 IMODBATH_READYEAR=.TRUE.

 END FUNCTION IMODBATH_READYEAR

 !###======================================================================
 LOGICAL FUNCTION IMODBATH_READPERIOD(NPERIOD,IPERIOD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: NPERIOD
 INTEGER,DIMENSION(:,:),POINTER :: IPERIOD
 INTEGER :: I,J,K

 IMODBATH_READPERIOD=.FALSE.

 NPERIOD=0
 IF(UTL_READINITFILE('NPERIOD',LINE,IU,1))THEN
  READ(LINE,*) NPERIOD; WRITE(*,'(A,I4)') 'NPERIOD=',NPERIOD
  IF(NPERIOD.GT.0)THEN
   ALLOCATE(IPERIOD(NPERIOD*2,2))
   K=0
   DO J=1,NPERIOD
    IF(.NOT.UTL_READINITFILE('PERIOD'//TRIM(ITOS(J)),LINE,IU,0))RETURN
    I=INDEX(LINE,'-')
    K=K+1
    READ(LINE(:I-1),'(2I2)') IPERIOD(K,1),IPERIOD(K,2)
    K=K+1
    READ(LINE(I+1:),'(2I2)') IPERIOD(K,1),IPERIOD(K,2)
    LINE='PERIOD'//TRIM(ITOS(J))//'='//TRIM(ITOS(IPERIOD(K-1,1)))//'-'//TRIM(ITOS(IPERIOD(K-1,2)))//';'// &
                                       TRIM(ITOS(IPERIOD(K,1)))  //'-'//TRIM(ITOS(IPERIOD(K  ,2)))
    WRITE(*,'(A)') TRIM(LINE)
   END DO
   NPERIOD=NPERIOD*2
  ELSE
   ALLOCATE(IPERIOD(1,2))
  ENDIF
 ENDIF

 IMODBATH_READPERIOD=.TRUE.

 END FUNCTION IMODBATH_READPERIOD

 !###======================================================================
 LOGICAL FUNCTION IMODBATCH_AREAINFO(ISEL,IDFNAME,GENFNAME)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: ISEL
 CHARACTER(LEN=*),INTENT(OUT) :: IDFNAME,GENFNAME

 IMODBATCH_AREAINFO=.FALSE.

 IDFNAME=''
 GENFNAME=''
 ISEL=1

 IF(UTL_READINITFILE('ISEL',LINE,IU,1))THEN
  READ(LINE,*) ISEL
  IF(ISEL.EQ.2)THEN
   IF(.NOT.UTL_READINITFILE('GENFILE',LINE,IU,0))RETURN
   READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFILE='//TRIM(GENFNAME)
  ELSEIF(ISEL.EQ.3)THEN
   IF(.NOT.UTL_READINITFILE('IDFNAME',LINE,IU,0))RETURN
   READ(LINE,*) IDFNAME; WRITE(*,'(A)') 'IDFNAME='//TRIM(IDFNAME)
  ENDIF
 ENDIF
 WRITE(*,'(A,I4)') 'ISEL=',ISEL

 IMODBATCH_AREAINFO=.TRUE.

 END FUNCTION IMODBATCH_AREAINFO

 !###======================================================================
 SUBROUTINE IMODBATCH_PLOT_MAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IDFLEGNAME,IPFLEGNAME,IFFLEGNAME,IDFNAME,IPFNAME,OUTNAME,IFFNAME,BMPOUTNAME
 CHARACTER(LEN=52) :: IDFLEGTXT,IPFLEGTXT,IFFLEGTXT
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: GENNAME
 INTEGER :: IDFLEGCOL,IPFLEGCOL,IFFLEGCOL,IDFLINETHICKNESS,IDFTRANSTOPO,IDFTRANSTOPOPER
 INTEGER :: JU,IOS,I,NFIG,RESOLUTION,IDFSTYLE,IPFSTYLE,IFFSTYLE,NLABELS,NGEN,IR,IG,IB,N,M,J,II,IEXT,II1,II2,IBITMAP
 INTEGER,DIMENSION(2) :: IPFASSFILES
 INTEGER,DIMENSION(5) :: IPFICOL
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX,YFRACLEGEND,RAT
 INTEGER,DIMENSION(3) :: IP
 INTEGER,DIMENSION(6) :: ITPER
 REAL(KIND=DP_KIND),DIMENSION(:,:),ALLOCATABLE :: XY
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILABELS,GENCOLOUR,GENTHICKNESS
 CHARACTER(LEN=52),DIMENSION(:),ALLOCATABLE :: STRING,CLABEL
 CHARACTER(LEN=3) :: CSTYLE
 CHARACTER(LEN=6) :: TRANSPER
 LOGICAL :: LIND
 
 IDFNAME=''; IDFLEGNAME=''; IPFNAME=''; IFFNAME=''
 IDFLEGCOL=0; IPFLEGCOL=0; IFFLEGCOL=0
 IDFTRANSTOPOPER=0 ; IDFTRANSTOPO=0
 
 !## read idfname (optional)
 IF(UTL_READINITFILE('IDFFILE',LINE,IU,1))THEN
  READ(LINE,*) IDFNAME; WRITE(*,'(A)') 'IDFNAME='//TRIM(IDFNAME)
  IP=0; IP(1)=1; IDFSTYLE=100
  IF(UTL_READINITFILE('IDFSTYLE',LINE,IU,1))THEN
   READ(LINE,*) IDFSTYLE; WRITE(*,'(A,I3)') 'IDFSTYLE=',IDFSTYLE
  ENDIF
  WRITE(CSTYLE,'(I3.3)') IDFSTYLE
  READ(CSTYLE,'(3I1)') IP 
  CALL UTL_READARRAY(IP,3,IDFSTYLE)
  !## read legname (optional)
  IF(UTL_READINITFILE('IDFLEGFILE',LINE,IU,1))THEN
   READ(LINE,*) IDFLEGNAME; WRITE(*,'(A)') 'IDFLEGFILE='//TRIM(IDFLEGNAME)
  ENDIF
  IDFLEGTXT=''
  IF(UTL_READINITFILE('IDFLEGTXT',LINE,IU,1))THEN
   READ(LINE,*) IDFLEGTXT; WRITE(*,'(A)') 'IDFLEGTXT='//TRIM(IDFLEGTXT)
  ENDIF
  IDFLEGCOL=1
  IF(UTL_READINITFILE('IDFLEGCOL',LINE,IU,1))THEN
   READ(LINE,*) IDFLEGCOL; WRITE(*,'(A)') 'IDFLEGCOL=',IDFLEGCOL
  ENDIF
  IF(UTL_READINITFILE('IDFLINETHICKNESS',LINE,IU,1))THEN
   READ(LINE,*) IDFLINETHICKNESS; WRITE(*,'(A)') 'IDFLINETHICKNESS=',IDFLINETHICKNESS
  ENDIF
  IF(UTL_READINITFILE('IDFTRANSTOPO',LINE,IU,1))THEN
   READ(LINE,*) IDFTRANSTOPO; WRITE(*,'(A,I1)') 'IDFTRANSTOPO=',IDFTRANSTOPO
  ENDIF  
  IF(UTL_READINITFILE('IDFTRANSTOPOPER',LINE,IU,1))THEN
   READ(LINE,*) IDFTRANSTOPOPER; WRITE(*,'(A,I6)') 'IDFTRANSTOPOPER=',IDFTRANSTOPOPER
   WRITE(TRANSPER,'(I6.6)') IDFTRANSTOPOPER
   READ(TRANSPER,'(6I1)') ITPER
   CALL UTL_READARRAY(ITPER,6,IDFTRANSTOPOPER)
  ENDIF 
 ENDIF

! !## read legname (optional)
! TSIZE=0.05D0; IF(UTL_READINITFILE('LEGTSIZE',LINE,IU,1))THEN
!  READ(LINE,*) TSIZE; WRITE(*,'(A,F10.3)') 'LEGTSIZE=',TSIZE
! ENDIF
  
 !## read ipfname (optional)
 IF(UTL_READINITFILE('IPFFILE',LINE,IU,1))THEN
  READ(LINE,*) IPFNAME
  WRITE(*,'(A)') 'IPFNAME='//TRIM(IPFNAME) 
  IPFSTYLE=0
  IF(UTL_READINITFILE('IPFSTYLE',LINE,IU,1))THEN
   READ(LINE,*) IPFSTYLE; WRITE(*,'(A,I1)') 'IPFSTYLE=',IPFSTYLE
  ENDIF
  IF(IPFSTYLE.LT.0.OR.IPFSTYLE.GT.1)THEN; WRITE(*,*) 'You should specify IPFSTYLE in {0,1}'; STOP; ENDIF

  IPFASSFILES=0; IPFASSFILES(2)=-1
  IF(UTL_READINITFILE('IPFASSFILES',LINE,IU,1))THEN
   READ(LINE,*) IPFASSFILES(1); WRITE(*,'(A,I1)') 'IPFASSFILES=',IPFASSFILES(1)
  ENDIF
  IF(IPFASSFILES(1).LT.0.OR.IPFASSFILES(1).GT.2)THEN; WRITE(*,*) 'You should specify IPFASSFILES in {0,1,2}'; STOP; ENDIF
  IF(IPFASSFILES(1).GT.0)THEN
   IF(UTL_READINITFILE('IPFASSFILES_ALL',LINE,IU,1))THEN
    READ(LINE,*) IPFASSFILES(2); WRITE(*,'(A,I1)') 'IPFASSFILES_ALL=',IPFASSFILES(2)
   ENDIF
   IF(IPFASSFILES(2).LT.-1.OR.IPFASSFILES(2).GT.1)THEN; WRITE(*,*) 'You should specify IPFASSFILES_ALL in {-1,0,1}'; STOP; ENDIF
  ENDIF
  IPFICOL(1)=1; IPFICOL(2)=2; IPFICOL(3)=3; IPFICOL(4)=0; IPFICOL(5)=1
  IF(UTL_READINITFILE('IPFXCOL',LINE,IU,1))READ(LINE,*) IPFICOL(1)
  WRITE(*,'(A,I1)') 'IPFXCOL=',IPFICOL(1)
  IF(UTL_READINITFILE('IPFYCOL',LINE,IU,1))READ(LINE,*) IPFICOL(2)
  WRITE(*,'(A,I1)') 'IPFYCOL=',IPFICOL(2)
  IF(UTL_READINITFILE('IPFHCOL',LINE,IU,1))READ(LINE,*) IPFICOL(4)
  WRITE(*,'(A,I1)') 'IPFHCOL=',IPFICOL(4)
  IF(UTL_READINITFILE('IPFHCOL_M',LINE,IU,1))READ(LINE,*) IPFICOL(5)
  WRITE(*,'(A,I1)') 'IPFHCOL_M=',IPFICOL(5)
  IPFLEGNAME=''; NLABELS=0
  IF(IPFSTYLE.EQ.1)THEN
   !## read legname (optional)
   IF(UTL_READINITFILE('IPFLEGFILE',LINE,IU,1))THEN
    READ(LINE,*) IPFLEGNAME
    WRITE(*,'(A)') 'IPFLEGFILE='//TRIM(IPFLEGNAME)
    IF(.NOT.UTL_READINITFILE('IPFLCOL',LINE,IU,0))RETURN
    READ(LINE,*) IPFICOL(3)
    WRITE(*,'(A,I1)') 'IPFLCOL=',IPFICOL(3)
    IPFLEGTXT=''
    IF(UTL_READINITFILE('IPFLEGTXT',LINE,IU,1))THEN
     READ(LINE,*) IPFLEGTXT; WRITE(*,'(A)') 'IPFLEGTXT='//TRIM(IPFLEGTXT)
    ENDIF
    IPFLEGCOL=1
    IF(UTL_READINITFILE('IPFLEGCOL',LINE,IU,1))THEN
     READ(LINE,*) IPFLEGCOL; WRITE(*,'(A)') 'IPFLEGCOL=',IPFLEGCOL
    ENDIF
   ELSE
    IF(IPFICOL(5).EQ.2)THEN
     WRITE(*,'(/A/)') 'You need to specify a legend in case IPFHCOL_M is specified as 2'; STOP
    ENDIF
   ENDIF
   IF(UTL_READINITFILE('NLABELS',LINE,IU,1))THEN
    READ(LINE,*) NLABELS; WRITE(*,'(A,I10)') 'NLABELS=',NLABELS
    ALLOCATE(ILABELS(NLABELS))
    IF(.NOT.UTL_READINITFILE('ILABELS',LINE,IU,0))RETURN
    READ(LINE,*) ILABELS; WRITE(*,'(A,99I5)') 'ILABELS=',ILABELS
   ENDIF
  ENDIF
 ENDIF

 !## read iffname (optional)
 IF(UTL_READINITFILE('IFFFILE',LINE,IU,1))THEN
  IFFSTYLE=1
  READ(LINE,*) IFFNAME; WRITE(*,'(A)') 'IFFNAME='//TRIM(IFFNAME)
  !## read legname (optional)
  IF(UTL_READINITFILE('IFFLEGFILE',LINE,IU,1))THEN
   READ(LINE,*) IFFLEGNAME; WRITE(*,'(A)') 'IFFLEGFILE='//TRIM(IFFLEGNAME)
  ENDIF
  IFFLEGTXT=''
  IF(UTL_READINITFILE('IFFLEGTXT',LINE,IU,1))THEN
   READ(LINE,*) IFFLEGTXT; WRITE(*,'(A)') 'IFFLEGTXT='//TRIM(IFFLEGTXT)
  ENDIF
  IFFLEGCOL=1
  IF(UTL_READINITFILE('IFFLEGCOL',LINE,IU,1))THEN
   READ(LINE,*) IFFLEGCOL; WRITE(*,'(A)') 'IFFLEGCOL=',IFFLEGCOL
  ENDIF
 ENDIF

 !## read genname (optional)
 NGEN=0;
 IF(UTL_READINITFILE('NGEN',LINE,IU,1))THEN
  READ(LINE,*) NGEN; WRITE(*,'(A,I10)') 'NGEN=',NGEN
  ALLOCATE(GENNAME(NGEN),GENCOLOUR(NGEN),GENTHICKNESS(NGEN))
  DO I=1,NGEN
   IF(.NOT.UTL_READINITFILE('GENFILE'//TRIM(ITOS(I)),LINE,IU,0))RETURN
   READ(LINE,*) GENNAME(I)
   LINE='GENFILE'//TRIM(ITOS(I))//'='//TRIM(GENNAME(I))
   WRITE(*,'(A)') TRIM(LINE)
   GENCOLOUR(I)=WRGB(0,0,0)
   IF(UTL_READINITFILE('GENCOLOUR'//TRIM(ITOS(I)),LINE,IU,1))THEN
    READ(LINE,*) IR,IG,IB; GENCOLOUR(I)=WRGB(IR,IG,IB)
    LINE='GENCOLOUR'//TRIM(ITOS(I))//'=('//TRIM(ITOS(IR))//','//TRIM(ITOS(IG))//','//TRIM(ITOS(IB))//') '//TRIM(ITOS(GENCOLOUR(I)))
    WRITE(*,'(A)') TRIM(LINE)
   ENDIF
   GENTHICKNESS(I)=1
   IF(UTL_READINITFILE('GENTHICKNESS'//TRIM(ITOS(I)),LINE,IU,1))THEN
    READ(LINE,*) GENTHICKNESS(I)
    LINE='GENTHICKNESS'//TRIM(ITOS(I))//'='//TRIM(ITOS(GENTHICKNESS(I)))
    WRITE(*,'(A)') TRIM(LINE)
   ENDIF
  ENDDO
 ENDIF

 !## read top25 reference
 IF(UTL_READINITFILE('TOP25',LINE,IU,1))THEN
  READ(LINE,*) PREFVAL(2); WRITE(*,'(A)') 'TOP25'//'='//TRIM(PREFVAL(2))
 ENDIF
 
 !## read outname
 IF(.NOT.UTL_READINITFILE('OUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) OUTNAME
 WRITE(*,'(A)') 'OUTFILE='//TRIM(OUTNAME)
 IF(INDEX(UTL_CAP(OUTNAME,'U'),'.BMP').EQ.0.AND. &
    INDEX(UTL_CAP(OUTNAME,'U'),'.PCX').EQ.0.AND. &
    INDEX(UTL_CAP(OUTNAME,'U'),'.JPG').EQ.0.AND. &
    INDEX(UTL_CAP(OUTNAME,'U'),'.PNG').EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot recognize file extent:'//CHAR(13)//'OUT='//TRIM(OUTNAME),'Error')
  RETURN
 ENDIF

 !## read LEGPLOT_PLOT (optional)
 FIG(1)='TITLE'; FIG(2)='SUBTITLE'; FIG(3)='FIGTXT'; FIG(4)='PRJTXT'
 NFIG  =0
 DO I=1,SIZE(FIG)
  IF(UTL_READINITFILE(FIG(I),LINE,IU,1))THEN
   READ(LINE,*,IOSTAT=IOS) FIG(I)
   IF(IOS.NE.0)THEN
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot read figure properties:'//CHAR(13)// &
      TRIM(FIG(I))//'='//TRIM(LINE),'Error')
    RETURN
   ENDIF
   NFIG=NFIG+1
  ENDIF
 ENDDO
 IF(NFIG.EQ.4)THEN
  WRITE(*,'(A)') 'TITLE='//TRIM(FIG(1))
  WRITE(*,'(A)') 'SUBTITLE='//TRIM(FIG(2))
  WRITE(*,'(A)') 'FIGTXT='//TRIM(FIG(3))
  WRITE(*,'(A)') 'PRJTXT='//TRIM(FIG(4))
 ENDIF
 
 YFRACLEGEND=100.0D0
 IF(UTL_READINITFILE('YFRACLEGEND',LINE,IU,1))THEN
  READ(LINE,*) YFRACLEGEND; WRITE(*,'(A,F10.1)') 'YFRACLEGEND=',YFRACLEGEND
 ENDIF

 RESOLUTION=3200
 IF(UTL_READINITFILE('RESOLUTION',LINE,IU,1))THEN
  READ(LINE,*) RESOLUTION; WRITE(*,'(A,I10)') 'RESOLUTION=',RESOLUTION
 ENDIF
 
 !## read extent (optional)
 XMIN=0.0D0; XMAX=0; YMIN=0.0D0; YMAX=0.0D0
 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*,IOSTAT=IOS) XMIN,YMIN,XMAX,YMAX
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot read extent properly:'//CHAR(13)//'EXT='//TRIM(LINE),'Error')
   RETURN
  ENDIF
  WRITE(*,'(A,4F10.2)') 'WINDOW=',XMIN,YMIN,XMAX,YMAX
 ENDIF

 CALL WBITMAPALLOC(40)
 CALL WINDOWOPEN(FLAGS=SYSMENUON+HIDEWINDOW+STATUSBAR)
 CALL WINDOWSTATUSBARPARTS(4,(/2000,2000,750,-1/),(/1,1,1,1/))
 CALL WMENU(ID_MAINMENU1,0)
 CALL WMENUTOOLBAR(ID_TOOLBAR1,0,1)

 LIND=.FALSE.
 IF(IPFASSFILES(1).GT.0.AND.IPFASSFILES(2).GE.0)THEN
  JU=UTL_GETUNIT(); CALL OSD_OPEN(JU,FILE=IPFNAME,STATUS='OLD',ACTION='READ,DENYWRITE')
  READ(JU,*) N; ALLOCATE(XY(N,2)); READ(JU,*) M; DO I=1,M; READ(JU,*); ENDDO; ALLOCATE(STRING(M))
  READ(JU,*) IEXT; ALLOCATE(CLABEL(N))
  IF(IEXT.EQ.0)THEN; WRITE(*,'(A)') 'Cannot plot associated files whenever IEXT=0'; STOP; ENDIF
  DO I=1,N
   READ(JU,*) (STRING(J),J=1,M)
   READ(STRING(IPFICOL(1)),*) XY(I,1); READ(STRING(IPFICOL(2)),*) XY(I,2); READ(STRING(IEXT),*) CLABEL(I)
  ENDDO
  CLOSE(JU)
  II1=1; II2=N; IF(IPFASSFILES(2).EQ.2)THEN; II1=IPFASSFILES(2); II2=II1; ENDIF
  LIND=.TRUE.
 ELSE
  II1=1; II2=1
 ENDIF
 
 !## 24-bits colour application
 CALL IGRCOLOURMODEL(24)
 !## load datamanager in memory
 CALL MANAGER_UTL_INIT()
 !## initialize colours
 CALL PREFCOLOURSINIT(.FALSE.)
 !## initiate lines in graphs
 CALL IPFANALYSE_INIT_GRAPHVARIABLES()
 !## remove backslash in labeling on default
 IBACKSLASH=1; ILABELNAME=0

 ICOLOR(1)=WRGB(255,0,0)
 ICOLOR(2)=WRGB(0,255,0)
 ICOLOR(3)=WRGB(0,0,255)

 !## initialize iMOD
 CALL IMODINIT()

 DO II=II1,II2
  
  IF(LIND)THEN
   I=INDEX(CLABEL(II),'\',.TRUE.); IF(I.NE.0)CLABEL(II)=CLABEL(II)(I+1:)
   BMPOUTNAME=OUTNAME(:INDEX(OUTNAME,'.',.TRUE.)-1)//'_'//TRIM(CLABEL(II))
   BMPOUTNAME=TRIM(BMPOUTNAME)//TRIM(OUTNAME(INDEX(OUTNAME,'.',.TRUE.):))
   FIG(2)=CLABEL(II)
   IPFASSFILES(2)=II
   XMIN=XY(II,1)-1000.0D0
   XMAX=XY(II,1)+1000.0D0
   YMIN=XY(II,2)-1000.0D0
   YMAX=XY(II,2)+1000.0D0
   WRITE(*,'(I5.5,A,I5.5,A)') II,'-',N,' Busy with '//TRIM(CLABEL(II))
   WRITE(*,'(5X,A)') 'Saving: '//TRIM(BMPOUTNAME)
  ELSE
   BMPOUTNAME=OUTNAME   
  ENDIF

  IF(LEN_TRIM(IDFNAME).NE.0)CALL MANAGER_UTL_ADDFILE(IDFNAMEGIVEN=IDFNAME,LEGNAME=IDFLEGNAME,ISTYLE=IDFSTYLE,LDEACTIVATE=.FALSE.)
  IF(LEN_TRIM(IPFNAME).NE.0)THEN
   IF(NLABELS.EQ.0)THEN
    CALL MANAGER_UTL_ADDFILE(IDFNAMEGIVEN=IPFNAME,LEGNAME=IPFLEGNAME,ISTYLE=IPFSTYLE,LDEACTIVATE=.FALSE., &
                 IPFICOL=IPFICOL,IPFASSFILES=IPFASSFILES)
   ELSE
    CALL MANAGER_UTL_ADDFILE(IDFNAMEGIVEN=IPFNAME,LEGNAME=IPFLEGNAME,ISTYLE=IPFSTYLE,LDEACTIVATE=.FALSE., &
                 IPFICOL=IPFICOL,ILABELS=ILABELS,IPFASSFILES=IPFASSFILES)
   ENDIF
  ENDIF
  IF(LEN_TRIM(IFFNAME).NE.0)CALL MANAGER_UTL_ADDFILE(IDFNAMEGIVEN=IFFNAME,LEGNAME=IFFLEGNAME,ISTYLE=IFFSTYLE,LDEACTIVATE=.FALSE.)
  DO I=1,NGEN; CALL GEN_INIT(GENNAME=GENNAME(I),LDEACTIVATE=.FALSE.,GENCOLOUR=GENCOLOUR(I),GENTHICKNESS=GENTHICKNESS(I)); ENDDO

  IF(NFIG.EQ.4)THEN
   !## bitmap size ... screensize --- vierkant
   MPW%DIX=RESOLUTION 
   MPW%DIY=RESOLUTION 
  ELSE
   RAT=(MPW%XMAX-MPW%XMIN)/(MPW%YMAX-MPW%YMIN)
   IF(RAT.GE.1.0D0)THEN
    MPW%DIX=RESOLUTION 
    MPW%DIY=MPW%DIX/RAT
   ELSE
    MPW%DIY=RESOLUTION 
    MPW%DIX=MPW%DIY*RAT
   ENDIF
  ENDIF
  IF(XMAX-XMIN.EQ.0.0D0)THEN
   !## draw in case no window is specified
   CALL IDFPLOT(1)
   !## if no idf/ipf plotted, use gen for zoom-extent
   IF(LEN_TRIM(IDFNAME).EQ.0.AND.LEN_TRIM(IPFNAME).EQ.0)THEN
    CALL WDIALOGSELECT(ID_DMANAGER)
    CALL WDIALOGSETTAB(ID_DMTAB,ID_DMANAGERTAB2)
   ENDIF
   CALL IDFZOOM(ID_ZOOMFULLMAP,0.0D0,0.0D0,0)
  ELSE
   !## set zoom level (all)
   MPW%XMIN=XMIN
   MPW%YMIN=YMIN
   MPW%XMAX=XMAX
   MPW%YMAX=YMAX
   CALL IDFZOOM(ID_DGOTOXY,0.0D0,0.0D0,0)
  ENDIF

  CALL WMENUSETSTATE(ID_SHOWSCALEBAR,2,0)
  CALL WMENUSETSTATE(ID_HIGHACCURACY,2,0)
  CALL WMENUSETSTATE(ID_EXCELLENTACCURACY,2,1)
  IF(PREFVAL(2).NE.'')CALL WMENUSETSTATE(ID_TOPOGRAPHY,2,1)
  !## set transparancy values  
  IF(IDFTRANSTOPO.EQ.1)THEN
!   CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY,2,1)
   IF(ITPER(1).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY0,2,1)
   IF(ITPER(2).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY10,2,1)
   IF(ITPER(3).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY25,2,1)
   IF(ITPER(4).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY50,2,1)
   IF(ITPER(5).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY75,2,1)
   IF(ITPER(6).EQ.1)CALL WMENUSETSTATE(ID_TOPOTRANSPARANCY90,2,1)
  ENDIF 
  CALL IDFPLOT(1)

  !## create drawing
  IBITMAP=0
  IF(NFIG.EQ.4)THEN
   CALL IMODBATH_PLOTFIG((/IDFLEGCOL,IPFLEGCOL,IFFLEGCOL/),YFRACLEGEND,(/IDFLEGTXT,IPFLEGTXT,IFFLEGTXT/),IBITMAP)
  ELSE
   IBITMAP=MPW%IBITMAP
  ENDIF
  CALL UTL_CREATEDIR(OUTNAME(1:INDEX(OUTNAME,'\',.TRUE.)-1))
  
  I=INFOERROR(1)
  CALL WBITMAPSAVE(IBITMAP,BMPOUTNAME)
  I=INFOERROR(1)
  CALL WBITMAPDESTROY(MPW%IBITMAP)
  IF(IBITMAP.NE.0)CALL WBITMAPDESTROY(IBITMAP) 
 ENDDO

 CALL WINDOWCLOSECHILD(MPW%IWIN)

 IF(ALLOCATED(XY))DEALLOCATE(XY)
 IF(ALLOCATED(STRING))DEALLOCATE(STRING)
 IF(ALLOCATED(CLABEL))DEALLOCATE(CLABEL)
 
 END SUBROUTINE IMODBATCH_PLOT_MAIN

 !###======================================================================
 SUBROUTINE IMODBATH_PLOTFIG(LEGCOL,YFRACLEGEND,LEGTXT,IBITMAP)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: YFRACLEGEND
 INTEGER,INTENT(IN),DIMENSION(3) :: LEGCOL
 INTEGER,INTENT(OUT) :: IBITMAP
 CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: LEGTXT
 INTEGER :: I,J
 REAL(KIND=DP_KIND) :: XP,YP,ACC,GR,LT,LB,LB1,X1,X2,Y1,Y2,BH,BND,PB,FB,TBND,DB,AB,DL
 INTEGER :: IHR,IMT,IS,MS,IY,IM,ID,N
 CHARACTER(LEN=50) :: STRING

 BND =5.0D0     !## witte rand
 XP  =420.0D0   !## paper width
 YP  =297.0D0   !## paper heigth
 GR  =YP        !## graph area right
 BH  =YP-40.0D0 !## title bot area
 LT  =YP-75.0D0 !## legend top area
 LB  =65.0D0    !## legend bot area
 AB  =45.0D0    !## axes bot area
 PB  =19.0D0    !## project
 FB  =15.0D0    !## figure number
 DB  =10.0D0    !## date
 TBND=BND+BND
 
 ACC=5.0D0

 !## create 'mother' bitmap for current coordinates
 CALL WBITMAPCREATE(IBITMAP,INT(XP*ACC),INT(YP*ACC))

 CALL IGRSELECT(DRAWBITMAP,IBITMAP)
 CALL IGRPLOTMODE(MODECOPY)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(0.0D0,0.0D0,XP,YP)

 !## legend area
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRFILLPATTERN(SOLID)
 CALL DBL_IGRRECTANGLE(GR,AB,XP-BND,LT)

 !## top text
 CALL IGRCOLOURN(WRGB(123,152,168))
 CALL DBL_IGRRECTANGLE(GR,LT,XP-BND,YP-BND)            

 !## bottom text
 CALL IGRCOLOURN(WRGB(123,152,168)) !0,102,161))
 CALL DBL_IGRRECTANGLE(GR,0.0D0+BND,XP-BND,AB)          
 
  !## main window
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL DBL_IGRRECTANGLE(0.0D0+BND,0.0D0+BND,GR-BND,YP-BND)  

 Y1=0.03333D0
 X1=Y1/(0.03333D0/0.01333D0)

 !## header/title
 CALL DBL_WGRTEXTFONT(IFAMILY=FFHELVETICA,TWIDTH=X1,THEIGHT=Y1,ISTYLE=FSBOLD)
 CALL DBL_WGRTEXTORIENTATION(IALIGN=ALIGNLEFT)
 CALL IGRCOLOURN(WRGB(0,0,0))
 CALL DBL_WGRTEXTBLOCK(GR+BND,BH,XP-TBND,YP-TBND,TRIM(FIG(1)),1.0D0)
 !## sub-header
 CALL DBL_WGRTEXTFONT(IFAMILY=FFHELVETICA,TWIDTH=X1/2.0D0,THEIGHT=Y1/2.0D0,ISTYLE=0) 
 CALL DBL_WGRTEXTBLOCK(GR+BND,LT+0.5D0*TBND,XP-TBND,BH-TBND,TRIM(FIG(2)),1.0D0)

 !## projectlabel
 CALL DBL_WGRTEXTFONT(IFAMILY=FFHELVETICA,TWIDTH=X1/2.0D0,THEIGHT=Y1/2.0D0,ISTYLE=FSITALIC)
 CALL DBL_WGRTEXTBLOCK(GR+BND,PB,XP-TBND,AB-2.5D0,'Project: '//CHAR(13)//TRIM(FIG(4)),1.0D0) 
 !## figure
 CALL DBL_WGRTEXTSTRING(GR+BND,FB,'Figure/report: '//TRIM(FIG(3)))
 !## date
 CALL IOSTIME(IHR,IMT,IS,MS)
 CALL IOSDATE(IY,IM,ID)
 CALL WDATETOSTRING(STRING,IY,IM,ID,DATELONGMONTH+DATENOLEADZERO,'-')
 STRING=TRIM(STRING)//' '//TRIM(ITOS(IHR))//':'//TRIM(ITOS(IMT))//':'//TRIM(ITOS(IS))
 CALL DBL_WGRTEXTSTRING(GR+BND,DB,'Creation Date/time: '//TRIM(STRING))

 CALL DBL_WGRTEXTORIENTATION(IALIGN=ALIGNRIGHT,ANGLE=0.0D0)
 CALL DBL_WGRTEXTFONT(IFAMILY=FFHELVETICA,TWIDTH=X1/3.0D0,THEIGHT=Y1/3.0D0,ISTYLE=0)
 CALL DBL_WGRTEXTSTRING(XP-BND,0.0D0+0.5D0*BND,'Powered by '//TRIM(UTL_IMODVERSION())//' Copyright © 2005-2020')

 CALL IMODBATH_PLOTFIG_DIM(MPW%IBITMAP,X1,X2,Y1,Y2,GR,YP)
 Y1=Y1+BND
 Y2=Y2-BND
 X1=X1+BND
 X2=X2-BND
 CALL DBL_IGRAREA(X1/XP,Y1/YP,X2/XP,Y2/YP)
 CALL WBITMAPPUT(MPW%IBITMAP,2,1)

 CALL IGRFILLPATTERN(OUTLINE)
 CALL IGRCOLOURN(WRGB(0,0,0))
 CALL IGRLINEWIDTH(1)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRRECTANGLE(0.0D0,0.0D0,XP,YP)

 N=0; DO I=1,MXMPLOT; IF(.NOT.MP(I)%IACT)CYCLE; N=N+1; ENDDO
  
 DL=0.0D0; IF(N.GT.0)DL =(YFRACLEGEND/DBLE(N))/100.0D0*(LT-LB)
 LB1=LT-DL
 
 DO I=1,MXMPLOT
  IF(.NOT.MP(I)%IACT)CYCLE
  IF(MP(I)%IPLOT.EQ.1)MP(I)%LEG%HEDTXT=LEGTXT(1)  !## idf
  IF(MP(I)%IPLOT.EQ.2)MP(I)%LEG%HEDTXT=LEGTXT(2)  !## ipf
  IF(MP(I)%IPLOT.EQ.3)MP(I)%LEG%HEDTXT=LEGTXT(3)  !## iff
 ENDDO
 
 !## plot legend
 DO I=1,MXMPLOT
  IF(.NOT.MP(I)%IACT)CYCLE
  
  X1=GR+BND
  Y1=LB1+BND
  X2=XP-BND-BND
  Y2=LT-BND
  CALL DBL_IGRAREA(X1/XP,Y1/YP,X2/XP,Y2/YP)
  CALL DBL_IGRUNITS(0.0D0,0.0D0,1.0D0,1.0D0) !yfraclegend/100.0D0) !1.0D0)
  J=MP(I)%IPLOT
  IF(LEGCOL(J).GT.0)CALL LEGPLOT_PLOT(MP(I)%LEG,LEGCOL(J),J,ISYMBOL=MP(I)%SYMBOL)  !## plot legend for iplot=1, nc=2 columns

  LT=LT-DL
  LB1=LB1-DL
  
 ENDDO
 
 !!## put deltares logo
 !CALL WBITMAPGETRESOURCE(ILOGO,ID_ICONTNO)
 !CALL IMODBATH_PLOTFIG_DIM(ILOGO,X1,X2,Y1,Y2,20.0D0,20.0D0)
 !X1=X1+GR
 !X2=X2+GR
 !Y1=Y1+BND
 !Y2=Y2+BND
 !CALL DBL_IGRAREA(X1/XP,Y1/YP,X2/XP,Y2/YP)
 !CALL WBITMAPPUT(ILOGO,2,1)

 CALL DBL_IGRAREA(GR/XP,AB/YP,XP/XP,LB/YP)
 X1=MPW%XMIN+(GR/GR)*(MPW%XMAX-MPW%XMIN)
 Y1=MPW%YMIN+(AB/YP)*(MPW%YMAX-MPW%YMIN)
 X2=MPW%XMIN+(XP/GR)*(MPW%XMAX-MPW%XMIN)
 Y2=MPW%YMIN+(LB/YP)*(MPW%YMAX-MPW%YMIN)
 CALL DBL_IGRUNITS(X1,Y1,X2,Y2)
 
 SB_XP1=GR/XP 
 SB_YP1=AB/YP 
 SB_XP2=(XP-BND)/XP
 SB_YP2=LB/YP 
 
 CALL IDFPLOT_FEATURES_SCALE() !

 END SUBROUTINE IMODBATH_PLOTFIG

 !###======================================================================
 SUBROUTINE IMODBATH_PLOTFIG_DIM(IBITMAP,X1,X2,Y1,Y2,XW,XH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBITMAP
 REAL(KIND=DP_KIND),INTENT(IN) :: XW,XH
 REAL(KIND=DP_KIND),INTENT(OUT) :: X1,X2,Y1,Y2
 INTEGER :: IW,IH
 REAL(KIND=DP_KIND) :: RAT

 !## put bitmap
 IW=WINFOBITMAP(IBITMAP,BITMAPWIDTH)
 IH=WINFOBITMAP(IBITMAP,BITMAPHEIGHT)
 RAT=REAL(IW)/REAL(IH)
 IF(RAT.GT.1.0D0)THEN
  Y1=(XH-(XH/RAT))/2.0; Y2= Y1+XH/RAT; X1=0.0D0; X2=XW
 ELSEIF(RAT.LT.1.0D0)THEN
  X1=(XW-(XW*RAT))/2.0; X2= X1+XW*RAT; Y1=0.0D0; Y2=XH
 ELSE
  X1=0.0D0; Y1=0.0D0; X2=XW; Y2=XH
 ENDIF

 END SUBROUTINE IMODBATH_PLOTFIG_DIM

 !###======================================================================
 SUBROUTINE IMODBATCH_FLUMY()
 !###======================================================================
 USE MOD_BATCH_FLUMY
 IMPLICIT NONE
 INTEGER :: I,NPAR
 CHARACTER(LEN=256) :: IPFFNAME
 
 XOFFSET=0.0D0
 YOFFSET=0.0D0
 ZOFFSET=0.0D0

 IF(.NOT.UTL_READINITFILE('IPFFILE',LINE,IU,0))RETURN
 READ(LINE,*) IPFFNAME; WRITE(*,'(A)') 'IPFFILE='//TRIM(IPFFNAME)
 IF(.NOT.UTL_READINITFILE('NPARAM',LINE,IU,0))RETURN
 READ(LINE,*) NPAR; WRITE(*,'(A,I3)') 'NPARAM=',NPAR
 
 IF(UTL_READINITFILE('ZOFFSET',LINE,IU,1))THEN
  READ(LINE,*) ZOFFSET; WRITE(*,'(A,F3.2)') 'ZOFFSET=',ZOFFSET
 ENDIF
 IF(UTL_READINITFILE('XOFFSET',LINE,IU,1))THEN
  READ(LINE,*) XOFFSET; WRITE(*,'(A,F3.2)') 'XOFFSET=',XOFFSET
 ENDIF
 IF(UTL_READINITFILE('YOFFSET',LINE,IU,1))THEN
  READ(LINE,*) YOFFSET; WRITE(*,'(A,F3.2)') 'YOFFSET=',YOFFSET
 ENDIF

 !## store flumy codes
 ALLOCATE(FLM(NPAR))

 DO I=1,NPAR
  IF(.NOT.UTL_READINITFILE('GRAIN'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) FLM(I)%GRAIN; FLM(I)%GRAIN=UTL_CAP(FLM(I)%GRAIN,'U')
  LINE='GRAIN'//TRIM(ITOS(I))//'='//TRIM(FLM(I)%GRAIN); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('FACIESL'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,'(A)') FLM(I)%FACL; FLM(I)%FACL=UTL_CAP(FLM(I)%FACL,'U')
  LINE='FACIESL'//TRIM(ITOS(I))//'='//TRIM(FLM(I)%FACL); WRITE(*,'(A)') TRIM(LINE)
  IF(.NOT.UTL_READINITFILE('FACIESN'//TRIM(ITOS(I)),LINE,IU,0))RETURN
  READ(LINE,*) FLM(I)%FACN
  LINE='FACIESN'//TRIM(ITOS(I))//'='//TRIM(ITOS(FLM(I)%FACN)); WRITE(*,'(A)') TRIM(LINE)    
 ENDDO

 CALL FLUMY_MAIN(IPFFNAME)
 
 DEALLOCATE(FLM)
 
 END SUBROUTINE IMODBATCH_FLUMY

 !###======================================================================
 SUBROUTINE IMODBATCH_GEOCONNECT()
 !###======================================================================
 USE MOD_GEOCONNECT
 USE MOD_GEOCONNECT_PAR
 IMPLICIT NONE
 
 IF(.NOT.UTL_READINITFILE('IFLAG',LINE,IU,0))RETURN
 READ(LINE,*) GC_IFLAG; WRITE(*,'(A,I1)') 'IFLAG=',GC_IFLAG
 
 IF(GC_IFLAG.EQ.1)THEN
  WRITE(*,'(/A/)')' IFLAG need to be 2 or 3'; STOP
!  IF(GC_INIT_IDENTIFY(IU))
 ELSEIF(GC_IFLAG.EQ.2)THEN
  IF(.NOT.GC_INIT_PREPROCESSING_READ(IU,1))RETURN
 ELSEIF(GC_IFLAG.EQ.3)THEN
  IF(.NOT.GC_INIT_POSTPROCESSING_READ(IU,1))RETURN
 ENDIF
 
 CALL GC_COMPUTE_MAIN(1)

 !## clean memory
 CALL GC_DEALLOCATE()
 
 END SUBROUTINE IMODBATCH_GEOCONNECT
 
 !###======================================================================
 SUBROUTINE IMODBATCH_PLOTRESIDUAL()
 !###======================================================================
 USE MOD_RESIDUALPLOT, ONLY : RESIDUAL_MAIN
 USE MOD_RESIDUALPLOT_PAR
 IMPLICIT NONE
 INTEGER,DIMENSION(6) :: ICOL
 INTEGER :: I
 
 IPLOT=1; ITRANSIENT=0; NLAYER=0; NIPFS=0; NRDATE=0; IWEIGHT=0; ICOL=0; IAVERAGE=0; IXY=0
 
 IF(.NOT.UTL_READINITFILE('INPUTFILE',LINE,IU,0))RETURN
 READ(LINE,*) INPUTFILE; WRITE(*,'(A)') 'INPUTFILE='//TRIM(INPUTFILE)
 
 IF(.NOT.UTL_READINITFILE('ITRANSIENT',LINE,IU,0))RETURN
 READ(LINE,*) ITRANSIENT; WRITE(*,'(A,I1)') 'ITRANSIENT=',ITRANSIENT
 
 !## decide whether average/all
 IF(ITRANSIENT.EQ.1)THEN
  IF(UTL_READINITFILE('IAVERAGE',LINE,IU,1))READ(LINE,*) IAVERAGE
  WRITE(*,'(A,I1)') 'IAVERAGE=',IAVERAGE
 ENDIF
 
 IF(UTL_READINITFILE('IXY',LINE,IU,1))THEN
  READ(LINE,*) IXY; WRITE(*,'(A,I1)') 'IXY=',IXY
  IF(IXY.EQ.1)THEN
   IF(.NOT.UTL_READINITFILE('XMAX',LINE,IU,0))RETURN
   READ(LINE,*) XMAX; WRITE(*,'(A,F15.3)') 'XMAX=',XMAX
   IF(.NOT.UTL_READINITFILE('XMIN',LINE,IU,0))RETURN
   READ(LINE,*) XMIN; WRITE(*,'(A,F15.3)') 'XMIN=',XMIN
   IF(.NOT.UTL_READINITFILE('YMAX',LINE,IU,0))RETURN
   READ(LINE,*) YMAX; WRITE(*,'(A,F15.3)') 'YMAX=',YMAX
   IF(.NOT.UTL_READINITFILE('YMIN',LINE,IU,0))RETURN
   READ(LINE,*) YMIN; WRITE(*,'(A,F15.3)') 'YMIN=',YMIN
  ENDIF
 ENDIF
 
 IF(INDEX(UTL_CAP(INPUTFILE,'U'),'IPF').GT.0)THEN
  ICOL(1)=1; IF(UTL_READINITFILE('IXCOL',LINE,IU,1))READ(LINE,*) ICOL(1)
  WRITE(*,'(A,I1)') 'IXCOL=',ICOL(1)
  ICOL(2)=2; IF(UTL_READINITFILE('IYCOL',LINE,IU,1))READ(LINE,*) ICOL(2)
  WRITE(*,'(A,I1)') 'IYCOL=',ICOL(2)   
  !## read only whenever steady-state
  ICOL(3)=2; IF(UTL_READINITFILE('IMCOL',LINE,IU,1))READ(LINE,*) ICOL(3)
  WRITE(*,'(A,I1)') 'IMCOL=',ICOL(3)
  ICOL(4)=3; IF(UTL_READINITFILE('IHCOL',LINE,IU,1))READ(LINE,*) ICOL(4)
  WRITE(*,'(A,I1)') 'IHCOL=',ICOL(4)
  ICOL(5)=0; IF(UTL_READINITFILE('IWCOL',LINE,IU,1))READ(LINE,*) ICOL(5)
  WRITE(*,'(A,I1)') 'IWCOL=',ICOL(5)
  ICOL(6)=0; IF(UTL_READINITFILE('ILCOL',LINE,IU,1))READ(LINE,*) ICOL(6)
  WRITE(*,'(A,I1)') 'ILCOL=',ICOL(6)
 ENDIF
 
 IF(.NOT.UTL_READINITFILE('IPLOT',LINE,IU,0))RETURN
 READ(LINE,*) IPLOT; WRITE(*,'(A,I1)') 'IPLOT=',IPLOT
 SELECT CASE (IPLOT)
  CASE (1:2) 
   IF(.NOT.UTL_READINITFILE('BMPNAME',LINE,IU,0))RETURN
   READ(LINE,*) BMPNAME; WRITE(*,'(A)') 'BMPNAME='//TRIM(BMPNAME)
  CASE (3)
   IF(.NOT.UTL_READINITFILE('IPFNAME',LINE,IU,0))RETURN
   READ(LINE,*) IPFNAME; WRITE(*,'(A)') 'IPFNAME='//TRIM(IPFNAME)
  CASE DEFAULT
   WRITE(*,'(/A/)') 'IPLOT NEED TO BE 1,2 OR 3'; STOP
 END SELECT
 
 IF(.NOT.UTL_READPOINTER(IU,NLAYER,ILAYER,'ILAYER',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NIPFS,IIPFS,'IIPF',1))RETURN
 IF(.NOT.UTL_READPOINTER(IU,NRDATE,IRDATE,'IDATE',1))RETURN
 
 IF(UTL_READINITFILE('IWEIGHT',LINE,IU,1))READ(LINE,*) IWEIGHT
 WRITE(*,'(A,I1)') 'IWEIGHT=',IWEIGHT 

 !## read weight-class
 WC1=0.0D0; IF(UTL_READINITFILE('WC1',LINE,IU,1))THEN
  READ(LINE,*) WC1; WRITE(*,'(A,F10.2)') 'WC1=',WC1 
 ENDIF
 WC2=0.0D0; IF(UTL_READINITFILE('WC2',LINE,IU,1))THEN
  READ(LINE,*) WC2; WRITE(*,'(A,F10.2)') 'WC2=',WC2
 ENDIF
 
 IF(.NOT.UTL_READPOINTER_REAL(IU,I,HCLASSES,'HCLASSES',1))RETURN 
 IF(ASSOCIATED(HCLASSES))THEN
  DO I=2,SIZE(HCLASSES)
   LINE='CLASS('//TRIM(ITOS(I-1))//')='//TRIM(RTOS(HCLASSES(I-1),'F',3))//' - '//TRIM(RTOS(HCLASSES(I),'F',3))
   WRITE(*,'(A)') TRIM(LINE)
   IF(HCLASSES(I).LE.HCLASSES(I-1))THEN
    WRITE(*,'(A)') 'Current class is not correct'; STOP
   ENDIF
  ENDDO
 ELSE
  ALLOCATE(HCLASSES(23)); HCLASSES=0.0D0
 ENDIF
 ALLOCATE(XCLASSES(SIZE(HCLASSES)-1))
 
 !## call residual-main routine
 CALL RESIDUAL_MAIN(ICOL)
 
 END SUBROUTINE IMODBATCH_PLOTRESIDUAL

 !###======================================================================
 SUBROUTINE IMODBATCH_ADJUSTVOXELIDF()
 !###======================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ) :: IDF
 CHARACTER(LEN=528) :: LINE,DIRNAME,IDFFILE,IDFNAME
 CHARACTER(LEN=52) :: WC
 REAL(KIND=DP_KIND) :: VOXELOFFSET
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: LISTNAME
 INTEGER :: I
 
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) DIRNAME
 IF(.NOT.UTL_READINITFILE('VOXELOFFSET',LINE,IU,0))RETURN
 READ(LINE,*) VOXELOFFSET  
  
 IDFFILE    =DIRNAME(INDEX(DIRNAME,'\',.TRUE.)+1:)
 WC         =IDFFILE
 DIRNAME=DIRNAME(:INDEX(DIRNAME,'\',.TRUE.)-1)
 
 IF(.NOT.UTL_DIRINFO_POINTER(DIRNAME,WC,LISTNAME,'F'))THEN; STOP 'No files found'; ENDIF

 DO I=1,SIZE(LISTNAME)
  IDFNAME=LISTNAME(I)
  IDFNAME=IDFNAME(:INDEX(IDFNAME,'.',.TRUE.)-1)
  LISTNAME(I)=TRIM(DIRNAME)//'\'//TRIM(LISTNAME(I))
  IF(.NOT.IDFREAD(IDF,LISTNAME(I),1))THEN; WRITE(*,'(A)') 'Cannot read '//TRIM(LISTNAME(I)); STOP; ENDIF
  IF(IDF%ITB.EQ.0)THEN; WRITE(*,'(A)') TRIM(LISTNAME(I))//' is not a voxel IDF'; STOP; ENDIF
  IDF%TOP=IDF%TOP+VOXELOFFSET
  IDF%BOT=IDF%BOT+VOXELOFFSET
  CLOSE(IDF%IU)
  CALL UTL_CREATEDIR(TRIM(DIRNAME)//'\OFFSET\')
  IDFNAME=TRIM(DIRNAME)//'\OFFSET\'//TRIM(IDFNAME)//'.IDF'
  IF(.NOT.IDFWRITE(IDF,IDFNAME,1))THEN;WRITE(*,'(A)') 'Cannot write '//TRIM(LISTNAME(I)); STOP; ENDIF
  WRITE(*,*) 'Writing IDF: '//TRIM(LISTNAME(I))
 ENDDO 
 
 END SUBROUTINE IMODBATCH_ADJUSTVOXELIDF

 !###======================================================================
 SUBROUTINE IMODBATCH_MFTOIMOD()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: MFFNAME,OUTNAME,IDFNAME
 
 IDFNAME=''
 
 IF(.NOT.UTL_READINITFILE('MFFNAME',LINE,IU,0))RETURN
 READ(LINE,*) MFFNAME; WRITE(*,'(A)') 'MFFNAME='//TRIM(MFFNAME)
 IF(.NOT.UTL_READINITFILE('OUTNAME',LINE,IU,0))RETURN
 READ(LINE,*) OUTNAME; WRITE(*,'(A)') 'OUTNAME='//TRIM(OUTNAME)
 IF(UTL_READINITFILE('IDFNAME',LINE,IU,1))THEN
  READ(LINE,*) IDFNAME; WRITE(*,'(A)') 'IDFNAME='//TRIM(IDFNAME)
 ENDIF
 
 CALL IMPORT_MF2005_MAIN(MFFNAME,OUTNAME,IDFNAME)
 
 END SUBROUTINE IMODBATCH_MFTOIMOD
 
 !###======================================================================
 SUBROUTINE IMODBATH_CREATEPILOTPOINTS_IPF()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IPFOBS,IPFMES,IPFPPS
 CHARACTER(LEN=2) :: PTYPE
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XP,YP !## list of points
 REAL(KIND=DP_KIND) :: DCLUSTER,DX,DY
 INTEGER :: I,J,NBORDER,PPTYPE,IG,IL
 TYPE(IDFOBJ) :: IDF
 
 NIPF=2; CALL IPFALLOCATE()
 
 IF(.NOT.UTL_READINITFILE('IPFOBS',LINE,IU,0))RETURN
 READ(LINE,*) IPFOBS; WRITE(*,'(A)') 'IPFOBS='//TRIM(IPFOBS)
 IPF(2)%NROW=0; IPFMES=''; IF(UTL_READINITFILE('IPFMES',LINE,IU,1))THEN
  READ(LINE,*) IPFMES; WRITE(*,'(A)') 'IPFMES='//TRIM(IPFMES)
 ENDIF
 DO I=1,2; IPF(I)%XCOL=1; IPF(I)%YCOL=2; IPF(I)%QCOL=1; IPF(I)%ZCOL=1; IPF(I)%Z2COL=1; ENDDO
 IPF(1)%FNAME=IPFOBS; IF(.NOT.IPFREAD2(1,1,1))RETURN
 IF(IPFMES.NE.'')THEN; IPF(2)%FNAME=IPFMES; IF(.NOT.IPFREAD2(2,1,1))RETURN; ENDIF

 IF(.NOT.UTL_READINITFILE('IPFPPS',LINE,IU,0))RETURN
 READ(LINE,*) IPFPPS; WRITE(*,'(A)') 'IPFPPS='//TRIM(IPFPPS)
 
 IF(UTL_READINITFILE('IDF',LINE,IU,1))THEN
  READ(LINE,*) IDF%FNAME; WRITE(*,'(A)') 'IDF='//TRIM(IDF%FNAME)
  IF(.NOT.IDFREAD(IDF,IDF%FNAME,1))STOP
 ENDIF
 
 !## cluster points
 DCLUSTER=0.0D0
 IF(UTL_READINITFILE('DCLUSTER',LINE,IU,1))READ(LINE,*) DCLUSTER
 WRITE(*,'(A)') 'DCLUSTER='//TRIM(RTOS(DCLUSTER,'F',3))

 !## number of points along the border
 NBORDER=1
 IF(UTL_READINITFILE('NBORDER',LINE,IU,1))READ(LINE,*) NBORDER
 WRITE(*,'(A)') 'NBORDER='//TRIM(ITOS(NBORDER))
 !## layer number 
 IL=1
 IF(UTL_READINITFILE('ILAYER',LINE,IU,1))READ(LINE,*) IL
 WRITE(*,'(A)') 'ILAYER='//TRIM(ITOS(IL))
 !## group number
 IG=1
 IF(UTL_READINITFILE('IGROUP',LINE,IU,1))READ(LINE,*) IG
 WRITE(*,'(A)') 'IGROUP='//TRIM(ITOS(IG))
  
 PPTYPE=1
 IF(UTL_READINITFILE('PPTYPE',LINE,IU,1))READ(LINE,*) PPTYPE
 WRITE(*,'(A)') 'PPTYPE='//TRIM(ITOS(PPTYPE))
 SELECT CASE (PPTYPE)
  CASE (0); WRITE(*,'(A)') 'ORIGINAL (CLUSTERED) POINTS USED FOR PILOTPOINTS'
  CASE (1); WRITE(*,'(A)') 'DELAUNEY (CIRCUMCENTER) POINTS USED FOR PILOTPOINTS'
  CASE (2); WRITE(*,'(A)') 'INCENTER POINTS USED FOR PILOTPOINTS'
  CASE (3); WRITE(*,'(A)') 'MIDPOINTS POITNS USED FOR PILOTPOINTS'
 END SELECT
 
 PTYPE='KH'
 IF(UTL_READINITFILE('PTYPE',LINE,IU,1))READ(LINE,*) PTYPE
 WRITE(*,'(A)') 'PTYPE='//TRIM(PTYPE)

 N=IPF(2)%NROW+IPF(1)%NROW+(4*NBORDER)
 
 ALLOCATE(XP(N),YP(N))
 N=4*NBORDER
 DO I=1,IPF(2)%NROW; XP(N+I)=IPF(2)%XYZ(1,I); YP(N+I)=IPF(2)%XYZ(2,I); ENDDO
 N=4*NBORDER+IPF(2)%NROW
 DO I=1,IPF(1)%NROW; XP(N+I)=IPF(1)%XYZ(1,I); YP(N+I)=IPF(1)%XYZ(2,I); ENDDO

 IF(UTL_READINITFILE('WINDOW',LINE,IU,1))THEN
  READ(LINE,*) XP(1),YP(1),XP(3),YP(3)
  WRITE(*,'(A,4F10.2)') 'WINDOW=',XP(1),YP(1),XP(3),YP(3)
  XP(2)=XP(1); XP(4)=XP(3)
  YP(2)=YP(3); YP(4)=YP(1)
 ELSE
  J=4*NBORDER+1
  XP(1)=MINVAL(XP(J:N)); YP(1)=MINVAL(YP(J:N))
  XP(2)=MINVAL(XP(J:N)); YP(2)=MAXVAL(YP(J:N))
  XP(3)=MAXVAL(XP(J:N)); YP(3)=MAXVAL(YP(J:N))
  XP(4)=MAXVAL(XP(J:N)); YP(4)=MINVAL(YP(J:N))
 ENDIF
 DX=(XP(3)-XP(1))/REAL(NBORDER,8)
 DY=(YP(2)-YP(1))/REAL(NBORDER,8)
 J=4; DO I=1,NBORDER-1
  J=J+1; XP(J)=XP(1)+DX*I; YP(J)=YP(2)
  J=J+1; XP(J)=XP(1)+DX*I; YP(J)=YP(1)
  J=J+1; XP(J)=XP(1);      YP(J)=YP(1)+DY*I
  J=J+1; XP(J)=XP(3);      YP(J)=YP(1)+DY*I
 ENDDO
 
 IG=IG-1
 CALL UTL_TRIANGULATION(XP,YP,IPFPPS,DCLUSTER,NBORDER,PTYPE,PPTYPE,IL,IG,IDF)
 
 END SUBROUTINE IMODBATH_CREATEPILOTPOINTS_IPF
 
 !###======================================================================
 SUBROUTINE UTL_TRIANGULATION(XP,YP,IPFPPS,DCLUSTER,NINT,PTYPE,PPTYPE,IL,IG,IDF)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: IPFPPS,PTYPE
 INTEGER,INTENT(IN) :: NINT,PPTYPE,IL
 INTEGER,INTENT(INOUT) :: IG
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 REAL(KIND=DP_KIND),INTENT(IN) :: DCLUSTER
 REAL(KIND=DP_KIND),INTENT(INOUT),DIMENSION(:) :: XP,YP
 TYPE TRIOBJ
  INTEGER,DIMENSION(3) :: IP=0 !## reference to point for triangles
 END TYPE TRIOBJ
 TYPE(TRIOBJ),DIMENSION(:),ALLOCATABLE :: TRI
 INTEGER :: I,J,JJ,K,NP,IP,JP,IT,JT,P1,P2,P3,ID,IPT,JU,NT,JD,ND,KU,NPF
 REAL(KIND=DP_KIND) :: D,X,Y,A,A1,A2,A3,A4,XD,YD,F
 REAL(KIND=DP_KIND),DIMENSION(3,4) :: ANGLE
 INTEGER,DIMENSION(2) :: SP !## points of triangles of segment to be adjusted
 INTEGER,DIMENSION(2,3) :: BP !## backup point prior to lawson flip
 INTEGER,ALLOCATABLE,DIMENSION(:) :: DD
 LOGICAL :: LEX
 REAL(KIND=DP_KIND),DIMENSION(2,3) :: T
 
 NP =SIZE(XP)
 NT =SIZE(TRI)
 NPF=IPF(2)%NROW
 
 ALLOCATE(TRI(2*NP)); ALLOCATE(DD(NP))

 !## apply clusters
 DD=0; DO IP=1,NP
  !## aready done
  IF(DD(IP).EQ.1)CYCLE
  XD=XP(IP); YD=YP(IP); ND=1
  DO JP=1,NP
   IF(IP.EQ.JP)CYCLE
   !## discard point that are too near
   D=UTL_DIST(XP(IP),YP(IP),XP(JP),YP(JP))
   IF(D.LE.DCLUSTER)THEN
    !## mark double to be removed
    XD=XD+XP(JP); YD=YD+YP(JP); DD(JP)=1; ND=ND+1
   ENDIF
  ENDDO
  !## set new point exclude corner points and fixed-points
  IF(IP.GT.NPF+4*NINT)THEN
   XD=XD/REAL(ND,8)
   YD=YD/REAL(ND,8)
   !## set new point
   XP(IP)=XD
   YP(IP)=YD
  ENDIF
 ENDDO
 
 !## remove all nodata
 JP=0
 DO IP=1,NP
  IF(DD(IP).EQ.0)THEN
   JP=JP+1
   IF(JP.NE.IP)THEN
    XP(JP)=XP(IP); YP(JP)=YP(IP)
   ENDIF
  ENDIF
 END DO
 NP=JP
 
 !## construct first four triangles, with first point not equal to all sides
 DO IP=NPF+(4*NINT)+1,NP
  IF(XP(IP).NE.XP(1).AND.XP(IP).NE.XP(3).AND. &
     YP(IP).NE.YP(1).AND.YP(IP).NE.YP(3))EXIT
 ENDDO
 IF(IP.GT.NP)STOP 'CANNOT FIND A GOOD STARTING POINT NOT ON THE BOUNDARY'
 TRI(1)%IP(1)=1; TRI(1)%IP(2)=2; TRI(1)%IP(3)=IP !5
 TRI(2)%IP(1)=2; TRI(2)%IP(2)=3; TRI(2)%IP(3)=IP !5
 TRI(3)%IP(1)=3; TRI(3)%IP(2)=4; TRI(3)%IP(3)=IP !5
 TRI(4)%IP(1)=4; TRI(4)%IP(2)=1; TRI(4)%IP(3)=IP !5
 
 !## start with these four triangles
 NT=4

 !## add all remaining points
 DO IP=5,NP
  
  !## skip fixed points
  IF(NPF.GT.0)THEN
   IF(IP.GT.4*NINT.AND.IP.LE.NPF+(4*NINT))CYCLE
  ENDIF
  
  if(ip.eq.np)then
   WRITE(*,*)
   DO IT=1,NT
    WRITE(*,'(4I10)') IT,(TRI(IT)%IP(J),J=1,3)
   ENDDO
  endif
  
  !## find out in what triangle current point is
  DO IT=1,NT
   P1=TRI(IT)%IP(1); P2=TRI(IT)%IP(2); P3=TRI(IT)%IP(3)
   IPT=UTL_POINT_IN_TRIANGLE((/XP(P1),YP(P1)/),(/XP(P2),YP(P2)/),(/XP(P3),YP(P3)/),(/XP(IP),YP(IP)/))
   IF(IPT.NE.0)EXIT
  ENDDO

  !## skip this point as it is on a point of an existing triangle
  IF(IPT.EQ.-1)CYCLE
  
  !## not in any triangle - error
  IF(IT.GT.NT)THEN; WRITE(*,'(/A/)') 'CURRENT POINT NOT IN ANY TRIANGLE, WILL BE SKIPPED'; PAUSE; CYCLE; ENDIF

  !## splits current triangle in three
  TRI(IT)%IP(1)=P1
  TRI(IT)%IP(2)=P2
  TRI(IT)%IP(3)=IP
  
  NT=NT+1
  TRI(NT)%IP(1)=P2
  TRI(NT)%IP(2)=P3
  TRI(NT)%IP(3)=IP

  NT=NT+1
  TRI(NT)%IP(1)=P3
  TRI(NT)%IP(2)=IP
  TRI(NT)%IP(3)=P1

  !## clean all triangle that are zero area
  IT=0; DO
   IT=IT+1
   IF(IT.GT.NT)EXIT
   DO J=1,3
    T(1,J)=XP(TRI(IT)%IP(J))
    T(2,J)=YP(TRI(IT)%IP(J))
   ENDDO
   A=TRIANGLE_AREA(T)
   !## move another triangle if this triangle has a volume
   IF(A.EQ.0.0D0)THEN
    DO I=IT,NT-1
     DO J=1,3; TRI(I)%IP(J)=TRI(I+1)%IP(J); ENDDO
    ENDDO
    NT=NT-1
    IT=IT-1
   ENDIF
  ENDDO

  !## apply a lawson flip to all triangles
  DO IT=1,NT
   if(it.eq.24)then
    write(*,*)
   endif
   
   !## determine angles 
   DO J=1,3
    T(1,J)=XP(TRI(IT)%IP(J))
    T(2,J)=YP(TRI(IT)%IP(J))
   ENDDO
   CALL TRIANGLE_ANGLES(T,ANGLE(:,1))
   write(*,'(I10,3F10.3)') it,angle(:,1)
   
   !## try to apply for a lawson flip
   DO K=1,3
    !## get maximum angle
    IF(ANGLE(K,1).GT.90.0D0)THEN
     ID=TRI(IT)%IP(K)
     !## select the two others points to look for another triangle
     I=0; DO JP=1,3; IF(ID.NE.TRI(IT)%IP(JP))THEN; I=I+1; SP(I)=TRI(IT)%IP(JP); ENDIF; ENDDO  
     IF(I.NE.2)THEN; WRITE(*,'(/A/)') 'CANNOT FIND TWO POINTS OF SELECTED TRIANGLE'; PAUSE; STOP; ENDIF
     !## find triangle thas shares these coordinates
     !## found triangle to be splitted
     DO JT=1,NT; IF(JT.EQ.IT)CYCLE; I=0; DO J=1,3
      IF(TRI(JT)%IP(J).EQ.SP(1).OR.TRI(JT)%IP(J).EQ.SP(2))I=I+1
     ENDDO; IF(I.EQ.2)EXIT; ENDDO
     !## find triangle that shares coordinates
     IF(I.EQ.2)THEN
      write(*,*) IT,JT
      !## backup
      DO JJ=1,3; BP(1,JJ)=TRI(IT)%IP(JJ); ENDDO
      DO JJ=1,3; BP(2,JJ)=TRI(JT)%IP(JJ); ENDDO

      !## find third point that remains in both triangles
      JD=0; DO J=1,3
       IF(TRI(JT)%IP(J).NE.SP(1).AND.TRI(JT)%IP(J).NE.SP(2))THEN; JD=TRI(JT)%IP(J); EXIT; ENDIF
      ENDDO
      !## not in any triangle - error
      IF(JD.EQ.0)THEN; WRITE(*,'(/A/)') 'NO FAR POINT FOUND FOR SELECTED TRIANGLE FOR LAWSON FLIP'; PAUSE; STOP; ENDIF
      
      TRI(IT)%IP(1)=ID
      TRI(IT)%IP(2)=SP(1)
      TRI(IT)%IP(3)=SP(2)
      
      TRI(JT)%IP(1)=JD
      TRI(JT)%IP(2)=SP(1)
      TRI(JT)%IP(3)=SP(2)

      DO J=1,3
       T(1,J)=XP(TRI(IT)%IP(J))
       T(2,J)=YP(TRI(IT)%IP(J))
      ENDDO
      CALL TRIANGLE_ANGLES(T,ANGLE(:,1))
      A1=ANGLE(1,1)*ANGLE(2,1)*ANGLE(3,1)
      WRITE(*,'(A15,5F10.2)') 'OLD TRIANGLE_1',ANGLE(:,1),SUM(ANGLE(:,1)),A1
      DO J=1,3
       T(1,J)=XP(TRI(JT)%IP(J))
       T(2,J)=YP(TRI(JT)%IP(J))
      ENDDO
      CALL TRIANGLE_ANGLES(T,ANGLE(:,2))
      A2=ANGLE(1,2)*ANGLE(2,2)*ANGLE(3,2)
      WRITE(*,'(A15,5F10.2)') 'OLD TRIANGLE_2',ANGLE(:,2),SUM(ANGLE(:,2)),A2
      WRITE(*,'(55X,F10.2)') A1+A2
      
      !## only apply if new polygon is still convex
      LEX=.FALSE.
      IF(ANGLE(1,1).GT.180.0D0.OR. &
         ANGLE(1,2).GT.180.0D0.OR. &
         ANGLE(2,1)+ANGLE(2,2).GT.180.0D0.OR. &
         ANGLE(3,1)+ANGLE(3,2).GT.180.0D0)THEN
       LEX=.TRUE.
      ENDIF
      
      TRI(IT)%IP(1)=SP(1)
      TRI(IT)%IP(2)=ID
      TRI(IT)%IP(3)=JD
      
      TRI(JT)%IP(1)=SP(2)
      TRI(JT)%IP(2)=ID
      TRI(JT)%IP(3)=JD

      DO J=1,3
       T(1,J)=XP(TRI(IT)%IP(J))
       T(2,J)=YP(TRI(IT)%IP(J))
      ENDDO
      CALL TRIANGLE_ANGLES(T,ANGLE(:,3))
      A3=ANGLE(1,3)*ANGLE(2,3)*ANGLE(3,3)
      WRITE(*,'(A15,5F10.2)') 'NEW TRIANGLE_1',ANGLE(:,3),SUM(ANGLE(:,3)),A3
      
      DO J=1,3
       T(1,J)=XP(TRI(JT)%IP(J))
       T(2,J)=YP(TRI(JT)%IP(J))
      ENDDO
      CALL TRIANGLE_ANGLES(T,ANGLE(:,4))
      A4=ANGLE(1,4)*ANGLE(2,4)*ANGLE(3,4)
      WRITE(*,'(A15,5F10.2)') 'NEW TRIANGLE_2',ANGLE(:,4),SUM(ANGLE(:,4)),A4
      WRITE(*,'(55X,F10.2)') A3+A4
      
      !## reset as it is no improvement and new polygon is not convex
      IF(A3+A4.LE.A1+A2.OR.LEX)THEN
       DO JJ=1,3; TRI(IT)%IP(JJ)=BP(1,JJ); ENDDO
       DO JJ=1,3; TRI(JT)%IP(JJ)=BP(2,JJ); ENDDO
      ENDIF
     
     ENDIF
     EXIT 
    ENDIF
   ENDDO
  ENDDO

 ENDDO
 
 DO IT=1,NT
  DO J=1,3
   T(1,J)=XP(TRI(IT)%IP(J))
   T(2,J)=YP(TRI(IT)%IP(J))
  ENDDO
  !## determine angles 
  CALL TRIANGLE_ANGLES(T,ANGLE(:,1))
  A=TRIANGLE_AREA(T)
  WRITE(*,'(I10,G10.1,3F10.3)') IT,ABS(A),ANGLE(:,1)
 ENDDO
 
 !## plot triangles
 CALL UTL_CREATEDIR(IPFPPS(:INDEX(IPFPPS,'\',.TRUE.)-1))
 JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'.GEN',STATUS='UNKNOWN',ACTION='WRITE')
 DO I=1,NT
  WRITE(JU,'(I10)') I
  WRITE(JU,'(2F15.3)') XP(TRI(I)%IP(1)),YP(TRI(I)%IP(1))
  WRITE(JU,'(2F15.3)') XP(TRI(I)%IP(2)),YP(TRI(I)%IP(2))
  WRITE(JU,'(2F15.3)') XP(TRI(I)%IP(3)),YP(TRI(I)%IP(3))
  WRITE(JU,'(2F15.3)') XP(TRI(I)%IP(1)),YP(TRI(I)%IP(1))
  WRITE(JU,'(A)') 'END'
 ENDDO
 WRITE(JU,'(A)') 'END'
 CLOSE(JU)

 KU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'.PRJ',STATUS='UNKNOWN',ACTION='WRITE')

 SELECT CASE (PPTYPE)

  !## use points
  CASE (0)
   !## plot used points of triangles
   JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'_POINTS.IPF',STATUS='UNKNOWN',ACTION='WRITE')
   WRITE(JU,*) NP; WRITE(JU,'(A)') '4'; WRITE(JU,'(A)') 'X'; WRITE(JU,'(A)') 'Y'; WRITE(JU,'(A)') 'NO_PPOINT'; WRITE(JU,'(A)') 'IACT'; WRITE(JU,'(A)') '0,TXT'
   DO I=1+(4+NINT),NP
    X=XP(I); Y=YP(I)
    CALL  UTL_TRIANGULATION_OUTPUT(JU,KU,XP,YP,NINT,DCLUSTER,X,Y,IL,IG,PTYPE,NPF,IDF)
   ENDDO
   CLOSE(JU)
 
  !## plot delauney points (circumcenter)
  CASE (1)
   JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'_DELAUNEY.IPF',STATUS='UNKNOWN',ACTION='WRITE')
   WRITE(JU,*) NT; WRITE(JU,'(A)') '4'; WRITE(JU,'(A)') 'X'; WRITE(JU,'(A)') 'Y'; WRITE(JU,'(A)') 'NO_PPOINT'; WRITE(JU,'(A)') 'IACT'; WRITE(JU,'(A)') '0,TXT'
   DO I=1,NT
    DO J=1,3
     T(1,J)=XP(TRI(I)%IP(J))
     T(2,J)=YP(TRI(I)%IP(J))
    ENDDO
    CALL TRIANGLE_CIRCUMCIRCLE(T,X,Y)
    CALL  UTL_TRIANGULATION_OUTPUT(JU,KU,XP,YP,NINT,DCLUSTER,X,Y,IL,IG,PTYPE,NPF,IDF)
   ENDDO
   CLOSE(JU)

  !## plot incenter points
  CASE (2)
   JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'_INCENTER.IPF',STATUS='UNKNOWN',ACTION='WRITE')
   WRITE(JU,*) NT; WRITE(JU,'(A)') '4'; WRITE(JU,'(A)') 'X'; WRITE(JU,'(A)') 'Y'; WRITE(JU,'(A)') 'NO_PPOINT'; WRITE(JU,'(A)') 'IACT'; WRITE(JU,'(A)') '0,TXT'
   DO I=1,NT
    DO J=1,3
     T(1,J)=XP(TRI(I)%IP(J))
     T(2,J)=YP(TRI(I)%IP(J))
    ENDDO
    CALL TRIANGLE_INCIRCLE(T,X,Y)
    CALL  UTL_TRIANGULATION_OUTPUT(JU,KU,XP,YP,NINT,DCLUSTER,X,Y,IL,IG,PTYPE,NPF,IDF)
   ENDDO
   CLOSE(JU)

  !## plot points of mid of triangles
  CASE (3)
   JU=UTL_GETUNIT(); OPEN(JU,FILE=IPFPPS(:INDEX(IPFPPS,'.',.TRUE.)-1)//'_CENTROID.IPF',STATUS='UNKNOWN',ACTION='WRITE')
   WRITE(JU,*) NT+NPF; WRITE(JU,'(A)') '4'; WRITE(JU,'(A)') 'X'; WRITE(JU,'(A)') 'Y'; WRITE(JU,'(A)') 'NO_PPOINT'; WRITE(JU,'(A)') 'IACT'; WRITE(JU,'(A)') '0,TXT'
   J=0; DO I=1,NT
    !## save known measures
    IF(I.GT.4*NINT.AND.I.LT.4*NINT+NPF)THEN
     IG=IG+1; J=J+1
     WRITE(JU,'(2F15.3,2I10)') X,Y,IG,1
     !## apply factor from ipf(2)
     READ(IPF(2)%INFO(3,J),*) F !F=1.0D0 !IP
     WRITE(KU,'(A)') TRIM(ITOS(1))//','//TRIM(PTYPE)//','// TRIM(ITOS(IL))//','// TRIM(ITOS(IG))//','//TRIM(RTOS(F,'F',1))//',1.1,0.01,100.0,10.0,'// TRIM(ITOS(IG))//',1,'// &
                     TRIM(PTYPE)//'_G'//TRIM(ITOS(IG))//'_L'//TRIM(ITOS(IL))//'1.0'
    ENDIF
    X=XP(TRI(I)%IP(1))+XP(TRI(I)%IP(2))+XP(TRI(I)%IP(3)); X=X/3.0D0
    Y=YP(TRI(I)%IP(1))+YP(TRI(I)%IP(2))+YP(TRI(I)%IP(3)); Y=Y/3.0D0
    CALL  UTL_TRIANGULATION_OUTPUT(JU,KU,XP,YP,NINT,DCLUSTER,X,Y,IL,IG,PTYPE,NPF,IDF)
   ENDDO
  CLOSE(JU)
 END SELECT
 
 DEALLOCATE(TRI)
 
 END SUBROUTINE UTL_TRIANGULATION

 !###======================================================================
 SUBROUTINE UTL_TRIANGULATION_OUTPUT(JU,KU,XP,YP,NINT,DCLUSTER,X,Y,IL,IG,PTYPE,NPF,IDF)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(:) :: XP,YP
 INTEGER,INTENT(IN) :: NINT,JU,IL,NPF,KU
 TYPE(IDFOBJ),INTENT(INOUT) :: IDF
 INTEGER,INTENT(INOUT) :: IG
 CHARACTER(LEN=*),INTENT(IN) :: PTYPE
 REAL(KIND=DP_KIND),INTENT(IN) :: DCLUSTER,X,Y
 INTEGER :: IACT,J,IROW,ICOL
 
 IACT=1
 DO J=1+(4*NINT),NPF+4*NINT-1
  IF(UTL_DIST(XP(J),YP(J),X,Y).LE.DCLUSTER)IACT=0
 ENDDO
 !## check idf if available
 IF(ASSOCIATED(IDF%X))THEN
  CALL IDFIROWICOL(IDF,IROW,ICOL,X,Y)
  IF(ICOL.EQ.0.OR.IROW.EQ.0)THEN
   IACT=0
  ELSE
   IF(IDF%X(ICOL,IROW).EQ.IDF%NODATA)IACT=0
  ENDIF
 ENDIF
 IG=IG+1
 WRITE(JU,'(2F15.3,2I10)') X,Y,IG,IACT
 WRITE(KU,'(A)') TRIM(ITOS(IACT))//','//TRIM(PTYPE)//','// TRIM(ITOS(IL))//','// TRIM(ITOS(IG))//',1.0,1.1,0.01,100.0,10.0,'// TRIM(ITOS(IG))//',1,'// &
                 TRIM(PTYPE)//'_G'//TRIM(ITOS(IG))//'_L'//TRIM(ITOS(IL))//'1.0'
 
 END SUBROUTINE UTL_TRIANGULATION_OUTPUT
 
 !###======================================================================
 SUBROUTINE TRIANGLE_ANGLES(T,ANGLE)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: A,B,C
 REAL(KIND=DP_KIND),DIMENSION(3),INTENT(OUT) :: ANGLE(:)
 REAL(KIND=DP_KIND),DIMENSION(2,3),INTENT(IN) :: T

 !## compute the length of each side.
 A=SQRT((T(1,2)-T(1,1))**2.0D0+(T(2,2)-T(2,1))**2.0D0)
 B=SQRT((T(1,3)-T(1,2))**2.0D0+(T(2,3)-T(2,2))**2.0D0)
 C=SQRT((T(1,1)-T(1,3))**2.0D0+(T(2,1)-T(2,3))**2.0D0)

 !## take care of ridiculous special cases
 IF(A.EQ.0.0D+00.AND.B.EQ.0.0D0.AND.C.EQ.0.0D0)THEN
  ANGLE(1:3)=2.0D0*PI/3.0D0; RETURN
 END IF

 IF(C.EQ.0.0D0.OR.A.EQ.0.0D0)THEN
  ANGLE(1)=PI
 ELSE
  ANGLE(1)=ARC_COSINE((C*C+A*A-B*B)/(2.0D0*C*A))
 END IF

 IF(A.EQ.0.0D0.OR.B.EQ.0.0D0)THEN
  ANGLE(2)=PI
 ELSE
  ANGLE(2)=ARC_COSINE((A*A+B*B-C*C)/(2.0D0*A*B))
 END IF

 IF(B.EQ.0.0D0.OR.C.EQ.0.0D0)THEN
  ANGLE(3)=PI
 ELSE
  ANGLE(3)=ARC_COSINE((B*B+C*C-A*A)/(2.0D0*B*C))
 END IF

 ANGLE=ANGLE*360.0D0/(2.0D0*PI)
 
 END SUBROUTINE TRIANGLE_ANGLES

 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION ARC_COSINE(C)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND), INTENT(IN) :: C
 REAL(KIND=DP_KIND) :: C2

 C2=C; C2=MAX(C2,-1.0D0); C2=MIN(C2,1.0D0)

 ARC_COSINE=ACOS(C2)

 END FUNCTION ARC_COSINE
      
 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION TRIANGLE_AREA(T)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(2,3) :: T

 TRIANGLE_AREA=0.5D0*(T(1,1)*(T(2,2)-T(2,3))+ &
                      T(1,2)*(T(2,3)-T(2,1))+ &
                      T(1,3)*(T(2,1)-T(2,2)))

 END FUNCTION TRIANGLE_AREA
      
 !###======================================================================
 SUBROUTINE TRIANGLE_CIRCUMCIRCLE(T,XC,YC)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(2,3) :: T
 REAL(KIND=DP_KIND),INTENT(OUT) :: XC,YC
 REAL(KIND=DP_KIND) :: A,B,BOT,C,DET,R
 REAL(KIND=DP_KIND),DIMENSION(2) :: F,TOP

 !## circumradius
 A=SQRT((T(1,2)-T(1,1))**2.0D0+(T(2,2)-T(2,1))**2.0D0)
 B=SQRT((T(1,3)-T(1,2))**2.0D0+(T(2,3)-T(2,2))**2.0D0)
 C=SQRT((T(1,1)-T(1,3))**2.0D0+(T(2,1)-T(2,3))**2.0D0)

 BOT=(A+B+C)*(-A+B+C)*(A-B+C)*(A+B-C)

 IF(BOT.LE.0.0D0)THEN
  R=-1.0D0
  XC=0.0D0
  YC=0.0D0
  RETURN
 ENDIF

 R=A*B*C/SQRT(BOT)

 !## circumcenter.
 F(1)=(T(1,2)-T(1,1))**2+(T(2,2)-T(2,1))**2.0D0
 F(2)=(T(1,3)-T(1,1))**2+(T(2,3)-T(2,1))**2.0D0

 TOP(1)= (T(2,3)-T(2,1))*F(1)-(T(2,2)-T(2,1))*F(2)
 TOP(2)=-(T(1,3)-T(1,1))*F(1)+(T(1,2)-T(1,1))*F(2)

 DET=(T(2,3)-T(2,1))*(T(1,2)-T(1,1)) &
    -(T(2,2)-T(2,1))*(T(1,3)-T(1,1))

 XC=T(1,1)+0.5D+00*TOP(1)/DET
 YC=T(2,1)+0.5D+00*TOP(2)/DET

 END SUBROUTINE TRIANGLE_CIRCUMCIRCLE
 
 !###======================================================================
 SUBROUTINE TRIANGLE_INCIRCLE(T,X,Y)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(2,3),INTENT(IN) :: T
 REAL(KIND=DP_KIND) :: A,B,C,PERIMETER,R
 REAL(KIND=DP_KIND),INTENT(OUT) :: X,Y

 !## compute the length of each side.
 A=SQRT((T(1,2)-T(1,1))**2.0D0+(T(2,2)-T(2,1))**2.0D0)
 B=SQRT((T(1,3)-T(1,2))**2.0D0+(T(2,3)-T(2,2))**2.0D0)
 C=SQRT((T(1,1)-T(1,3))**2.0D0+(T(2,1)-T(2,3))**2.0D0)
 
 PERIMETER=A+B+C

 IF(PERIMETER.EQ.0.0D0)THEN
  X=T(1,1); Y=T(2,1); R=0.0D0; RETURN
 ENDIF

 X=(B*T(1,1)+C*T(1,2)+A*T(1,3))/PERIMETER
 Y=(B*T(2,1)+C*T(2,2)+A*T(2,3))/PERIMETER

 R=0.5D0*SQRT((-A+B+C)*(+A-B+C)*(+A+B-C)/PERIMETER)

 END SUBROUTINE TRIANGLE_INCIRCLE
      
 !###======================================================================
 INTEGER FUNCTION UTL_POINT_IN_TRIANGLE(A,B,C,P)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),DIMENSION(:) :: A,B,C,P
 REAL(KIND=DP_KIND) :: X,Y,Z
 
 UTL_POINT_IN_TRIANGLE=-1
 
 !## check whether points of triangle equal to point p
! WRITE(*,*) SUM(P-A)
! WRITE(*,*) SUM(P-B)
! WRITE(*,*) SUM(P-C)
 IF(P(1)-A(1).EQ.0.0D0.AND.P(2)-A(2).EQ.0.0D0)RETURN
 IF(P(1)-B(1).EQ.0.0D0.AND.P(2)-B(2).EQ.0.0D0)RETURN
 IF(P(1)-C(1).EQ.0.0D0.AND.P(2)-C(2).EQ.0.0D0)RETURN
 !IF(SUM(P-B).EQ.0.0D0)RETURN
 !IF(SUM(P-C).EQ.0.0D0)RETURN
 
 UTL_POINT_IN_TRIANGLE=0

 Z= UTL_DETERMINANT(A,B)+UTL_DETERMINANT(B,C)+UTL_DETERMINANT(C,A)
 IF(Z.EQ.0.0D0)STOP 'THIS IS NOT A TRIANGLE'
 X=(UTL_DETERMINANT(A,B)+UTL_DETERMINANT(B,P)+UTL_DETERMINANT(P,A))/Z
 Y=(UTL_DETERMINANT(C,A)+UTL_DETERMINANT(A,P)+UTL_DETERMINANT(P,C))/Z
 IF(X+Y.LE.1.0D0)THEN
  IF(X.GE.0.0D0.AND.X.LE.1.0D0.AND. &
     Y.GE.0.0D0.AND.Y.LE.1.0D0)UTL_POINT_IN_TRIANGLE=1
 ENDIF
 
 END FUNCTION UTL_POINT_IN_TRIANGLE

 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION UTL_DETERMINANT(A,B)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN),DIMENSION(2) :: A,B
 
 UTL_DETERMINANT=A(1)*B(2)-A(2)*B(1)

 END FUNCTION UTL_DETERMINANT
 
 !###======================================================================
 SUBROUTINE IMODBATH_CREATEPILOTPOINTS()
 !###======================================================================
 USE MOD_UTL, ONLY : UTL_MINTHICKNESS
 IMPLICIT NONE
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: BND,VCW,TOP,BOT,KVV,PPT1,PPT2,KHV,KVA
 TYPE(IDFOBJ) :: MASK
 INTEGER :: NLAY,ILAY,IVCW,DI,IROW,ICOL,NG,N,JU,KU,NP,IAQUIFER,IAQUITARD,IQ3D,IFM,IMASK,IACT,IPF
 REAL(KIND=DP_KIND) :: MINC,DX,T,K,C,X,Y,C1,C2
 CHARACTER(LEN=256) :: OUTPUTFOLDER
 CHARACTER(LEN=2) :: CPARAM1,CPARAM2
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: TP,BT,HK,VK,VA,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: TH
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IB

 !## per ipf
 IPF=0; IF(UTL_READINITFILE('IPF',LINE,IU,1))READ(LINE,*) IPF
 WRITE(*,'(A)') 'IPF='//TRIM(ITOS(IPF))

 IF(IPF.EQ.1)THEN; CALL IMODBATH_CREATEPILOTPOINTS_IPF(); STOP; ENDIF
 
 !## per layer of per kh
 IFM=0; IF(UTL_READINITFILE('IFM',LINE,IU,1))READ(LINE,*) IFM
 WRITE(*,'(A)') 'IFM='//TRIM(ITOS(IFM))

 IF(IFM.EQ.0)THEN

  !## define quasi/3d simulations
  IQ3D=1; IF(UTL_READINITFILE('IQ3D',LINE,IU,1))READ(LINE,*) IQ3D
  WRITE(*,'(A)') 'IQ3D='//TRIM(ITOS(IQ3D))

  IF(IQ3D.EQ.1)THEN
   IAQUIFER=0; IF(UTL_READINITFILE('IAQUIFER',LINE,IU,1))READ(LINE,*) IAQUIFER
   WRITE(*,'(A)') 'IAQUIFER='//TRIM(ITOS(IAQUIFER))
   IAQUITARD=0; IF(UTL_READINITFILE('IAQUITARD',LINE,IU,1))READ(LINE,*) IAQUITARD
   WRITE(*,'(A)') 'IAQUITARD='//TRIM(ITOS(IAQUITARD))
  ELSE
   IAQUIFER=1; IAQUITARD=0
  ENDIF
 
  IVCW=0
  IF(IQ3D.EQ.1)THEN
   IF(UTL_READINITFILE('IVCW',LINE,IU,1))READ(LINE,*) IVCW
   WRITE(*,'(A)') 'IVCW='//TRIM(ITOS(IVCW))
  ENDIF
 
  IF(.NOT.UTL_READINITFILE('MINC',LINE,IU,0))RETURN
  READ(LINE,*) MINC; WRITE(*,'(A)') 'MINC='//TRIM(RTOS(MINC,'F',2))

 ELSE
  IQ3D=0; IVCW=0; IAQUIFER=1; IAQUITARD=0; MINC=0.0D0
 ENDIF
 
 CPARAM1='KH'; IF(IVCW.EQ.1)CPARAM1='KD'; CPARAM2='KV'; IF(IVCW.EQ.1)CPARAM2='VC'

 !## read in dx, cannot specify different per layer due to aggregation
 IF(.NOT.UTL_READINITFILE('DX',LINE,IU,0))RETURN
 READ(LINE,*) DX; WRITE(*,'(A)') 'DX='//TRIM(RTOS(DX,'F',2))

 IF(.NOT.UTL_READINITFILE('NLAY',LINE,IU,0))RETURN
 READ(LINE,*) NLAY; WRITE(*,'(A)') 'NLAY='//TRIM(ITOS(NLAY))
 
 ALLOCATE(BND(NLAY),PPT1(NLAY),PPT2(NLAY-1))
 IF(IVCW.EQ.1)THEN
  ALLOCATE(VCW(NLAY))
 ELSE
  ALLOCATE(TOP(NLAY),BOT(NLAY))
  IF(IQ3D.EQ.1)THEN
   ALLOCATE(KVV(NLAY))
  ELSE
   ALLOCATE(KHV(NLAY),KVA(NLAY))
  ENDIF
 ENDIF
 
 IMASK=0; IF(UTL_READINITFILE('MASK',LINE,IU,1))THEN
  IMASK=1; READ(LINE,*) MASK%FNAME; WRITE(*,'(A)') 'MASK='//TRIM(MASK%FNAME)
 ENDIF
 
 DO ILAY=1,NLAY
  CALL IDFNULLIFY(PPT1(ILAY)); CALL IDFNULLIFY(BND(ILAY))
  IF(.NOT.UTL_READINITFILE('BND_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
  READ(LINE,*) BND(ILAY)%FNAME; WRITE(*,'(A)') 'BND_L'//TRIM(ITOS(ILAY))//'='//TRIM(BND(ILAY)%FNAME)
  IF(IVCW.EQ.1)THEN
   IF(ILAY.LT.NLAY)THEN
    CALL IDFNULLIFY(VCW(ILAY)); CALL IDFNULLIFY(PPT2(ILAY))
    IF(.NOT.UTL_READINITFILE('VCW_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
    READ(LINE,*) VCW(ILAY)%FNAME; WRITE(*,'(A)') 'VCW_L'//TRIM(ITOS(ILAY))//'='//TRIM(VCW(ILAY)%FNAME)
   ENDIF
  ELSE
   CALL IDFNULLIFY(TOP(ILAY))
   IF(.NOT.UTL_READINITFILE('TOP_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
   READ(LINE,*) TOP(ILAY)%FNAME; WRITE(*,'(A)') 'TOP_L'//TRIM(ITOS(ILAY))//'='//TRIM(TOP(ILAY)%FNAME)
   CALL IDFNULLIFY(BOT(ILAY))
   IF(.NOT.UTL_READINITFILE('BOT_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
   READ(LINE,*) BOT(ILAY)%FNAME; WRITE(*,'(A)') 'BOT_L'//TRIM(ITOS(ILAY))//'='//TRIM(BOT(ILAY)%FNAME)
   IF(IQ3D.EQ.1)THEN
    IF(ILAY.LT.NLAY)THEN
     CALL IDFNULLIFY(KVV(ILAY))
     IF(.NOT.UTL_READINITFILE('KVV_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
     READ(LINE,*) KVV(ILAY)%FNAME; WRITE(*,'(A)') 'KVV_L'//TRIM(ITOS(ILAY))//'='//TRIM(KVV(ILAY)%FNAME)
    ENDIF
   ELSE
    CALL IDFNULLIFY(KHV(ILAY))
    IF(IFM.EQ.0)THEN
     IF(.NOT.UTL_READINITFILE('KHV_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
     READ(LINE,*) KHV(ILAY)%FNAME; WRITE(*,'(A)') 'KHV_L'//TRIM(ITOS(ILAY))//'='//TRIM(KHV(ILAY)%FNAME)
    ENDIF
    CALL IDFNULLIFY(KVA(ILAY))
    IF(IFM.EQ.0)THEN
     IF(.NOT.UTL_READINITFILE('KVA_L'//TRIM(ITOS(ILAY)),LINE,IU,0))RETURN
     READ(LINE,*) KVA(ILAY)%FNAME; WRITE(*,'(A)') 'KVA_L'//TRIM(ITOS(ILAY))//'='//TRIM(KVA(ILAY)%FNAME)
    ENDIF
   ENDIF
  ENDIF
 ENDDO
 
 IF(.NOT.UTL_READINITFILE('OUTPUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTPUTFOLDER; WRITE(*,'(A)') 'OUTPUTFOLDER='//TRIM(OUTPUTFOLDER)
 
 !## read bnd files
 DO ILAY=1,NLAY
  WRITE(*,'(A)') 'Reading '//TRIM(BND(ILAY)%FNAME)//'...'
  IF(.NOT.IDFREAD(BND(ILAY),BND(ILAY)%FNAME,1))STOP 'Cannot read data for BND'
  IF(IAQUIFER.EQ.1)CALL IDFCOPY(BND(ILAY),PPT1(ILAY))
  IF(IAQUITARD.EQ.1.AND.ILAY.LT.NLAY)CALL IDFCOPY(BND(ILAY),PPT2(ILAY))
 ENDDO
 DO ILAY=1,NLAY
  IF(IVCW.EQ.1)THEN
   IF(ILAY.LT.NLAY)THEN
    WRITE(*,'(A)') 'Reading '//TRIM(VCW(ILAY)%FNAME)//'...'
    CALL IDFCOPY(BND(ILAY),VCW(ILAY)); IF(.NOT.IDFREADSCALE(VCW(ILAY)%FNAME,VCW(ILAY),3,1,0.0D0,0))STOP 'Cannot read data for VCW'
   ENDIF
  ELSE
   IF(IQ3D.EQ.1)THEN
    IF(ILAY.LT.NLAY)THEN
     WRITE(*,'(A)') 'Reading '//TRIM(KVV(ILAY)%FNAME)//'...'
     CALL IDFCOPY(BND(ILAY),KVV(ILAY)); IF(.NOT.IDFREADSCALE(KVV(ILAY)%FNAME,KVV(ILAY),3,1,0.0D0,0))STOP 'Cannot read data for KVV'
    ENDIF
   ELSE
    CALL IDFCOPY(BND(ILAY),KHV(ILAY)); CALL IDFCOPY(BND(ILAY),KVA(ILAY))
    IF(IFM.EQ.0)THEN
     WRITE(*,'(A)') 'Reading '//TRIM(KHV(ILAY)%FNAME)//'...'
     IF(.NOT.IDFREADSCALE(KHV(ILAY)%FNAME,KHV(ILAY),3,1,0.0D0,0))STOP 'Cannot read data for KHV'
     WRITE(*,'(A)') 'Reading '//TRIM(KVA(ILAY)%FNAME)//'...'
     IF(.NOT.IDFREADSCALE(KVA(ILAY)%FNAME,KVA(ILAY),2,1,0.0D0,0))STOP 'Cannot read data for KVA'
    ELSE
     KHV(ILAY)%X=KHV(ILAY)%NODATA; KVA(ILAY)%X=KVA(ILAY)%NODATA
     DO IROW=1,BND(ILAY)%NROW; DO ICOL=1,BND(ILAY)%NCOL
      IF(BND(ILAY)%X(ICOL,IROW).GT.0)THEN
       KHV(ILAY)%X(ICOL,IROW)=ILAY
       KVA(ILAY)%X(ICOL,IROW)=1.0D0
      ENDIF
     ENDDO; ENDDO
    ENDIF
   ENDIF
   WRITE(*,'(A)') 'Reading '//TRIM(TOP(ILAY)%FNAME)//'...'
   CALL IDFCOPY(BND(ILAY),TOP(ILAY)); IF(.NOT.IDFREADSCALE(TOP(ILAY)%FNAME,TOP(ILAY),2,1,0.0D0,0))STOP 'Cannot read data for TOP'
   WRITE(*,'(A)') 'Reading '//TRIM(BOT(ILAY)%FNAME)//'...'
   CALL IDFCOPY(BND(ILAY),BOT(ILAY)); IF(.NOT.IDFREADSCALE(BOT(ILAY)%FNAME,BOT(ILAY),2,1,0.0D0,0))STOP 'Cannot read data for BOT'
  ENDIF
 ENDDO
 
 !## read mask file
 IF(IMASK.EQ.1)THEN
  WRITE(*,'(A)') 'Reading '//TRIM(MASK%FNAME)//'...'
  CALL IDFCOPY(BND(1),MASK); IF(.NOT.IDFREADSCALE(MASK%FNAME,MASK,7,1,0.0D0,0))STOP 'Cannot read data for MASK'
  DO IROW=1,MASK%NROW; DO ICOL=1,MASK%NCOL
   IF(MASK%X(ICOL,IROW).EQ.0.0D0)MASK%X(ICOL,IROW)=MASK%NODATA
  ENDDO; ENDDO
 ENDIF

 IF(IFM.EQ.1)THEN
  ALLOCATE(TP(NLAY)   ,BT(NLAY),   HK(NLAY),   VK(NLAY),   VA(NLAY), IB(NLAY))
  ALLOCATE(TP_BU(NLAY),BT_BU(NLAY),HK_BU(NLAY),VK_BU(NLAY),VA_BU(NLAY),TH(NLAY,2))
  !## is het niet de eerste laag wordt het?
  DO IROW=1,BND(1)%NROW; DO ICOL=1,BND(1)%NCOL; DO ILAY=1,NLAY
   IB(ILAY)=BND(ILAY)%X(ICOL,IROW)
   TP(ILAY)=TOP(ILAY)%X(ICOL,IROW)
   BT(ILAY)=BOT(ILAY)%X(ICOL,IROW)
   HK(ILAY)=ILAY 
   VK(ILAY)=1.0D0; IF(IQ3D.EQ.1)VK(ILAY)=KVV(ILAY)%X(ICOL,IROW)
   VA(ILAY)=KVA(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,1.0D0,NLAY,ICOL,IROW)
   DO ILAY=1,NLAY
    KHV(ILAY)%X(ICOL,IROW)=HK(ILAY)
   ENDDO
  ENDDO; ENDDO
  DEALLOCATE(TP,BT,HK,VK,VA,IB,TP_BU,BT_BU,HK_BU,VK_BU,VA_BU,TH)
!  DO ILAY=1,NLAY
!   KHV%FNAME='D:\TMP_'//TRIM(ITOS(ILAY))//'.IDF'
!   IF(.NOT.IDFWRITE(KHV(ILAY),KHV(ILAY)%FNAME,1))THEN; ENDIF
!  ENDDO
 ENDIF
 
 NG=0; NP=0

 DI=INT(DX/BND(1)%DX)

 !## put pilotpoints in aquifers
 IF(IAQUIFER.EQ.1)THEN
  PPT1%NODATA=-999.99D0
  
  DO ILAY=1,NLAY; PPT1(ILAY)%X=PPT1(ILAY)%NODATA; ENDDO
  
  IF(IFM.EQ.0)THEN

   DO ILAY=1,NLAY
   
    PPT1(ILAY)%X=PPT1(ILAY)%NODATA
    DO IROW=0.5*DI,BND(ILAY)%NROW,DI; DO ICOL=0.5*DI,BND(ILAY)%NCOL,DI
     !## skip inactive cells 
     IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
     IF(ILAY.EQ.1)THEN
      NG=NG+1; NP=NP+1; PPT1(ILAY)%X(ICOL,IROW)=NG
     ELSE
      IF(IVCW.EQ.1)THEN
       C=VCW(ILAY-1)%X(ICOL,IROW)
      ELSE
       IF(IQ3D.EQ.1)THEN
        T=BOT(ILAY-1)%X(ICOL,IROW)-TOP(ILAY)%X(ICOL,IROW)
        K=KVV(ILAY-1)%X(ICOL,IROW)
        C=T/K
       ELSE
        T=TOP(ILAY-1)%X(ICOL,IROW)-BOT(ILAY-1)%X(ICOL,IROW)
        K=KHV(ILAY-1)%X(ICOL,IROW)*KVA(ILAY-1)%X(ICOL,IROW) 
        C1=0.0D0; IF(T.GT.0.0D0.AND.K.GT.0.0D0)C1=(0.5D0*T)/K
        T=TOP(ILAY  )%X(ICOL,IROW)-BOT(ILAY  )%X(ICOL,IROW)
        K=KHV(ILAY  )%X(ICOL,IROW)*KVA(ILAY  )%X(ICOL,IROW) 
        C2=0.0D0; IF(T.GT.0.0D0.AND.K.GT.0.0D0)C2=(0.5D0*T)/K
        C=C1+C2
       ENDIF
      ENDIF
      !## check c to see if similar point need to be used
      IF(C.GT.MINC)THEN
       NG=NG+1
       N =NG
      ELSE
       N =PPT1(ILAY-1)%X(ICOL,IROW)
      ENDIF
      IF(N.LT.0)THEN
       WRITE(*,*) 'Something went wrong'; STOP
      ENDIF
      NP=NP+1
      PPT1(ILAY)%X(ICOL,IROW)=N
     ENDIF
    ENDDO; ENDDO
   ENDDO
  
  ELSE

   DO ILAY=1,NLAY
    PPT1(ILAY)%X=PPT1(ILAY)%NODATA
    DO IROW=0.5D0*DI,BND(ILAY)%NROW,DI; DO ICOL=0.5D0*DI,BND(ILAY)%NCOL,DI
     !## skip inactive cells 
     IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0)CYCLE
     IF(ILAY.EQ.1)THEN
      NG=NG+1; NP=NP+1; PPT1(ILAY)%X(ICOL,IROW)=NG
     ELSE
      !## check c to see if similar point need to be used
      IF(KHV(ILAY)%X(ICOL,IROW).NE.KHV(ILAY-1)%X(ICOL,IROW))THEN
       NG=NG+1
       N =NG
      ELSE
       N =PPT1(ILAY-1)%X(ICOL,IROW)
      ENDIF
      IF(N.LT.0)THEN
       WRITE(*,*) 'Something went wrong'; STOP
      ENDIF
      NP=NP+1
      PPT1(ILAY)%X(ICOL,IROW)=N
     ENDIF
    ENDDO; ENDDO
   ENDDO
  ENDIF
 ENDIF
 
! DO ILAY=1,NLAY
!  PPT1%FNAME='D:\TMP_'//TRIM(ITOS(ILAY))//'.IDF'
!  IF(.NOT.IDFWRITE(PPT1(ILAY),PPT1(ILAY)%FNAME,1))THEN; ENDIF
! ENDDO
 
 !## put pilotpoints in aquitards
 IF(IAQUITARD.EQ.1)THEN
  PPT2%NODATA=-999.99D0
  DO ILAY=1,NLAY-1

   PPT2(ILAY)%X=PPT2(ILAY)%NODATA
   DO IROW=0.5*DI,BND(ILAY)%NROW,DI; DO ICOL=0.5*DI,BND(ILAY)%NCOL,DI
    !## skip inactive cells above and below aquitard
    IF(BND(ILAY)%X(ICOL,IROW).EQ.0.0D0.OR.BND(ILAY+1)%X(ICOL,IROW).EQ.0.0D0)CYCLE

    IF(IVCW.EQ.1)THEN
     C=VCW(ILAY-1)%X(ICOL,IROW)
    ELSE
     T=MAX(0.0D0,BOT(ILAY)%X(ICOL,IROW)-TOP(ILAY+1)%X(ICOL,IROW))
     K=KVV(ILAY)%X(ICOL,IROW)
     C=T/K
    ENDIF
    NG=NG+1
    N =NG
    NP=NP+1
    !## check c to see if similar point need to be used
    IF(C.GT.MINC)THEN
     PPT2(ILAY)%X(ICOL,IROW)= N
    ELSE
     PPT2(ILAY)%X(ICOL,IROW)=-N
    ENDIF
   ENDDO; ENDDO
  ENDDO
 ENDIF

 CALL UTL_CREATEDIR(OUTPUTFOLDER)
 
 KU=UTL_GETUNIT()
 IF(IAQUIFER.EQ.1)THEN
  OPEN(KU,FILE=TRIM(OUTPUTFOLDER)//'\PILOTPOINT_AQUIFER.PRJ',ACTION='WRITE',FORM='FORMATTED')
 ELSE
  OPEN(KU,FILE=TRIM(OUTPUTFOLDER)//'\PILOTPOINT_AQUITARD.PRJ',ACTION='WRITE',FORM='FORMATTED')
 ENDIF
 WRITE(KU,'(I10,A)') NP,',(PST) PARAMETER ESTIMATION,1'
 WRITE(KU,*) '1'
 WRITE(KU,*) 'FILE.IPF,2,1,2,4,3,-5'
 WRITE(KU,*) '99,0.0,0.0,0,0,1.0,0.0,3,0.0,0.0,2,'//TRIM(RTOS(DX*4.0D0,'F',2))//',0,1.0'

 !## write IPF and PRJ
 NP=0

 IF(IAQUIFER.EQ.1)THEN
  DO ILAY=1,NLAY; DO I=1,2; N=0
   DO IROW=0.5D0*DI,BND(ILAY)%NROW,DI; DO ICOL=0.5D0*DI,BND(ILAY)%NCOL,DI

    IF(PPT1(ILAY)%X(ICOL,IROW).EQ.PPT1(ILAY)%NODATA)CYCLE; N=N+1
    CALL IDFGETLOC(PPT1(ILAY),IROW,ICOL,X,Y)
    IF(I.EQ.2)THEN
     NG=PPT1(ILAY)%X(ICOL,IROW)
     NP=NP+1

     !## skip mask cells eq. 0.0 or nodata
     IACT=1; IF(IMASK.EQ.1)THEN
      IF(MASK%X(ICOL,IROW).EQ.MASK%NODATA)IACT=0
     ENDIF

     IF(IVCW.EQ.1)THEN
      WRITE(JU,'(2(F10.2,1X),2(I10,1X),2(F10.2,1X),I5)') X,Y,NP,INT(PPT1(ILAY)%X(ICOL,IROW)),-DBLE(ILAY)+0.5D0,-DBLE(ILAY)-0.5D0,IACT
     ELSE
      WRITE(JU,'(2(F10.2,1X),2(I10,1X),2(F10.2,1X),I5)') X,Y,NP,INT(PPT1(ILAY)%X(ICOL,IROW)),TOP(ILAY)%X(ICOL,IROW),BOT(ILAY)%X(ICOL,IROW),IACT
     ENDIF
     WRITE(KU,'(A)') TRIM(ITOS(IACT))//','//TRIM(CPARAM1)//','//TRIM(ITOS(ILAY))//','//TRIM(ITOS(NP))//',1.0,1.1,0.01,100.0,10.0,'// &
       TRIM(ITOS(NG))//',1,'//TRIM(CPARAM1)//'_GRP'//TRIM(ITOS(NG))//',1.0'
    ENDIF
   ENDDO; ENDDO
   IF(I.EQ.1)THEN
    JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(OUTPUTFOLDER)//'\PILOTPOINT_'//TRIM(CPARAM1)//'_L'//TRIM(ITOS(ILAY))//'.IPF',ACTION='WRITE',FORM='FORMATTED')
    WRITE(JU,*) N; WRITE(JU,*) 7; WRITE(JU,*) 'X'; WRITE(JU,*) 'Y'; WRITE(JU,*) 'PARAMETER'
    WRITE(JU,*) 'ZONE'; WRITE(JU,*) 'T'; WRITE(JU,*) 'B'; WRITE(JU,*) 'IACT'; WRITE(JU,*) '0,TXT'
   ELSE
    CLOSE(JU)
   ENDIF
  ENDDO; ENDDO
 ENDIF
 
 IF(IAQUITARD.EQ.1)THEN
  DO ILAY=1,NLAY-1; DO I=1,2; N=0
   DO IROW=0.5D0*DI,BND(ILAY)%NROW,DI; DO ICOL=0.5D0*DI,BND(ILAY)%NCOL,DI

    !## skip mask cells eq. 0.0 or nodata
    IACT=1; IF(IMASK.EQ.1)THEN
     IF(MASK%X(ICOL,IROW).EQ.MASK%NODATA)IACT=0
    ENDIF

    IF(PPT2(ILAY)%X(ICOL,IROW).EQ.PPT2(ILAY)%NODATA)CYCLE; N=N+1
    CALL IDFGETLOC(PPT2(ILAY),IROW,ICOL,X,Y)
    IF(I.EQ.2)THEN
     NP=NP+1
     IF(IVCW.EQ.1)THEN
      WRITE(JU,'(2(F10.2,1X),2(I10,1X),2(F10.2,1X),I5)') X,Y,NP,INT(PPT2(ILAY)%X(ICOL,IROW)),-REAL(ILAY,8)+0.5D0,-REAL(ILAY,8)-0.5D0,IACT
     ELSE
      WRITE(JU,'(2(F10.2,1X),2(I10,1X),2(F10.2,1X),I5)') X,Y,NP,INT(PPT2(ILAY)%X(ICOL,IROW)),BOT(ILAY)%X(ICOL,IROW),TOP(ILAY+1)%X(ICOL,IROW),IACT
     ENDIF
     NG=PPT2(ILAY)%X(ICOL,IROW)
     IF(NG.GT.0)THEN
      !## skip mask cells eq. 0.0 or nodata
      IACT=1; IF(IMASK.EQ.1)THEN
       IF(MASK%X(ICOL,IROW).EQ.MASK%NODATA)IACT=0
      ENDIF
      WRITE(KU,'(A)') TRIM(ITOS(IACT))//','//TRIM(CPARAM2)//','//TRIM(ITOS(ILAY))//','//TRIM(ITOS(NP))//',1.0,1.1,0.01,100.0,10.0,'// &
        TRIM(ITOS(NG))//',1,'//TRIM(CPARAM2)//'_GRP'//TRIM(ITOS(NG))//',1.0'
     ELSE
      IACT=0
      WRITE(KU,'(A)') TRIM(ITOS(IACT))//','//TRIM(CPARAM2)//','//TRIM(ITOS(ILAY))//','//TRIM(ITOS(NP))//',1.0,1.1,0.01,100.0,10.0,'// &
        TRIM(ITOS(ABS(NG)))//',1,'//TRIM(CPARAM2)//'_GRP'//TRIM(ITOS(ABS(NG)))//',1.0'
     ENDIF
    ENDIF
   ENDDO; ENDDO
   IF(I.EQ.1)THEN
    JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(OUTPUTFOLDER)//'\PILOTPOINT_'//TRIM(CPARAM2)//'_L'//TRIM(ITOS(ILAY))//'.IPF',ACTION='WRITE',FORM='FORMATTED')
    WRITE(JU,*) N; WRITE(JU,*) 7; WRITE(JU,*) 'X'; WRITE(JU,*) 'Y'; WRITE(JU,*) 'PARAMETER'
    WRITE(JU,*) 'ZONE'; WRITE(JU,*) 'T'; WRITE(JU,*) 'B'; WRITE(JU,*) 'IACT'; WRITE(JU,*) '0,TXT'
   ELSE
    CLOSE(JU)
   ENDIF
  ENDDO; ENDDO
 ENDIF

 !## add ipf files
 IF(IAQUIFER.EQ.1)N=NLAY; IF(IAQUITARD.EQ.1)N=N+NLAY-1
 WRITE(KU,'(I10)') N
 IF(IAQUIFER.EQ.1)THEN
  DO ILAY=1,NLAY; WRITE(KU,'(A)') TRIM(OUTPUTFOLDER)//'\PILOTPOINT_'//TRIM(CPARAM1)//'_L'//TRIM(ITOS(ILAY))//'.IPF'; ENDDO
 ENDIF
 IF(IAQUITARD.EQ.1)THEN
  DO ILAY=1,NLAY-1; WRITE(KU,'(A)') TRIM(OUTPUTFOLDER)//'\PILOTPOINT_'//TRIM(CPARAM2)//'_L'//TRIM(ITOS(ILAY))//'.IPF'; ENDDO
 ENDIF
 
 CLOSE(KU)
 
 END SUBROUTINE IMODBATH_CREATEPILOTPOINTS
 
 !###======================================================================
 SUBROUTINE IMODBATCH_MF6NETWORKS()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: GENFNAME,OUTFOLDER
 INTEGER :: N
 
 IF(.NOT.UTL_READINITFILE('GENFNAME',LINE,IU,0))RETURN
 READ(LINE,*) GENFNAME; WRITE(*,'(A)') 'GENFNAME='//TRIM(GENFNAME)
 IF(.NOT.UTL_READINITFILE('OUTFOLDER',LINE,IU,0))RETURN
 READ(LINE,*) OUTFOLDER; WRITE(*,'(A)') 'OUTFOLDER='//TRIM(OUTFOLDER)
  
 CALL PMANAGER_GENERATEMFNETWORKS(GENFNAME,OUTFOLDER,N,1,0)
 WRITE(*,'(1X,A,I10)') 'Number of submodels is ',N
 
 END SUBROUTINE IMODBATCH_MF6NETWORKS

 !###======================================================================
 SUBROUTINE IMODBATCH_MSPNETRCH()
 !###======================================================================
 USE MOD_MSPINSPECTOR_PAR
 USE IMODVAR, ONLY : DP_KIND,SP_KIND 
 IMPLICIT NONE
 INTEGER :: SY,EY
 
 !## - reading Compulsory input - 

 !## read location info
 IF(.NOT.UTL_READINITFILE('SOURCEDIR',LINE,IU,0))RETURN
 READ(LINE,*) SOURCEDIR; WRITE(*,'(A)') 'SOURCEDIR='//TRIM(SOURCEDIR)
 
 !## - reading Optional input - 

 IF(UTL_READINITFILE('RESULTDIR',LINE,IU,1))THEN
   READ(LINE,*) RESDIR; WRITE(*,'(A)') 'RESULTDIR='//TRIM(RESDIR)
 ELSE   
   RESDIR=TRIM(SOURCEDIR)//'\METASWAP\MSPNETRCH'
 ENDIF
 
 
 MSPRCH_NYEAR=0
 !## read start date 
 MSPRCH_FYR=00000000 ;  MSPRCH_TYR=99991231
 IF(UTL_READINITFILE('SDATE',LINE,IU,1))THEN
  READ(LINE,*) MSPRCH_FYR !; IF(MSPRCH_FYR.LT.99999999)MSPRCH_FYR=MSPRCH_FYR*1000000
  WRITE(*,'(A,I16)') 'SDATE=',MSPRCH_FYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') SY
 
 !## read end date
  IF(.NOT.UTL_READINITFILE('EDATE',LINE,IU,0))RETURN
  READ(LINE,*) MSPRCH_TYR !; IF(MSPRCH_TYR.LT.99999999)MSPRCH_TYR=MSPRCH_TYR*1000000
  WRITE(*,'(A,I16)') 'EDATE=',MSPRCH_TYR
  LINE=ADJUSTL(LINE); READ(LINE,'(I4)') EY
  IF(.NOT.IMODBATH_READYEAR(MSPRCH_NYEAR,MSPRCH_IYEAR,SYEAR=SY,EYEAR=EY))RETURN
 ELSE
  WRITE(*,'(/1A/)') 'COMPUTING NET RECHARGE FOR ALL TIMESTEPS'
 ENDIF
 
 !## read Storage coefficient
 SCOPT=-1  ! Option to choose methode of calculating STORAGE COEFICIENT is disabled
 STOAVG=''
 IF(UTL_READINITFILE('STOAVG',LINE,IU,1))THEN
   READ(LINE,*) STOAVG; WRITE(*,'(A)') 'STOAVG='//TRIM(STOAVG)
 ELSE
   !WRITE(*,'(A)') 'COMPUTING AVERAGE STORAGE COEFFICIENT'
   !## read flag to determine period for calculating average Storage coefficient
   !IF(UTL_READINITFILE('SCOPT',LINE,IU,1))THEN
   !  READ(LINE,*) SCOPT; WRITE(*,'(A)') 'SCOPT='//TRIM(ITOS(SCOPT))
   !ENDIF
   IF(SCOPT.EQ.0) WRITE(*,'(A)') 'COMPUTING AVERAGE STORAGE COEFFICIENT FOR THE MODELED PERIODE'
   IF(SCOPT.EQ.1) WRITE(*,'(A)') 'COMPUTING AVERAGE STORAGE COEFFICIENT FOR THE PERIODE SDATE-EDATE'
 ENDIF

 IF(.NOT.MSPNETRCHCOMPUTE())THEN;
  WRITE(*,'(/A/)') 'NOT Successfully completed MSPNETRCH. Check the echo. '
 ELSE
  WRITE(*,'(/A)') 'Successfully completed MSPNETRCH, results written in:'
  WRITE(*,'(A/)') TRIM(RESDIR)
 ENDIF

 END SUBROUTINE IMODBATCH_MSPNETRCH

 !###======================================================================
 SUBROUTINE IMODBATCH_IPFEVALUATE()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: INIPF,OUTIPF
 INTEGER :: NLAY
 INTEGER,DIMENSION(5) :: ICOLS
 
 !## perform ipf sample, return number of 
 IF(.NOT.IMODBATCH_IPFSAMPLE_MAIN(INIPF,ICOLS,NLAY))RETURN
  
 IF(.NOT.UTL_READINITFILE('IPFLAYERS',LINE,IU,0))RETURN
 READ(LINE,*) OUTIPF; WRITE(*,'(A)') 'IPFLAYERS='//TRIM(OUTIPF)
  
 CALL IPFEVALUATE(INIPF,OUTIPF,NLAY,ICOLS) 
 
 END SUBROUTINE IMODBATCH_IPFEVALUATE
 
END MODULE MOD_BATCH