!!  Copyright (C) Stichting Deltares, 2005-2014.
!!
!!  This file is part of iMOD.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!  Contact: imod.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands.
!!
MODULE MOD_MODEL

USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MODPLOT
USE MOD_COLOURS
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_MDL_PAR
USE MOD_UTL, ONLY : UTL_GETUNIT,UTL_SUBST,ITOS,RTOS,UTL_CREATEDIR,UTL_IMODFILLMENU,IDFPLOT1BITMAP,IDFPLOT2BITMAP,&
     INVERSECOLOUR,UTL_CAP,UTL_WSELECTFILE,UTL_HIDESHOWDIALOG,UTL_MESSAGEHANDLE
USE MOD_IDF, ONLY : IDFREAD,IDFDEALLOCATEX,IDFWRITE,IDFREADPART,IDFREADSCALE
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_OSD, ONLY : OSD_OPEN,OSD_IOSTAT_MSG
USE MOD_IPF_PAR, ONLY : NIPF,IPF
USE MOD_IPF, ONLY : IPFALLOCATE,IPFREAD2,IPFWRITE
USE MOD_PMANAGER, ONLY: PMANAGERRUN,PMANAGERSHOW
USE MOD_ABOUT, ONLY : IMOD_AGREEMENT

TYPE(IDFOBJ),PRIVATE :: IDF,IDFC
INTEGER,PRIVATE :: IEDGE

CHARACTER(LEN=4),DIMENSION(4),PRIVATE :: EXT
DATA EXT/'.IDF','.IPF','.GEN','.ISG'/

CONTAINS

 !###======================================================================
 SUBROUTINE MODEL1MAIN(ITYPE,MESSAGE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITYPE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 CHARACTER(LEN=20) :: LINE
 INTEGER :: IWIN,I
 CHARACTER(LEN=256) :: FNAME
 LOGICAL :: LEX
 
 SELECT CASE (ITYPE)

  CASE (FIELDCHANGED)
   SELECT CASE (MESSAGE%WIN)
    !## main
    CASE (ID_DMDLTAB1)
     SELECT CASE (MESSAGE%VALUE2)
      !## select new runfile
      CASE (IDF_MENU1)
       CALL MODEL1DRAW_SIMBOX(.FALSE.) !## remove previous one
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,0)
       CALL MODEL1TABSTATES(MODEL1RUNFILE(),.TRUE.)
       CALL MODEL1DRAW_SIMBOX(.FALSE.) !## draw new one
      !## use scenario's, scn-file
      CASE (IDF_CHECK1,IDF_MENU2)
       CALL MODEL1DRAW_SIMBOX(.TRUE.) !## remove previous one
       CALL MODEL1READ_SCENARIOS()
       CALL MODEL1DRAW_SIMBOX(.TRUE.) !## draw new one
       CALL MODEL1FIELD_SCENARIOS()
       CALL MODEL1FILL_RESULTS()
       CALL MODEL1FREEZESCENARIO()
     END SELECT
    !## configuration
    CASE (ID_DMDLTAB2)
     SELECT CASE (MESSAGE%VALUE2)
      !## type of network
      CASE (IDF_RADIO1,IDF_RADIO2)
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
       CALL MODEL1GETSIMBOX()
       CALL MODEL1FIELDS()
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
      !## nlay
      CASE (IDF_MENU3)
       CALL MODEL1GETSIMBOX()
       !## reset nlayers to be saved!
       NLMDL=0
       CALL MODEL1FILLSAVINGS()
      !## coordinates
      CASE (IDF_REAL1,IDF_REAL2,IDF_REAL4,IDF_REAL5,IDF_REAL7,IDF_REAL8,IDF_REAL9)
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
       CALL MODEL1GETSIMBOX()
       CALL MODEL1FIELDS()
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
      !## cellsize
      CASE (IDF_MENU1)
       CALL WDIALOGSELECT(ID_DMDLTAB2)
       CALL WDIALOGGETMENU(IDF_MENU1,I,LINE)
       READ(LINE,*) SIMCSIZE
       CALL WDIALOGPUTREAL(IDF_REAL7,SIMCSIZE)
       CALL MODEL1GETSIMBOX()
      !## maxcellsize
      CASE (IDF_MENU4)
       CALL WDIALOGSELECT(ID_DMDLTAB2)
       CALL WDIALOGGETMENU(IDF_MENU4,I,LINE)
       READ(LINE,*) MAXSIMCSIZE
       CALL WDIALOGPUTREAL(IDF_REAL9,MAXSIMCSIZE)
       CALL MODEL1GETSIMBOX()
      !## buffer size
      CASE (IDF_MENU2)
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
       CALL WDIALOGSELECT(ID_DMDLTAB2)
       CALL WDIALOGGETMENU(IDF_MENU2,I,LINE)
       READ(LINE,*) MDLBUFFER
       CALL WDIALOGPUTREAL(IDF_REAL8,MDLBUFFER)
       CALL MODEL1GETSIMBOX()
       CALL MODEL1DRAW_SIMBOX(.FALSE.)
      !## usage of maxsimcsize
      CASE (IDF_CHECK1)
       CALL MODEL1GETSIMBOX()
       CALL MODEL1FIELDS()
     END SELECT

    !## savings
    CASE (ID_DMDLTAB3)
     SELECT CASE (MESSAGE%VALUE2)
      !## fill savings
      CASE (IDF_MENU1)
       CALL MODEL1FILLSAVINGS()
      !## read savings
      CASE (IDF_MENU2)
       CALL MODEL1GETSAVINGS()
     END SELECT

    !## output directory
    CASE (ID_DMDLTAB4)
     SELECT CASE (MESSAGE%VALUE2)
     END SELECT
   END SELECT

  CASE(PUSHBUTTON)
   SELECT CASE (MESSAGE%WIN)

    !## runfile tab
    CASE (ID_DMODEL)
     SELECT CASE (MESSAGE%VALUE1)
      !## help
      CASE (IDHELP)
       CALL IMODGETHELP('5.7','TMO.ModSim')
      !## cancel modeling
      CASE (IDCANCEL)
       CALL MODEL1CLOSE()
     END SELECT

    !## runfile tab
    CASE (ID_DMDLTAB1)
     SELECT CASE (MESSAGE%VALUE1)
      !## open runfile in projectmanager
      CASE (ID_PRJMANAGER)
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGGETMENU(IDF_MENU1,I,FNAME)
       FNAME=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(FNAME)
       IF(PMANAGERRUN(ID_OPENRUN,FNAME))CALL PMANAGERSHOW(1)
      !## copy runfile
      CASE (ID_COPY)
       CALL MODEL1COPYRUNFILE(0)
      !## show run-file
      CASE (ID_INFO1)
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGGETMENU(IDF_MENU1,I,FNAME)
       CALL WINDOWOPENCHILD(IWIN,FLAGS=SYSMENUON+MAXBUTTON,WIDTH=1000,HEIGHT=500)
       CALL WINDOWSELECT(IWIN)
       FNAME=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(FNAME)
       CALL WEDITFILE(FNAME,ITYPE=MODAL,IDMENU=0,IFONT=COURIERNEW,ISIZE=10)
       IF(MODEL1FILL_RUNFILES())THEN
        CALL MODEL1TABSTATES(MODEL1RUNFILE(),.TRUE.)
        CALL MODEL1DRAW_SIMBOX(.FALSE.) !## draw new one
        CALL WDIALOGPUTOPTION(IDF_MENU1,I)
       ENDIF
      !## show scn-file
      CASE (ID_INFO2)
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGGETMENU(IDF_MENU2,I,FNAME)
       FNAME=TRIM(PREFVAL(1))//'\SCENARIOS\'//TRIM(FNAME)//'\'//TRIM(FNAME)//'.SCN'
       INQUIRE(FILE=FNAME,EXIST=LEX)
       IF(.NOT.LEX)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'SCN-File: '//CHAR(13)//TRIM(FNAME)//CHAR(13)// &
         'does not exist!','Warning')
       ELSE
        CALL WINDOWOPENCHILD(IWIN,FLAGS=SYSMENUON,WIDTH=1000,HEIGHT=500)
        CALL WINDOWSELECT(IWIN)
        CALL WEDITFILE(FNAME,ITYPE=MODAL,IDMENU=0,IFONT=COURIERNEW,ISIZE=10)
       ENDIF
      !## show sdf-file
      CASE (ID_INFO3)
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGGETMENU(IDF_MENU4,I)
       INQUIRE(FILE=SDFFNAME(I),EXIST=LEX)
       IF(.NOT.LEX)THEN
        CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'SDF-File: '//CHAR(13)//TRIM(SDFFNAME(I))//CHAR(13)// &
         'does not exist!','Warning')
       ELSE
        CALL WINDOWOPENCHILD(IWIN,FLAGS=SYSMENUON,WIDTH=1000,HEIGHT=500)
        CALL WINDOWSELECT(IWIN)
        CALL WEDITFILE(TRIM(SDFFNAME(I)),ITYPE=MODAL,IDMENU=0,IFONT=COURIERNEW,ISIZE=10)
       ENDIF
      !## check runfile
      CASE (ID_CHECKRUNFILE)
       CALL WDIALOGSELECT(ID_DMDLTAB1)
       CALL WDIALOGGETMENU(IDF_MENU1,I,FNAME)
       CALL MODEL1CHECKRUNFILE(TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(FNAME))
      CASE (ID_ZOOMFULL)
       DX=(SIMBOX(3)-SIMBOX(1))/10.0; DY=(SIMBOX(4)-SIMBOX(2))/10.0
       MPW%XMIN=SIMBOX(1)-DX; MPW%YMIN=SIMBOX(2)-DY; MPW%XMAX=SIMBOX(3)+DX; MPW%YMAX=SIMBOX(4)+DY
       CALL IDFPLOT(1)
     END SELECT

    !## dimension tab
    CASE (ID_DMDLTAB2)
     SELECT CASE (MESSAGE%VALUE1)
      !## draw area of interest
      CASE (ID_DRAW)
       CALL MODEL1DEFINEBOX()
      CASE (ID_OPEN)
       FNAME=''
       IF(UTL_WSELECTFILE('iMOD IDF-File (*.idf)|*.idf|',LOADDIALOG+PROMPTON+DIRCHANGE+MUSTEXIST, &
                     FNAME,'Select IDF File (*.idf)'))THEN
        BNDFNAME=FNAME
        CALL WDIALOGPUTSTRING(IDF_STRING1,FNAME)
       ENDIF
     END SELECT

    !## runfile tab
    CASE (ID_DMDLTAB4)
     SELECT CASE (MESSAGE%VALUE1)
      !## start modflow
      CASE (IDOK)
       CALL MODEL1STARTMAIN()
     END SELECT

   END SELECT
 END SELECT

 END SUBROUTINE MODEL1MAIN

 !###======================================================================
 SUBROUTINE MODEL1MOUSEMOVE(MESSAGE,IDOWN,DOWNX,DOWNY)
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER,INTENT(IN) :: IDOWN
 REAL,INTENT(INOUT) :: DOWNX,DOWNY
 REAL :: MIND,DX,DY
 INTEGER,DIMENSION(0:5) :: IDCURSOR
 DATA IDCURSOR/CURARROW,ID_CURSORMOVELEFTRIGHT,ID_CURSORMOVEUPDOWN,ID_CURSORMOVELEFTRIGHT, &
               ID_CURSORMOVEUPDOWN,ID_CURSORMOVE/

 MIND=(MPW%XMAX-MPW%XMIN)/500.0

 SELECT CASE (IDOWN)
  !## no mouse button pressed, see in what neighbourhood
  CASE (0)
   IEDGE=0
   IF(ABS(MESSAGE%GX-SIMBOX(1)).LE.MIND)IEDGE=1 !## west
   IF(ABS(MESSAGE%GY-SIMBOX(2)).LE.MIND)IEDGE=2 !## south
   IF(ABS(MESSAGE%GX-SIMBOX(3)).LE.MIND)IEDGE=3 !## east
   IF(ABS(MESSAGE%GY-SIMBOX(4)).LE.MIND)IEDGE=4 !## north
   IF(IEDGE.EQ.0)THEN
    IF(MESSAGE%GX.GT.SIMBOX(1).AND.MESSAGE%GX.LT.SIMBOX(3).AND. &
       MESSAGE%GY.GT.SIMBOX(2).AND.MESSAGE%GY.LT.SIMBOX(4))IEDGE=5 !## inside
   ENDIF
   IF(WINFOMOUSE(MOUSECURSOR).NE.IDCURSOR(IEDGE))CALL WCURSORSHAPE(IDCURSOR(IEDGE))

  !## left mouse button pressed
  CASE (4)
   
   IF(IEDGE.GT.0)THEN
    !## change only whenever inside rectangle
    IF(MESSAGE%GX.GE.MODBOX(1).AND.MESSAGE%GX.LE.MODBOX(3).AND. &
       MESSAGE%GY.GE.MODBOX(2).AND.MESSAGE%GY.LE.MODBOX(4))THEN
     CALL MODEL1DRAW_SIMBOX(.FALSE.) !## remove previous one
     DX=MESSAGE%GX-DOWNX
     DY=MESSAGE%GY-DOWNY
     SELECT CASE (IEDGE)
      CASE (1)
       SIMBOX(IEDGE)=MIN(SIMBOX(3),SIMBOX(IEDGE)+DX) 
      CASE (3)
       SIMBOX(IEDGE)=MAX(SIMBOX(1),SIMBOX(IEDGE)+DX) 
      CASE (2)
       SIMBOX(IEDGE)=MIN(SIMBOX(4),SIMBOX(IEDGE)+DY) 
      CASE (4)
       SIMBOX(IEDGE)=MAX(SIMBOX(2),SIMBOX(IEDGE)+DY) 
      CASE (5)
       SIMBOX(1)=MAX(MODBOX(1),SIMBOX(1)+DX)
       SIMBOX(2)=MAX(MODBOX(2),SIMBOX(2)+DY)
       SIMBOX(3)=MIN(MODBOX(3),SIMBOX(3)+DX)
       SIMBOX(4)=MIN(MODBOX(4),SIMBOX(4)+DY)
     END SELECT
     CALL MODEL1PUTSIMBOX(SIMBOX(1),SIMBOX(2),SIMBOX(3),SIMBOX(4))
     CALL MODEL1GETSIMBOX()
     CALL MODEL1FIELDS()
     CALL MODEL1DRAW_SIMBOX(.FALSE.) !## draw new one
     DOWNX=DOWNX+DX
     DOWNY=DOWNY+DY
    ENDIF
   ENDIF

 END SELECT

 END SUBROUTINE MODEL1MOUSEMOVE

 !###======================================================================
 SUBROUTINE MODEL1FIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: NID=25
 INTEGER,DIMENSION(NID) :: ID
 INTEGER :: I,J
 REAL :: X1,Y1,X2,Y2,DX,DY
 DATA ID/IDF_GROUP3,IDF_LABEL3,IDF_LABEL9,IDF_LABEL13,IDF_LABEL14,IDF_LABEL15,    &
         IDF_MENU1,IDF_MENU2,IDF_MENU4,IDF_REAL7,IDF_REAL8,IDF_REAL9,IDF_CHECK1,  &
         IDF_GROUP4,IDF_LABEL5,IDF_LABEL7,IDF_REAL1,IDF_REAL2,IDF_REAL3,IDF_REAL4,&
         IDF_REAL5,IDF_REAL6,IDF_LABEL16,IDF_LABEL17,ID_DRAW/

 CALL WDIALOGSELECT(ID_DMDLTAB2)

 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,J)
 !## put dimensions of idf file
 IF(J.EQ.2)CALL MODEL1PUTSIMBOX(IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX)

 J=ABS(J-2)
 DO I=1,NID
  CALL WDIALOGFIELDSTATE(ID(I),J)
 END DO
 J=ABS(J-1)
 CALL WDIALOGFIELDSTATE(IDF_STRING1,J)
 CALL WDIALOGFIELDSTATE(ID_OPEN,J)

 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
 CALL WDIALOGFIELDSTATE(IDF_MENU4,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL9,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL15,I)

 CALL WDIALOGGETREAL(IDF_REAL1,X1)
 CALL WDIALOGGETREAL(IDF_REAL4,Y1)
 CALL WDIALOGGETREAL(IDF_REAL2,X2)
 CALL WDIALOGGETREAL(IDF_REAL5,Y2)
 DX=X2-X1
 DY=Y2-Y1
 CALL WDIALOGPUTREAL(IDF_REAL3,DX)
 CALL WDIALOGPUTREAL(IDF_REAL6,DY)

 CALL WDIALOGSELECT(ID_DMODEL)
 
 END SUBROUTINE MODEL1FIELDS

 !###======================================================================
 SUBROUTINE MODEL1FILLSAVINGS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILIST
 CHARACTER(LEN=10),DIMENSION(:),ALLOCATABLE :: CLAY

 !## maximum number of layers
 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGGETMENU(IDF_MENU3,NLAY)
 IF(NLAY.LE.0)RETURN
  
 !## selected item to be saved
 CALL WDIALOGSELECT(ID_DMDLTAB3)
 CALL WDIALOGGETMENU(IDF_MENU1,I)
 !## error occured in runfile
 IF(I.LE.0)RETURN
 
 I=MDL_IPOS(I)
 
 IF(IAMDL(I).LE.0)THEN
  CALL WDIALOGCLEARFIELD(IDF_MENU2)
  CALL WDIALOGPUTSTRING(IDF_LABEL9,'Not active')
  CALL WDIALOGFIELDSTATE(IDF_MENU2,2)
 ELSE
  !## nlay
  IF(ALLOCATED(CLAY))DEALLOCATE(CLAY)
  ALLOCATE(CLAY(NLAY))
  DO J=1,NLAY; WRITE(CLAY(J),'(I10)') J; END DO
  IF(ALLOCATED(ILIST))DEALLOCATE(ILIST); ALLOCATE(ILIST(NLAY)); ILIST=0
  DO J=1,MIN(NLAY,NLMDL(I))
   IF(ILMDL(I,J).EQ.0)THEN
    ILIST=1
   ELSEIF(ILMDL(I,J).GT.0.AND.ILMDL(I,J).LE.NLAY)THEN
    ILIST(ILMDL(I,J))=1
   ENDIF
  END DO
  CALL WDIALOGPUTSTRING(IDF_LABEL9,'Selected Layers')
  CALL WDIALOGFIELDSTATE(IDF_MENU2,1)
  CALL WDIALOGPUTMENU(IDF_MENU2,CLAY,NLAY,ILIST)
  IF(ALLOCATED(ILIST))DEALLOCATE(ILIST); IF(ALLOCATED(CLAY))DEALLOCATE(CLAY)
 ENDIF

 END SUBROUTINE MODEL1FILLSAVINGS

 !###======================================================================
 SUBROUTINE MODEL1GETSAVINGS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILIST

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGGETMENU(IDF_MENU3,NLAY)

 CALL WDIALOGSELECT(ID_DMDLTAB3)
 CALL WDIALOGGETMENU(IDF_MENU1,I)
 I=MDL_IPOS(I)
 
 IF(ALLOCATED(ILIST))DEALLOCATE(ILIST)
 ALLOCATE(ILIST(NLAY))
 ILIST=0
 CALL WDIALOGGETMENU(IDF_MENU2,ILIST)
 NLMDL(I)=0
 K=0
 DO J=1,NLAY
  IF(ILIST(J).EQ.1)THEN
   K=K+1
   NLMDL(I)  =NLMDL(I)+1
   ILMDL(I,K)=J
  ENDIF
 END DO

 IF(ALLOCATED(ILIST))DEALLOCATE(ILIST)

 END SUBROUTINE MODEL1GETSAVINGS

 !###======================================================================
 SUBROUTINE MODEL1STARTMAIN()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=20) :: SCENDIR
 INTEGER :: I
 CHARACTER(LEN=256) :: RUN1,RUN2,RDIR,LINE
 LOGICAL :: LEX

 CALL WDIALOGSELECT(ID_DMDLTAB1)
 !## runfile to be copied!
 CALL WDIALOGGETMENU(IDF_MENU1,I,RUN1)
 IF(LEN_TRIM(RUN1).EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No Runfile given!','Error')
  RETURN
 ENDIF
 RUN1=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(RUN1)
 INQUIRE(FILE=RUN1,EXIST=LEX)
 IF(.NOT.LEX)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Runfile '//TRIM(RUN1)//' does not exists!','Error')
  RETURN
 ENDIF

 !## get result-directory
 CALL WDIALOGSELECT(ID_DMDLTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IBUFFER)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IBUDGET)

 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,ISCEN)

 IF(ISCEN.EQ.0)THEN
  SCENDIR='MODELS'
 ELSE
  CALL WDIALOGGETMENU(IDF_MENU2,I,SCENDIR)
  SCENFNAME=TRIM(PREFVAL(1))//'\SCENARIOS\'//TRIM(SCENDIR)//'\'//TRIM(SCENDIR)//'.SCN'
  SCENDIR='SCENARIOS'
 ENDIF

 !## get result-directory
 CALL WDIALOGSELECT(ID_DMDLTAB4)
 CALL WDIALOGGETMENU(IDF_MENU1,I,RDIR)
 IF(LEN_TRIM(RDIR).EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Enter/select a folder in the Result Folder tab','Error')
  RETURN
 ENDIF

 !## check existence of result folder
 IF(IOSDIREXISTS(TRIM(PREFVAL(1))//'\'//TRIM(SCENDIR)//'\'//TRIM(RDIR)))THEN
  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONYES,'Model Output will be saved in existing folder '//CHAR(13)// &
     TRIM(PREFVAL(1))//'\'//TRIM(SCENDIR)//'\'//TRIM(RDIR)//CHAR(13)//'overwrite it and continue?','Question')
 ELSE
  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONYES,'Model Output will be saved in folder '//CHAR(13)// &
     TRIM(PREFVAL(1))//'\'//TRIM(SCENDIR)//'\'//TRIM(RDIR)//CHAR(13)//'Continue?','Question')
 ENDIF
 IF(WINFODIALOG(4).NE.1)RETURN

 !## open runfile to be created!
 RUN2=TRIM(PREFVAL(1))//'\'//TRIM(SCENDIR)//'\'//TRIM(RDIR)

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGGETMENU(IDF_MENU3,I,LINE)
 READ(LINE,*) NLAY

 !## xmin/ymax etc. (1) or idf (2)
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
 IF(I.EQ.1)THEN
  !## get coarsening outside area of interest
  CALL WDIALOGGETCHECKBOX(IDF_CHECK1,NSCL)
  NSCL=NSCL+1 !## 1=equi-dist grid; 2=non-equi grid
  NMULT=1
 ELSE
  NSCL=0
  NMULT=0
 ENDIF

 !## model dimensions
 IF(NMULT.EQ.1)CALL MODEL1GETSIMBOX()

 !## solver
 CALL WDIALOGSELECT(ID_DMDLTAB6)
 CALL WDIALOGGETREAL(IDF_REAL1,HCLOSE)
 CALL WDIALOGGETREAL(IDF_REAL2,RCLOSE)
 CALL WDIALOGGETREAL(IDF_REAL3,RELAX)
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,MXITER)
 CALL WDIALOGGETINTEGER(IDF_INTEGER2,NITER)
 CALL WDIALOGGETREAL(IDF_REAL4,MAXWBAL)
 CALL WDIALOGGETINTEGER(IDF_INTEGER3,MAXICVNG)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IDAMPING)
 CALL WDIALOGGETMENU(IDF_MENU1,NPCOND)
 CALL WDIALOGGETREAL(IDF_REAL5,MINKD)
 CALL WDIALOGGETREAL(IDF_REAL6,MINC)

 CALL WDIALOGSELECT(ID_DMDLTAB4)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)

 IF(.NOT.MODEL1WRITERUNFILE(RUN1,RUN2,0,0,''))RETURN

 CALL MODEL1START(RUN1,RUN2,I)

 END SUBROUTINE MODEL1STARTMAIN

 !###======================================================================
 SUBROUTINE MODEL1START(RUN1,RUN2,IRUNMODE)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: RUN1,RUN2
 INTEGER,INTENT(IN) :: IRUNMODE
 CHARACTER(LEN=256) :: RUN,DIRNAME
 INTEGER :: IU,IOS,I,IFLAGS,IEXCOD,IERROR
 LOGICAL :: LEX

! IF(IRUNMODE.EQ.0)THEN
 !## simulate batch-file, inclusive pause statement.
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=TRIM(RUN2)//'\RUN.BAT',STATUS='REPLACE',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Modflow is allready running, you can not start '//CHAR(13)// &
   'new run while previous run is still running'//CHAR(13)//'Error creating '//CHAR(13)// &
   TRIM(RUN2)//'\RUN.BAT','Error')
  RETURN
 ENDIF
! ENDIF

 I=INDEXNOCASE(PREFVAL(8),'\',.TRUE.)+1
 !## remove previous version of imodflow
 INQUIRE(FILE=TRIM(RUN2)//'\'//TRIM(PREFVAL(8)(I:)),EXIST=LEX)
 IF(LEX)CALL IOSDELETEFILE(TRIM(RUN2)//'\'//TRIM(PREFVAL(8)(I:)))
 !## copy imodflow executable
 CALL IOSCOPYFILE(TRIM(PREFVAL(8)),TRIM(RUN2)//'\'//TRIM(PREFVAL(8)(I:)))
 
 INQUIRE(FILE=TRIM(PREFVAL(1))//'\license_agreement.txt',EXIST=LEX)
 IF(.NOT.LEX)THEN
  IERROR=0; CALL IMOD_AGREEMENT(IERROR)
  IF(IERROR.NE.1)THEN
   CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Can not start iMODFLOW unless you accept the iMOD Software License Agreement','Error')
   RETURN
  ENDIF
 ENDIF

 !## copy imod license text
 CALL IOSCOPYFILE(TRIM(PREFVAL(1))//'\license_agreement.txt',TRIM(RUN2)//'\license_agreement.txt')
 
! IF(IRUNMODE.EQ.0)THEN
 !## write start script in batch file
 WRITE(IU,'(A)') 'START "Runfile:'//TRIM(RUN1(INDEX(RUN1,'\',.TRUE.):))//'" /B '//TRIM(PREFVAL(8)(I:))//' '//'IMODFLOW.RUN'
 CLOSE(IU)
! ENDIF

 !## move iMOD to the simulation directory
 CALL IOSDIRNAME(DIRNAME)
 CALL IOSDIRCHANGE(TRIM(RUN2)//'\')

 !## start the batch file
 IF(IRUNMODE.EQ.0)THEN

  IFLAGS=0
 !## executes on commandtool such that commands alike 'dir' etc. works
#if (defined(WINTERACTER9))
  IFLAGS=IFLAGS+PROCCMDPROC
#endif 

  CALL IOSCOMMAND('RUN.BAT',IFLAGS,IEXCOD=IEXCOD)

  IF(ISCEN.EQ.0)THEN
   CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Succesfully STARTED the Modflow simulation using:'//CHAR(13)// &
                  'MODFLOW: '//TRIM(PREFVAL(8))//CHAR(13)// &
                  'RUNFILE: '//TRIM(RUN1),'Information')
  ELSE
   CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Succesfully STARTED the Modflow simulation using:'//CHAR(13)// &
                  'MODFLOW: '//TRIM(PREFVAL(8))//CHAR(13)// &
                  'RUNFILE: '//TRIM(RUN1)//CHAR(13)// &
                  'SCENARIO: '//TRIM(SCENFNAME),'Information')
  ENDIF
  
 ELSE

  RUN=TRIM(PREFVAL(8)(I:))//' '//'IMODFLOW.RUN'

  IFLAGS=PROCBLOCKED
 !## executes on commandtool such that commands alike 'dir' etc. works

#if (defined(WINTERACTER9))
  IFLAGS=IFLAGS+PROCCMDPROC
#endif 
  
  CALL IOSCOMMAND(TRIM(RUN),IFLAGS,IEXCOD=IEXCOD)
  IF(IEXCOD.EQ.0)THEN
   IF(ISCEN.EQ.0)THEN
    CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Succesfully Simulated the Modflow simulation using:'//CHAR(13)// &
                   'MODFLOW: '//TRIM(PREFVAL(8))//CHAR(13)// &
                   'RUNFILE: '//TRIM(RUN1),'Information')
   ELSE
    CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Succesfully Simulated the Modflow simulation using:'//CHAR(13)// &
                   'MODFLOW: '//TRIM(PREFVAL(8))//CHAR(13)// &
                   'RUNFILE: '//TRIM(RUN1)//CHAR(13)// &
                   'SCENARIO: '//TRIM(SCENFNAME),'Information')
   ENDIF
  ELSE
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'An error occured in starting your simulation','Error')
  ENDIF

 ENDIF

 CALL IOSDIRCHANGE(DIRNAME)

 END SUBROUTINE MODEL1START

 !###======================================================================
 LOGICAL FUNCTION MODEL1WRITERUNFILE(RUN1,RUN2,ISUB,SIMNPER,INIDATE)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: RUN1,RUN2,INIDATE
 INTEGER,INTENT(IN) :: ISUB,SIMNPER
 INTEGER :: IU,JU,KU,IOS,NLAY_ORG,NSCL_ORG,I,J,K,KPER,ISAVE,IPER
 CHARACTER(LEN=256) :: LINE,FNAME
 REAL :: DELT,DX,FCT,IMP,DELTCNVG
 CHARACTER(LEN=50) :: CDATE,FRM
 LOGICAL :: LEX,LDATE

 MODEL1WRITERUNFILE=.FALSE.

 CALL UTL_CREATEDIR(RUN2)

 JU=UTL_GETUNIT()
 CALL OSD_OPEN(JU,FILE=TRIM(RUN2)//'\IMODFLOW.RUN',STATUS='REPLACE',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Modflow is allready running, you can not start '//CHAR(13)// &
   'new run while previous run is still running','Error')
  RETURN
 ENDIF

 !## open runfile to be copied!
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=RUN1,STATUS='OLD',ACTION='READ,DENYWRITE')

 READ(IU,*)
 WRITE(JU,'(A)') '"'//TRIM(RUN2)//'"'
! READ(IU,*)  NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF
 READ(IU,'(A256)',IOSTAT=IOS) LINE
 READ(LINE,*,IOSTAT=IOS) NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL,IARMSWP,IBNDCHK
 IF(IOS.NE.0)THEN
  IBNDCHK=0
  READ(LINE,*,IOSTAT=IOS) NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL,IARMSWP
  IF(IOS.NE.0)THEN
   IARMSWP=0
   READ(LINE,*,IOSTAT=IOS) NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL
   IF(IOS.NE.0)THEN
    IFVDL=0
    READ(LINE,*,IOSTAT=IOS) NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF,IUNCONF
    IF(IOS.NE.0)THEN
     IUNCONF=0
     READ(LINE,*,IOSTAT=IOS) NLAY_ORG,MXNLAY,NPER,ISS,NSCL_ORG,IFTEST,ICONCHK,IIPF
    ENDIF
   ENDIF
  ENDIF
 ENDIF 

 IF(NSCL_ORG.GT.2)THEN 
  CLOSE(IU); CLOSE(JU); CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You can not run a simulation with NSCL.GT.2','Error')
  RETURN
 ENDIF

 !## no extra testing
 IFTEST=0
 LINE=TRIM(ITOS(NLAY))//','//TRIM(ITOS(MXNLAY))//','//TRIM(ITOS(NPER+SIMNPER))//','//TRIM(ITOS(ISS))//','//TRIM(ITOS(NSCL))//','// &
      TRIM(ITOS(IFTEST))//','//TRIM(ITOS(ICONCHK))//','//TRIM(ITOS(IIPF))//','//TRIM(ITOS(IUNCONF))//','//TRIM(ITOS(IFVDL))//','// &
      TRIM(ITOS(IARMSWP))//','//TRIM(ITOS(IBNDCHK))
 WRITE(JU,'(A)') TRIM(LINE)
 DO I=1,ABS(IIPF); READ(IU,'(A256)') LINE; WRITE(JU,'(A)') TRIM(LINE); ENDDO
 READ(IU,'(A)')  LINE
 LINE=TRIM(ITOS(NMULT))//','//TRIM(ITOS(IDBG))//','//TRIM(ITOS(IEXPORT))//','//TRIM(ITOS(IPOSWEL))//',' &
           //TRIM(ITOS(ISCEN))//','//TRIM(ITOS(IBUDGET))//','//TRIM(RTOS(MINKD,'E',3))//','//TRIM(RTOS(MINC,'E',3))
 WRITE(JU,'(A)') TRIM(LINE)

 READ(IU,*)
 DELTCNVG=0.0
 LINE=TRIM(ITOS(MXITER))//','//TRIM(ITOS(NITER))//','//TRIM(RTOS(HCLOSE,'E',3))//','//TRIM(RTOS(RCLOSE,'E',3))//',' &
           //TRIM(RTOS(RELAX,'F',2))//','//TRIM(ITOS(NPCOND))//','//TRIM(RTOS(MAXWBAL,'F',3))//','//TRIM(ITOS(MAXICVNG))//',' &
           //TRIM(RTOS(DELTCNVG,'F',2))//','//TRIM(ITOS(IDAMPING))
           
 WRITE(JU,'(A)') TRIM(LINE)

 IF(NSCL_ORG.NE.0)READ(IU,*) !## simbox(1:4),simcsize,mdlbuffer

 DO I=1,NMULT; READ(IU,*); ENDDO
 
 IF(NMULT.EQ.1)THEN

  !## round to nearest snap ...

  !## xmin
  J =INT((SIMBOX(1)-MODBOX(1))/SIMCSIZE)
  DX=SIMBOX(1)-MODBOX(1)
  SIMBOX(1)=MAX(MODBOX(1),MODBOX(1)+J*SIMCSIZE)
  !## ymin
  J =INT((SIMBOX(2)-MODBOX(2))/SIMCSIZE)
  DX=SIMBOX(2)-MODBOX(2)
  SIMBOX(2)=MAX(MODBOX(2),MODBOX(2)+J*SIMCSIZE)
  !## xmax
  J =INT((SIMBOX(3)-MODBOX(3))/SIMCSIZE)
  DX=SIMBOX(3)-MODBOX(3)
  IF(MOD(DX,SIMCSIZE).NE.0)J=J+1
  SIMBOX(3)=MIN(MODBOX(3),MODBOX(3)+J*SIMCSIZE)
  !## ymax
  J =INT((SIMBOX(4)-MODBOX(4))/SIMCSIZE)
  DX=SIMBOX(4)-MODBOX(4)
  IF(MOD(DX,SIMCSIZE).NE.0)J=J+1
  SIMBOX(4)=MIN(MODBOX(4),MODBOX(4)+J*SIMCSIZE)

  LINE=''
  DO I=1,4
   LINE=TRIM(LINE)//TRIM(RTOS(SIMBOX(I),'F',2))//','
  ENDDO
 
  IF(NSCL.EQ.1)LINE=TRIM(LINE)//TRIM(RTOS(SIMCSIZE,'F',2))//','//TRIM(RTOS(MDLBUFFER,'F',2))
  IF(NSCL.EQ.2)LINE=TRIM(LINE)//TRIM(RTOS(SIMCSIZE,'F',2))//','//TRIM(RTOS(MAXSIMCSIZE,'F',2))//','//TRIM(RTOS(MDLBUFFER,'F',2))

  WRITE(JU,'(A)') TRIM(ADJUSTL(LINE))

 ELSE
  !## something to do with nmult>1

 ENDIF

 IF(ISCEN.EQ.1)WRITE(JU,*) '"'//TRIM(SCENFNAME)//'"'

 READ(IU,*)
 WRITE(JU,'(A)') 'ACTIVE MODULES'

 !## skip original runfile until MODULES FOR EACH LAYER
 DO
  READ(IU,'(A256)') LINE; LINE=UTL_CAP(LINE,'U')
  IF(INDEX(LINE,'MODULES FOR EACH LAYER').GT.0)EXIT
 END DO

 !## write new modules/packages that are active
 DO I=1,NMP_ACT
  K=MDL_IPOS(I)
  IF(NLMDL(K).EQ.0)WRITE(FRM,'(A9)') '(I2,I3,A)'
  IF(NLMDL(K).GT.0)WRITE(FRM,'(A4,I3,A5)') '(I2,',NLMDL(K)+1,'I3,A)'
  WRITE(LINE,FRM,IOSTAT=IOS) IAMDL(K),NLMDL(K),(ILMDL(K,J),J=1,NLMDL(K)),' ('//TRIM(MDLKEYWS(K))//')'
  WRITE(JU,'(A)') TRIM(LINE)
 END DO

 INQUIRE(FILE=PREFVAL(8),EXIST=LEX)
 IF(.NOT.LEX)THEN
  CLOSE(IU)
  CLOSE(JU,STATUS='DELETE')
  CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Given MODFLOW executable in *.prf-file: '//CHAR(13)// &
    'MODFLOW=[ '//TRIM(PREFVAL(8))//' ]'//CHAR(13)//' is empty or does not exist!','Error')
  RETURN
 ENDIF

 !## write bndfname
 IF(LEN_TRIM(BNDFNAME).EQ.0)THEN
  FNAME=TRIM(RTOS(IDF%XMIN,'F',2))//','//TRIM(RTOS(IDF%YMIN,'F',2))//','//TRIM(RTOS(IDF%XMAX,'F',2))//','//TRIM(RTOS(IDF%YMAX,'F',2))
  WRITE(JU,'(A)') TRIM(FNAME)
 ELSE
  FNAME=BNDFNAME
  CALL IUPPERCASE(FNAME)
  FNAME=UTL_SUBST(FNAME,TRIM(REPLACESTRING),PREFVAL(5))
  WRITE(JU,'(A)') '"'//TRIM(FNAME)//'"'
 ENDIF

 WRITE(JU,'(A)') 'MODULES FOR EACH LAYER'

 CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(4,'Writing runfile ...')

 !## copy of packages in tmp-runfiles
 KU=0
 IPER=0
 !## copy paste entire runfile
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT

  LDATE=.FALSE.
  READ(LINE,*,IOSTAT=IOS) I,FCT,IMP
  !## try date 
  IF(IOS.NE.0)THEN
   READ(LINE,*,IOSTAT=IOS) KPER,DELT,CDATE,ISAVE
   IF(IOS.EQ.0)THEN
    LDATE=.TRUE. 
    IPER=IPER+1
   ENDIF
  ENDIF
  IF(LDATE)THEN 
   IF(IBUFFER.EQ.0)ISAVE=-1*ABS(ISAVE)
   IF(IBUFFER.EQ.1)ISAVE=   ABS(ISAVE)
   IF(ISUB.EQ.0)THEN
    LINE=TRIM(ITOS(KPER))//','//TRIM(RTOS(DELT,'F',2))//','//TRIM(CDATE)//','//TRIM(ITOS(ISAVE))
   ELSE
    LINE=TRIM(ITOS(KPER))//','//TRIM(RTOS(DELT,'F',2))//','//TRIM(INIDATE)//','//TRIM(ITOS(ISAVE))
   ENDIF
   WRITE(JU,'(A)') TRIM(ADJUSTL(LINE))
  ELSE
   !## start of data block found ... see whether runfile need to be copied
   IF(INDEX(LINE,'(').GT.0.AND.INDEX(LINE,')').GT.0.AND.ISUB.EQ.1.AND.IPER.GT.0)THEN 
    !## close previous unit
    IF(KU.GT.0)THEN; INQUIRE(UNIT=KU,OPENED=LEX); IF(LEX)CLOSE(KU); ENDIF
    KU=UTL_GETUNIT()
    CALL OSD_OPEN(KU,FILE=TRIM(RUN2)//'\org_'//LINE(INDEX(LINE,'(')+1:INDEX(LINE,')')-1)//'.RUN',STATUS='REPLACE', &
        ACTION='WRITE,DENYREAD',IOSTAT=IOS)
    IF(IOS.NE.0)THEN
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not create '//TRIM(RUN2)//'\org_'// &
       LINE(INDEX(LINE,'(')+1:INDEX(LINE,')')-1)//'.RUN','Error')
     RETURN
    ENDIF
   ENDIF
   LINE=UTL_CAP(LINE,'U')
   LINE=UTL_SUBST(LINE,TRIM(REPLACESTRING),PREFVAL(5))

   !## try find extent ... to put quotes around it (for reasons of security)
   IF(INDEX(LINE,'\',.TRUE.).GT.0)THEN
    I=INDEX(LINE,'.',.TRUE.)
    !## found extent
    IF(I.GT.0)THEN
     J=INDEX(LINE,',',.TRUE.)
     !## found comma ---- BEFORE extent!
     IF(J.GT.0.AND.J.LT.I)THEN
      FNAME=LINE(J+1:)
      !## read without quotes
      READ(FNAME,*) FNAME
      !## assign quotes if neccessary
      IF(INDEX(TRIM(FNAME),' ').GT.0)THEN
       LINE =LINE(:J-1)//',"'//TRIM(ADJUSTL(FNAME))//'"'
      ELSE
       LINE =LINE(:J-1)//','//TRIM(ADJUSTL(FNAME))
      ENDIF
     ELSE
      !## read without quotes
      READ(LINE,*) LINE
      IF(INDEX(TRIM(LINE),' ').GT.0)THEN
       LINE ='"'//TRIM(ADJUSTL(LINE))//'"'
      ELSE
       LINE =TRIM(ADJUSTL(LINE))
      ENDIF
     ENDIF
    ENDIF
   ENDIF

   WRITE(JU,'(A)') TRIM(ADJUSTL(LINE))
   IF(KU.NE.0)WRITE(KU,'(A)') TRIM(ADJUSTL(LINE))
  ENDIF
 END DO

 CALL WINDOWSELECT(0)
 CALL WINDOWOUTSTATUSBAR(4,'')

 CLOSE(IU)
 CLOSE(JU)
 IF(KU.GT.0)THEN; INQUIRE(UNIT=KU,OPENED=LEX); IF(LEX)CLOSE(KU); ENDIF

 MODEL1WRITERUNFILE=.TRUE.

 END FUNCTION MODEL1WRITERUNFILE

 !###======================================================================
 SUBROUTINE MODEL1COPYRUNFILE(IBATCH)
 !###======================================================================
 IMPLICIT NONE
 REAL,PARAMETER :: TINY=0.01
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: IU,JU,KU,I,II,J,JJ,K,IOS,IROW,ICOL,N
 REAL :: X1,Y1,X2,Y2,DX
 CHARACTER(LEN=256) :: LINE,STRING,FNAMETO,FNAME,FNAME1,FNAME2  
 CHARACTER(LEN=52) :: SUBMAP
 CHARACTER(LEN=4),DIMENSION(10) :: EXTISG
 LOGICAL :: LEX,LCOPY
 DATA EXTISG/'ISG','ISP','ISD1','ISD2','ISC1','ISC2','IST1','IST2','ISQ1','ISQ2'/

 IF(IBATCH.EQ.0)THEN

  !## get current simulation window
  CALL MODEL1GETSIMBOX()

  RESDIR=TRIM(PREFVAL(1))
  CALL WSELECTDIR(NONEXPATH+DIRCHANGE+DIRCREATE,RESDIR,'Select/Create Folder to store copy')
  IF(WINFODIALOG(4).NE.1)RETURN

  CALL WDIALOGSELECT(ID_DMDLTAB1)
  CALL WDIALOGGETMENU(IDF_MENU1,I,RUNFILE)
  RUNFILE=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(RUNFILE)

 ENDIF

 !## open runfile
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=RUNFILE,STATUS='OLD',ACTION='READ,DENYWRITE',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open selected runfile for reading!','Error')
  IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Can not open selected runfile ['//TRIM(RUNFILE)//'] for reading!'
  RETURN
 ENDIF

 FNAME=TRIM(RUNFILE(INDEX(RUNFILE,'\',.TRUE.)+1:))

 !## create result-folder
 CALL UTL_CREATEDIR(RESDIR)
 
 JU=UTL_GETUNIT()
 CALL OSD_OPEN(JU,FILE=TRIM(RESDIR)//'\'//TRIM(FNAME),STATUS='REPLACE',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CLOSE(IU)
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open new runfile:'//CHAR(13)// &
    TRIM(RESDIR)//'\'//TRIM(FNAME),'Error')
  IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Can not open new runfile: ['//TRIM(RESDIR)//'\'//TRIM(FNAME)//']'
  RETURN
 ENDIF

 IF(IBATCH.EQ.0)THEN
  CALL UTL_MESSAGEHANDLE(0)
  CALL WINDOWSELECT(0)
  CALL WINDOWOUTSTATUSBAR(4,'Copy runfile/content ...')
 ELSE
  WRITE(*,'(A)') 'Copy runfile/content ...'
 ENDIF

 NIPF=1
 CALL IPFALLOCATE()
 IPF(1)%XCOL =1 !## x
 IPF(1)%YCOL =2 !## y
 IPF(1)%ZCOL =1 !## z not used
 IPF(1)%Z2COL=1 !## z not used
 IPF(1)%QCOL =1 !## q not used
 
 !## no window given
 LCOPY=.FALSE.; IF(SIMBOX(1).EQ.SIMBOX(3).AND.SIMBOX(2).EQ.SIMBOX(4))LCOPY=.TRUE.

 !## get the cellsize
 READ(IU,'(A256)') LINE
! WRITE(JU,'(A)') TRIM(LINE)
 DO
  READ(IU,'(A256)',IOSTAT=IOS) STRING
  STRING=ADJUSTL(STRING)
  IF(IOS.NE.0)THEN
   IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not find [ACTIVE MODULES]','Error')
   IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Can not find [ACTIVE MODULES]'
   RETURN
  ENDIF
  IF(TRIM(UTL_CAP(STRING,'U')).EQ.'ACTIVE MODULES')THEN
   READ(LINE,*) X1,Y1,X2,Y2,DX
   IF(X1.EQ.1.0.OR.X1.EQ.0.0)READ(LINE,*) I,X1,Y1,X2,Y2,DX
   IF(SIMBOX(1).EQ.SIMBOX(3).AND.SIMBOX(2).EQ.SIMBOX(4))THEN
    SIMBOX(1)=X1; SIMBOX(2)=Y1; SIMBOX(3)=X2; SIMBOX(4)=Y2
   ENDIF
   EXIT
  ENDIF
  LINE=STRING
 ENDDO
 
 REWIND(IU)
 
 SUBMAP=''
 K=0
MAINLOOP: DO
  LEX=.TRUE.
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  I=INDEX(LINE,'(')
  J=INDEX(LINE,')')
  IF(I.GT.0.AND.J.GT.0)SUBMAP=UTL_CAP(LINE(I+1:J-1),'U')
  IF(SUBMAP.EQ.'')SUBMAP='GENERAL'
  LINE=UTL_CAP(LINE,'U')
  LINE=UTL_SUBST(LINE,TRIM(REPLACESTRING),PREFVAL(5))
  K=K+1
  !## try find extent
  DO I=1,SIZE(EXT)
   J=INDEX(LINE,EXT(I),.TRUE.)
   !## found extent
   IF(J.GT.0)THEN
    !## found comma (before)
    J=INDEX(LINE(:J),',',.TRUE.)+1
    IF(J.GT.0)THEN
     READ(LINE(J:),*) FNAME 
     INQUIRE(FILE=FNAME,EXIST=LEX)
     IF(.NOT.LEX)THEN
      IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can not find '//CHAR(13)//'['//TRIM(FNAME)//']','Error')
      IF(IBATCH.EQ.1)WRITE(*,'(A)') 'iMOD can not find ['//TRIM(FNAME)//']'
      EXIT MAINLOOP
     ENDIF
     
     JJ=0
     IF(LEN_TRIM(CLIPDIR).GT.0)THEN
      JJ=INDEX(UTL_CAP(FNAME,'U'),TRIM(UTL_CAP(CLIPDIR,'U')))
      !## clipdir found
      IF(JJ.GT.0)FNAMETO=UTL_SUBST(UTL_CAP(FNAME,'U'),TRIM(UTL_CAP(CLIPDIR,'U')),TRIM(UTL_CAP(RESDIR,'U')))
     ENDIF
     IF(JJ.EQ.0)THEN
      IF(TRIM(SUBMAP).EQ.'')FNAMETO=TRIM(RESDIR)//'\GENERAL\VERSION_1\'//TRIM(FNAME(INDEX(FNAME,'\',.TRUE.)+1:))
      IF(TRIM(SUBMAP).NE.'')FNAMETO=TRIM(RESDIR)//'\'//TRIM(SUBMAP)//'\VERSION_1\'//TRIM(FNAME(INDEX(FNAME,'\',.TRUE.)+1:))
     ENDIF
     
     !## filename allready exists
     INQUIRE(FILE=FNAMETO,EXIST=LEX)
     !## boundaries always because of the boundary file that could be used previously
     IF(TRIM(SUBMAP).EQ.'BND')LEX=.FALSE.

     IF(.NOT.LEX)THEN

      !## resize IDF-file
      IF(EXT(I).EQ.'.IDF')THEN
       
       IF(LCOPY)THEN
        CALL UTL_CREATEDIR(FNAMETO(:INDEX(FNAMETO,'\',.TRUE.)-1))
        CALL IOSCOPYFILE(FNAME,FNAMETO)
       ELSE
        IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Processing '//TRIM(FNAME))
        IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Processing '//TRIM(FNAME)
        !## include constant head around it
        IF(TRIM(SUBMAP).EQ.'BND')THEN
         !## scale boundary because otherwise the size of the model becomes too less
         IDFC%XMIN=SIMBOX(1); IDFC%YMIN=SIMBOX(2)
         IDFC%XMAX=SIMBOX(3); IDFC%YMAX=SIMBOX(4); IDFC%DX=DX ;IDFC%DY=IDFC%DX
         IDFC%NCOL=(IDFC%XMAX-IDFC%XMIN)/IDFC%DX;  IDFC%NROW=(IDFC%YMAX-IDFC%YMIN)/IDFC%DY
         IF(.NOT.IDFREADSCALE(FNAME,IDFC,1,1,0.0,0))RETURN
         DO IROW=1,IDFC%NROW
          IF(IDFC%X(1,IROW)        .GT.0)IDFC%X(1,IROW)        =-1
          IF(IDFC%X(IDFC%NCOL,IROW).GT.0)IDFC%X(IDFC%NCOL,IROW)=-1
         ENDDO
         DO ICOL=1,IDFC%NCOL
          IF(IDFC%X(ICOL,1)        .GT.0)IDFC%X(ICOL,1)        =-1
          IF(IDFC%X(ICOL,IDFC%NROW).GT.0)IDFC%X(ICOL,IDFC%NROW)=-1
         ENDDO
        ELSE
         !## read part of idf and store in idf()%x() - create smaller resolution!
         IF(.NOT.IDFREAD(IDFC,FNAME,0))EXIT
         IF(.NOT.IDFREADPART(IDFC,SIMBOX(1),SIMBOX(2)+TINY,SIMBOX(3)-TINY,SIMBOX(4)))RETURN
        ENDIF
        IF(.NOT.IDFWRITE(IDFC,FNAMETO,1))RETURN
        CALL IDFDEALLOCATEX(IDFC)
        IF(IDFC%IU.GT.0)CLOSE(IDFC%IU)
       ENDIF
       IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Copy runfile/content ...')
     
      ELSEIF(EXT(I).EQ.'.IPF')THEN

       IPF(1)%FNAME=FNAME
       !# read entire ipf
       IF(.NOT.IPFREAD2(1,1,0))RETURN

       IF(IPF(1)%ACOL.GT.0)THEN
        KU=UTL_GETUNIT()
        CALL OSD_OPEN(KU,FILE=TRIM(PREFVAL(1))//'\TMP\copy.bat',STATUS='REPLACE',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
        IF(IOS.NE.0)THEN
         CLOSE(IU); CLOSE(JU)
         IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open '//TRIM(PREFVAL(1))//'\tmp\copy.bat','Error')
         IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Can not open '//TRIM(PREFVAL(1))//'\tmp\copy.bat'
         RETURN
        ENDIF
       ENDIF
       
       !## check points inside area
       N=0
       DO II=1,IPF(1)%NROW
        IF(IPF(1)%XYZ(1,II).GE.SIMBOX(1).AND.IPF(1)%XYZ(1,II).LE.SIMBOX(3).AND. &
           IPF(1)%XYZ(2,II).GE.SIMBOX(2).AND.IPF(1)%XYZ(2,II).LE.SIMBOX(4))THEN
         N=N+1
         IPF(1)%INFO(:,N)=IPF(1)%INFO(:,II)
         !## store associated file to be copied -- if available
         IF(IPF(1)%ACOL.GT.0)THEN
          !## old associated filename      
          FNAME1=FNAME(:INDEX(FNAME,'\',.TRUE.)-1)//'\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,II))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
          INQUIRE(FILE=FNAME1,EXIST=LEX)
          IF(.NOT.LEX)THEN
           IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,TRIM(FNAME1)//' does not exists!')
           IF(IBATCH.EQ.1)WRITE(*,'(A)') TRIM(FNAME1)//' does not exists!'
          ELSE
           FNAME2=TRIM(RESDIR)//'\'//TRIM(SUBMAP)  //'\VERSION_1\'//TRIM(IPF(1)%INFO(IPF(1)%ACOL,II))//'.'//TRIM(ADJUSTL(IPF(1)%FEXT))
           CALL UTL_CREATEDIR(FNAME2(:INDEX(FNAME2,'\',.TRUE.)-1))
           !## copy batch
           STRING='copy '//TRIM(FNAME1)//' '//TRIM(FNAME2)
           WRITE(KU,'(A)') TRIM(STRING)
          ENDIF
         ENDIF     
        ENDIF
       END DO
       CALL UTL_CREATEDIR(FNAMETO(:INDEX(FNAMETO,'\',.TRUE.)-1))
       IPF(1)%NROW=N
       IPF(1)%FNAME=FNAMETO
       IF(.NOT.IPFWRITE(1))RETURN
       !## start copying
       IF(IPF(1)%ACOL.GT.0)THEN
        CLOSE(KU)
        CALL IOSCOMMAND(TRIM(PREFVAL(1))//'\TMP\COPY.BAT',PROCBLOCKED)
       ENDIF
       
      ELSEIF(EXT(I).EQ.'.ISG')THEN
      
       CALL UTL_CREATEDIR(FNAMETO(:INDEX(FNAMETO,'\',.TRUE.)-1))
       DO II=1,SIZE(EXTISG)
        FNAME1=FNAME  (:INDEX(FNAME  ,'.',.TRUE.))//TRIM(EXTISG(II))
        FNAME2=FNAMETO(:INDEX(FNAMETO,'.',.TRUE.))//TRIM(EXTISG(II))
        CALL IOSCOPYFILE(TRIM(FNAME1),TRIM(FNAME2))
       ENDDO
       
      ELSE

       CALL UTL_CREATEDIR(FNAMETO(:INDEX(FNAMETO,'\',.TRUE.)-1))
       CALL IOSCOPYFILE(TRIM(FNAME),TRIM(FNAMETO))

      ENDIF
     ELSE
      IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,TRIM(FNAMETO)//' allready exists!')
      IF(IBATCH.EQ.1)WRITE(*,'(A)') TRIM(FNAMETO)//' allready exists!'
     ENDIF
     LINE=UTL_SUBST(LINE,TRIM(FNAME),TRIM(FNAMETO))
     EXIT
    ENDIF
   ENDIF
  ENDDO
  WRITE(JU,'(A)') TRIM(LINE)
 ENDDO MAINLOOP

 IF(IBATCH.EQ.0)THEN
  CALL UTL_MESSAGEHANDLE(1)
  CALL WINDOWSELECT(0)
  CALL WINDOWOUTSTATUSBAR(4,'')
 ENDIF

 CLOSE(IU)
 IF(.NOT.LEX)THEN
  CLOSE(JU,STATUS='DELETE')
  IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can not copy '//CHAR(13)//TRIM(FNAME),'Error')
  IF(IBATCH.EQ.1)WRITE(*,'(A)') 'iMOD can not copy '//CHAR(13)//TRIM(FNAME)
 ELSE
  CLOSE(JU)
  IF(IBATCH.EQ.0)THEN
   IF(.NOT.MODEL1FILL_RUNFILES())RETURN
  ENDIF
 ENDIF

 END SUBROUTINE MODEL1COPYRUNFILE

 !###======================================================================
 SUBROUTINE MODEL1CHECKRUNFILE(RUNFNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: RUNFNAME
 CHARACTER(LEN=256) :: LINE,FNAME
 INTEGER :: I,J,K,IOS,IU,JU,IWIN
 LOGICAL :: LEX

 CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(4,'Checking runfile ...')

 !## open runfile
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=RUNFNAME,STATUS='OLD',ACTION='READ,DENYWRITE',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open runfile:'//CHAR(13)// &
   TRIM(RUNFNAME)//CHAR(13)//'for reading purposes.','Error')
  RETURN
 ENDIF

 JU=UTL_GETUNIT()
 CALL OSD_OPEN(JU,FILE=TRIM(PREFVAL(1))//'\tmp\runfile.log',STATUS='REPLACE',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CLOSE(IU)
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open logfile:'//CHAR(13)// &
   TRIM(PREFVAL(1))//'\tmp\runfile.log','Error')
  RETURN
 ENDIF

 CALL UTL_MESSAGEHANDLE(0)
 
 WRITE(JU,'(A)') 'Check-result for:'
 WRITE(JU,'(A)') TRIM(RUNFNAME)
 WRITE(JU,'(/A/)') 'Non-existing files:'
 WRITE(JU,'(A10,1X,A)') 'Line','File'
 
 K=0
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  LINE=UTL_CAP(LINE,'U')
  K=K+1
  !## try find extent
  DO I=1,SIZE(EXT)
   J=INDEX(LINE,EXT(I),.TRUE.)
   !## found extent
   IF(J.GT.0)THEN
    J=INDEX(LINE,',',.TRUE.)+1
    !## found comma
    IF(J.GT.0)THEN
     FNAME=LINE(J:)
     READ(FNAME,*) FNAME !## remove quotes (if existing)
     FNAME=UTL_SUBST(FNAME,TRIM(REPLACESTRING),PREFVAL(5))
     INQUIRE(FILE=FNAME,EXIST=LEX)
     IF(.NOT.LEX)WRITE(JU,'(I10,1X,A)') K,TRIM(FNAME)
     EXIT
    ENDIF
   ENDIF
  ENDDO
 ENDDO

 CLOSE(IU); CLOSE(JU)

 CALL UTL_MESSAGEHANDLE(1)
 CALL WINDOWSELECT(0)
 CALL WINDOWOUTSTATUSBAR(4,'')

 CALL WINDOWOPENCHILD(IWIN,FLAGS=SYSMENUON,WIDTH=1000,HEIGHT=500)
 CALL WINDOWSELECT(IWIN)
 FNAME=TRIM(PREFVAL(1))//'\tmp\runfile.log'
 CALL WEDITFILE(FNAME,ITYPE=MODAL,IDMENU=0,IFONT=COURIERNEW,ISIZE=10)

 END SUBROUTINE MODEL1CHECKRUNFILE

 !###======================================================================
 LOGICAL FUNCTION MODEL1CHECK(FNAME,IU,JU)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER,INTENT(IN) :: IU,JU
 INTEGER :: IOS
 REAL :: X

 READ(FNAME,*,IOSTAT=IOS) X
 IF(IOS.NE.0)THEN
  INQUIRE(FILE=FNAME,EXIST=MODEL1CHECK)
  IF(.NOT.MODEL1CHECK)THEN
   CLOSE(IU)
   CLOSE(JU,STATUS='DELETE')
   CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'File '//TRIM(FNAME)//CHAR(13)// &
   'does not exists!','Error')
  ENDIF
 ELSE
  MODEL1CHECK=.TRUE.
 ENDIF

 END FUNCTION MODEL1CHECK

 !###======================================================================
 SUBROUTINE MODEL1DEFINEBOX()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,IDOWN
 REAL :: XC1,YC1,XC2,YC2

 CALL UTL_HIDESHOWDIALOG(ID_DMODEL,0)
 CALL WCURSORSHAPE(ID_CURSORNETWORK)
 CALL WINDOWOUTSTATUSBAR(4,'Click your right mouse button to quit')

 IDOWN=0
 DO

  CALL WMESSAGE(ITYPE, MESSAGE)
  SELECT CASE(ITYPE)

   CASE(MOUSEMOVE)

    CALL WINDOWSELECT(0)
    CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(ITOS(INT(MESSAGE%GX)))//' m; Y:'//TRIM(ITOS(INT(MESSAGE%GY)))//' m')
    XC2=MESSAGE%GX
    YC2=MESSAGE%GY
    
    IF(XC2.LT.MODBOX(1).OR.XC2.GT.MODBOX(3).OR. &
       YC2.LT.MODBOX(2).OR.YC2.GT.MODBOX(4))THEN
     IF(WINFOMOUSE(MOUSECURSOR).NE.CURHOURGLASS)CALL WCURSORSHAPE(CURHOURGLASS)
     CALL WINDOWOUTSTATUSBAR(2,'Outside model domain')
    ELSE
     IF(WINFOMOUSE(MOUSECURSOR).NE.ID_CURSORNETWORK)CALL WCURSORSHAPE(ID_CURSORNETWORK)
     IF(IDOWN.EQ.1)CALL WINDOWOUTSTATUSBAR(2,'DeltaX:'//TRIM(ITOS(INT(XC2-XC1)))//' m; DeltaY:'//TRIM(ITOS(INT(YC2-YC1)))//' m')
    ENDIF  

    !## first point set!
    IF(IDOWN.EQ.1)THEN
     !## remove previous one
     CALL MODEL1DRAW_SIMBOX(.FALSE.)
     CALL MODEL1PUTSIMBOX(MIN(XC1,XC2),MIN(YC1,YC2),MAX(XC1,XC2),MAX(YC1,YC2))
     CALL MODEL1GETSIMBOX()
     CALL MODEL1FIELDS()
     !## draw updated one
     CALL MODEL1DRAW_SIMBOX(.FALSE.)
    ENDIF

   !## mouse button pressed
   CASE (MOUSEBUTDOWN)
   
    SELECT CASE (MESSAGE%VALUE1)
     !## left button
     CASE (1)
      IF(WINFOMOUSE(MOUSECURSOR).NE.CURHOURGLASS)THEN
       IF(IDOWN.EQ.0)THEN
        XC1=XC2
        YC1=YC2
        IDOWN=1
       ELSEIF(IDOWN.EQ.1)THEN
        EXIT
       ENDIF
      ENDIF
     !## right button
     CASE (3)
      EXIT
    END SELECT
    
   CASE (BITMAPSCROLLED)
    MPW%IX=MESSAGE%VALUE1
    MPW%IY=MESSAGE%VALUE2

  END SELECT
 ENDDO

 CALL WCURSORSHAPE(CURARROW)
 CALL IGRPLOTMODE(MODECOPY)

 CALL WINDOWSELECT(0)
 CALL WINDOWOUTSTATUSBAR(2,'')
 CALL WINDOWOUTSTATUSBAR(4,'')
 CALL UTL_HIDESHOWDIALOG(ID_DMODEL,2)

 END SUBROUTINE MODEL1DEFINEBOX

 !###======================================================================
 SUBROUTINE MODEL1PUTSIMBOX(XMIN,YMIN,XMAX,YMAX)
 !###======================================================================
 IMPLICIT NONE
 REAL,INTENT(IN) :: XMIN,XMAX,YMIN,YMAX
 REAL :: DX,DY

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGPUTREAL(IDF_REAL1,MAX(MODBOX(1),XMIN),'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL4,MAX(MODBOX(2),YMIN),'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL2,MIN(MODBOX(3),XMAX),'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL5,MIN(MODBOX(4),YMAX),'(F10.2)')
 DX=MIN(MODBOX(3),XMAX)-MAX(MODBOX(1),XMIN)
 DY=MIN(MODBOX(4),YMAX)-MAX(MODBOX(2),YMIN)
 CALL WDIALOGPUTREAL(IDF_REAL3,DX,'(F10.2)')
 CALL WDIALOGPUTREAL(IDF_REAL6,DY,'(F10.2)')

 END SUBROUTINE MODEL1PUTSIMBOX

 !###======================================================================
 SUBROUTINE MODEL1GETSIMBOX()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: NROW,NCOL,I
 REAL :: DX,DY
 CHARACTER(LEN=256) :: LINE

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGGETREAL(IDF_REAL1,SIMBOX(1))
 CALL WDIALOGGETREAL(IDF_REAL4,SIMBOX(2))
 CALL WDIALOGGETREAL(IDF_REAL2,SIMBOX(3))
 CALL WDIALOGGETREAL(IDF_REAL5,SIMBOX(4))
 DX=SIMBOX(3)-SIMBOX(1)
 DY=SIMBOX(4)-SIMBOX(2)

 !## given area of interest
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
 IF(I.EQ.1)THEN

  CALL WDIALOGGETREAL(IDF_REAL7,SIMCSIZE)
  CALL WDIALOGGETREAL(IDF_REAL8,MDLBUFFER)
  CALL WDIALOGGETREAL(IDF_REAL9,MAXSIMCSIZE)

  DX=DX+MDLBUFFER
  DY=DY+MDLBUFFER
  NCOL=INT(DX/SIMCSIZE)
  NROW=INT(DY/SIMCSIZE)

 ELSE

  !## put dimensions of idf file
  SIMBOX(1)=IDF%XMIN
  SIMBOX(2)=IDF%YMIN
  SIMBOX(3)=IDF%XMAX
  SIMBOX(4)=IDF%YMAX
  NROW     =IDF%NROW
  NCOL     =IDF%NCOL
 ENDIF

 CALL WDIALOGGETMENU(IDF_MENU3,I,LINE)
 READ(LINE,*) NLAY

 IF(NLAY.LT.MXNLAY)THEN
  CALL WDIALOGPUTSTRING(IDF_LABEL11,'Modellayer '//TRIM(ITOS(NLAY))//' will be modelled as a Constant Head Boundary')
 ELSE
  CALL WDIALOGPUTSTRING(IDF_LABEL11,'')
 ENDIF
 
 !## not possible to compute with nodes more than maxnodes
 CALL WDIALOGSELECT(ID_DMODEL)
! LEX=.TRUE.
! IF(IAMDL(1).EQ.1.AND.NROW*NCOL     .GT.MAXNODESTRANSIENT)LEX=.FALSE.
! IF(IAMDL(1).EQ.0.AND.NCOL*NROW*NLAY.GT.MAXNODESSTEADY)   LEX=.FALSE.
! IF(NROW*NCOL.LE.0)LEX=.FALSE.
! LSIM=LEX
 
 END SUBROUTINE MODEL1GETSIMBOX

 !###======================================================================
 SUBROUTINE MODEL1DRAW_SIMBOX(LSCEN)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LSCEN

 IF(IDRAW.EQ.0)RETURN 

 CALL IDFPLOT1BITMAP()
 CALL IGRPLOTMODE(MODEXOR)
 !## draw scenario polygons
 IF(LSCEN)THEN
  IF(.NOT.MODEL1PLOTFILE_SCENARIOS())THEN
   CALL MODEL1TABSTATES(.FALSE.,.FALSE.)
  ENDIF
 ENDIF
 !## draw network
 CALL MODEL1PLOT_SIMBOX()
 CALL IDFPLOT2BITMAP()

 CALL IGRPLOTMODE(MODECOPY)

 END SUBROUTINE MODEL1DRAW_SIMBOX

 !###======================================================================
 SUBROUTINE MODEL1PLOT_SIMBOX()
 !###======================================================================
 IMPLICIT NONE
 REAL :: X1,Y1,X2,Y2

 !## black - area of interest
 X1=SIMBOX(1)
 X2=SIMBOX(3)
 Y1=SIMBOX(2)
 Y2=SIMBOX(4)

 CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGUP)
 CALL IGRCOLOURN(INVERSECOLOUR(WRGB(0,0,0)))
 IF(ABS(X1-X2).GT.0.0.AND.ABS(Y2-Y1).GT.0.0)CALL IGRRECTANGLE(X1,Y1,X2,Y2)
 CALL IGRFILLPATTERN(OUTLINE)
 CALL IGRLINEWIDTH(5)
 IF(ABS(X1-X2).GT.0.0.AND.ABS(Y2-Y1).GT.0.0)CALL IGRRECTANGLE(X1,Y1,X2,Y2)

 !## buffer - green
 X1=MAX(SIMBOX(1)-MDLBUFFER,MODBOX(1))
 X2=MIN(SIMBOX(3)+MDLBUFFER,MODBOX(3))
 Y1=MAX(SIMBOX(2)-MDLBUFFER,MODBOX(2))
 Y2=MIN(SIMBOX(4)+MDLBUFFER,MODBOX(4))
 CALL IGRCOLOURN(INVERSECOLOUR(WRGB(0,255,0)))
 IF(ABS(X1-X2).GT.0.0.AND.ABS(Y2-Y1).GT.0.0)CALL IGRRECTANGLE(X1,Y1,X2,Y2)
 
 !## total model area
 X1=MODBOX(1)
 X2=MODBOX(3)
 Y1=MODBOX(2)
 Y2=MODBOX(4)
 CALL IGRCOLOURN(INVERSECOLOUR(WRGB(0,0,255)))
 IF(ABS(X1-X2).GT.0.0.AND.ABS(Y2-Y1).GT.0.0)CALL IGRRECTANGLE(X1,Y1,X2,Y2)
 CALL IGRLINEWIDTH(1)
 CALL IGRFILLPATTERN(SOLID)

 END SUBROUTINE MODEL1PLOT_SIMBOX

 !###======================================================================
 LOGICAL FUNCTION MODEL1RUNFILE()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=10),ALLOCATABLE,DIMENSION(:) :: CSIZES
 INTEGER :: I
 REAL :: DX
 CHARACTER(LEN=256) :: FNAME

 MODEL1RUNFILE=.FALSE.

 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGGETMENU(IDF_MENU1,I,FNAME)
 FNAME=TRIM(PREFVAL(1))//'\RUNFILES\'//TRIM(FNAME)

 !## read selected runfile
 IF(.NOT.MODEL1READRUNFILE(FNAME))RETURN

 !## put save options
 CALL WDIALOGSELECT(ID_DMDLTAB3)
 IF(NMP_ACT.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No modules/packages are found in the run-file'//CHAR(13)// &
      'Bracket the keyword, e.g. (bnd), otherwise iMOD can not find them','Error') 
  RETURN
 ENDIF
 CALL WDIALOGPUTMENU(IDF_MENU1,MDLALIAS_ACT,NMP_ACT,1)

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 !## plot fname of idf
 CALL WDIALOGPUTSTRING(IDF_STRING1,BNDFNAME)
 !## define box
 CALL WDIALOGPUTREAL(IDF_REAL1,MODBOX(1))
 CALL WDIALOGPUTREAL(IDF_REAL4,MODBOX(2))
 CALL WDIALOGPUTREAL(IDF_REAL2,MODBOX(3))
 CALL WDIALOGPUTREAL(IDF_REAL5,MODBOX(4))
 !## simcsize
 IF(ALLOCATED(CSIZES))DEALLOCATE(CSIZES)
 ALLOCATE(CSIZES(MAXCSIZES))
 CSIZES(1) ='1.0'
 CSIZES(2) ='5.0'
 CSIZES(3) ='10.0'
 CSIZES(4) ='25.0'
 CSIZES(5) ='50.0'
 CSIZES(6) ='100.0'
 CSIZES(7) ='250.0'
 CSIZES(8) ='500.0'
 CSIZES(9) ='750.0'
 CSIZES(10)='1000.0'
 CSIZES(11)='1250.0'
 CSIZES(12)='2500.0'
 CSIZES(13)='5000.0'
 CSIZES=ADJUSTR(CSIZES)
 CALL WDIALOGPUTMENU(IDF_MENU1,CSIZES,13,4)  !## simcsize
 CALL WDIALOGPUTMENU(IDF_MENU4,CSIZES,13,6)  !## max simcsize
 CALL WDIALOGPUTREAL(IDF_REAL7,SIMCSIZE)     !## simcsize
 CALL WDIALOGPUTREAL(IDF_REAL9,4.0*SIMCSIZE) !## max simcsize

 !## buffer
 DX=-100.0
 DO I=1,MAXCSIZES
  DX=DX+100.0
  WRITE(CSIZES(I),'(F10.2)') DX
 END DO
 CALL WDIALOGPUTMENU(IDF_MENU2,CSIZES,MAXCSIZES,16)
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGPUTMENU(IDF_MENU3,CSIZES,MAXCSIZES,16)
 IF(ALLOCATED(CSIZES))DEALLOCATE(CSIZES)

 !## nlay
 ALLOCATE(CSIZES(MXNLAY))
 DX=0.0
 DO I=1,MXNLAY !NLAY
  DX=DX+1.0
  WRITE(CSIZES(I),'(I10)') INT(DX)
 END DO
 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGPUTMENU(IDF_MENU3,CSIZES,MXNLAY,MXNLAY)
 IF(ALLOCATED(CSIZES))DEALLOCATE(CSIZES)

 CALL WDIALOGPUTREAL(IDF_REAL8,MDLBUFFER)

 !## put iteration options
 CALL WDIALOGSELECT(ID_DMDLTAB6)
 CALL WDIALOGPUTREAL(IDF_REAL1,HCLOSE,'(E10.4)')
 CALL WDIALOGPUTREAL(IDF_REAL2,RCLOSE,'(E10.4)')
 CALL WDIALOGPUTREAL(IDF_REAL3,RELAX,'(F10.3)')
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MXITER)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,NITER)
 CALL WDIALOGPUTREAL(IDF_REAL4,MAXWBAL,'(F10.3)')
 CALL WDIALOGPUTINTEGER(IDF_INTEGER3,MAXICVNG)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,IDAMPING)
 NPCOND=MAX(1,MIN(2,NPCOND))
 CALL WDIALOGPUTOPTION(IDF_MENU1,NPCOND)
 CALL WDIALOGPUTREAL(IDF_REAL5,MINKD,'(F10.3)')
 CALL WDIALOGPUTREAL(IDF_REAL6,MINC,'(F10.3)')

 !## initial simulation size is equal to entire model simulation size
 SIMBOX=MODBOX
 !## fill coordinates current model
 CALL MODEL1PUTSIMBOX(SIMBOX(1),SIMBOX(2),SIMBOX(3),SIMBOX(4))
 CALL MODEL1GETSIMBOX()
 !## write save-able topics from runfile
 CALL MODEL1FILLSAVINGS()
 !## update fields
 CALL MODEL1FIELDS()

! MPW%XMIN=SIMBOX(1)-DX; MPW%YMIN=SIMBOX(2)-DY; MPW%XMAX=SIMBOX(3)+DX; MPW%YMAX=SIMBOX(4)+DY
! CALL IDFPLOT(1)

 MODEL1RUNFILE=.TRUE.

 END FUNCTION MODEL1RUNFILE

 !###======================================================================
 LOGICAL FUNCTION MODEL1READRUNFILE(RUNFNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: RUNFNAME
 INTEGER :: IU,IOS,I,J
 CHARACTER(LEN=256) :: FNAME,LINE

 MODEL1READRUNFILE=.FALSE.

 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=RUNFNAME,STATUS='OLD',ACTION='READ,DENYWRITE',IOSTAT=IOS)
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error opening: '//TRIM(RUNFNAME)))RETURN
 READ(IU,*,IOSTAT=IOS)
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: Result directory'))RETURN
 READ(IU,'(A256)',IOSTAT=IOS) LINE
 READ(LINE,*,IOSTAT=IOS) NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL,IARMSWP,IBNDCHK
 IF(IOS.NE.0)THEN
  IBNDCHK=0
  READ(LINE,*,IOSTAT=IOS) NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL,IARMSWP
  IF(IOS.NE.0)THEN
   IARMSWP=0
   READ(LINE,*,IOSTAT=IOS) NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF,IUNCONF,IFVDL
   IF(IOS.NE.0)THEN
    IFVDL=0
    READ(LINE,*,IOSTAT=IOS) NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF,IUNCONF
    IF(IOS.NE.0)THEN
     IUNCONF=0
     READ(LINE,*,IOSTAT=IOS) NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF
    ENDIF
   ENDIF
  ENDIF
 ENDIF 
 
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: NLAY,MXNLAY,NPER,ISS,NSCL,IFTEST,ICONCHK,IIPF'))RETURN

 !## read/skip ipf files
 DO I=1,ABS(IIPF); READ(IU,'(A256)',IOSTAT=IOS) LINE; ENDDO
 
 READ(IU,'(A256)',IOSTAT=IOS) LINE
 READ(LINE,*,IOSTAT=IOS) NMULT,IDBG,IEXPORT,IPOSWEL,I,IBUDGET,MINKD,MINC
 IF(IOS.NE.0)THEN
  MINC=0.001
  READ(LINE,*,IOSTAT=IOS) NMULT,IDBG,IEXPORT,IPOSWEL,I,IBUDGET,MINKD
  IF(IOS.NE.0)THEN
   MINKD=0.0
   READ(LINE,*,IOSTAT=IOS) NMULT,IDBG,IEXPORT,IPOSWEL,I,IBUDGET
   IF(IOS.NE.0)THEN
    IBUDGET=0
    READ(LINE,*,IOSTAT=IOS) NMULT,IDBG,IEXPORT,IPOSWEL,I
    IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: NMULT,IDEBUG,IEXPORT,IPOSWEL,ISCEN'))RETURN
   ENDIF
  ENDIF
 ENDIF
! IF(NMULT.GT.1)THEN
!  IF(.NOT.MODEL1READRUNFILEERROR(1,IU,'You can not use a runfile with more simulation boxes (NMULT='//TRIM(ITOS(NMULT))//')'))RETURN
! ENDIF
 IF(I.NE.0)THEN
  IF(.NOT.MODEL1READRUNFILEERROR(1,IU,'You can not use a runfile that includes a scenario file, ISCEN.EQ.1'))RETURN
 ENDIF

 READ(IU,'(A256)',IOSTAT=IOS) LINE
 READ(LINE,*,IOSTAT=IOS) MXITER,NITER,HCLOSE,RCLOSE,RELAX,NPCOND,MAXWBAL,MAXICVNG,DELTCNVG,IDAMPING
 IF(IOS.NE.0)THEN
  IDAMPING=1
  READ(LINE,*,IOSTAT=IOS) MXITER,NITER,HCLOSE,RCLOSE,RELAX,NPCOND,MAXWBAL,MAXICVNG,DELTCNVG
  IF(IOS.NE.0)THEN
   DELTCNVG=0.0
   READ(LINE,*,IOSTAT=IOS) MXITER,NITER,HCLOSE,RCLOSE,RELAX,NPCOND,MAXWBAL,MAXICVNG
   IF(IOS.NE.0)THEN
    MAXICVNG=100
    READ(LINE,*,IOSTAT=IOS) MXITER,NITER,HCLOSE,RCLOSE,RELAX,MAXWBAL
    IF(IOS.NE.0)THEN
     MAXWBAL=0.01
     READ(LINE,*,IOSTAT=IOS) MXITER,NITER,HCLOSE,RCLOSE,RELAX
    ENDIF
   ENDIF
  ENDIF
 ENDIF
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: MXITER,NITER,HCLOSE,RCLOSE,RELAX'))RETURN

 IF(NSCL.GT.2)THEN
  IF(.NOT.MODEL1READRUNFILEERROR(1,IU,'You can not run an IR computation from iMOD, NSCL.GT.2'))RETURN
 ENDIF

 IF(NMULT.EQ.1)THEN
  IF(NSCL.EQ.1)THEN
   READ(IU,*,IOSTAT=IOS) MODBOX(1:4),SIMCSIZE,MDLBUFFER
   IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: XMIN,YMIN,XMAX,YMAX,CSIZE,LAMBDA'))RETURN
  ENDIF
  IF(NSCL.EQ.2)THEN
   READ(IU,*,IOSTAT=IOS) MODBOX(1:4),SIMCSIZE,MAXSIMCSIZE,MDLBUFFER
   IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: XMIN,YMIN,XMAX,YMAX,CSIZE,MAXSIMCSIZE,LAMBDA'))RETURN
  ENDIF
 ELSE
  DO I=1,NMULT; READ(IU,*,IOSTAT=IOS); ENDDO
  !## default for nscl=0
  SIMCSIZE =100.0
  MDLBUFFER=1500.0
 ENDIF

 READ(IU,*,IOSTAT=IOS)
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: ACTIVE MODULES/PACKAGES'))RETURN

 IF(ALLOCATED(IAMDL))DEALLOCATE(IAMDL)
 IF(ALLOCATED(NLMDL))DEALLOCATE(NLMDL)
 IF(ALLOCATED(ILMDL))DEALLOCATE(ILMDL)
 ALLOCATE(IAMDL(MXMDL))
 ALLOCATE(NLMDL(MXMDL))
 ALLOCATE(ILMDL(MXMDL,MXNLAY))
 NLMDL=0
 ILMDL=0
 IAMDL=0
 MDLALIAS_ACT=''
 MDL_IPOS=0
 NMP_ACT=0
 BNDFNAME=''
 
 !## read/identify modules/packages
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  LINE=UTL_CAP(LINE,'U')
  IF(INDEX(LINE,'(').EQ.0.AND.INDEX(LINE,')').EQ.0)THEN
   IF(TRIM(LINE).EQ.'MODULES FOR EACH LAYER')EXIT
   READ(LINE,*,IOSTAT=IOS) IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX 
   IF(IOS.EQ.0)EXIT
   IF(INDEX(LINE,'.IDF',.TRUE.).GT.0)THEN
    !## read bndfile
    READ(LINE,'(A)',IOSTAT=IOS) FNAME
    READ(FNAME,*) FNAME !## remove quotes (if existing)
    IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading: BNDFILE'))RETURN
    CALL IUPPERCASE(FNAME)
    BNDFNAME=UTL_SUBST(FNAME,TRIM(REPLACESTRING),PREFVAL(5))
    !## read header of bndfile
    IF(.NOT.IDFREAD(IDF,BNDFNAME,0))THEN; CLOSE(IU); BNDFNAME=''; RETURN; ENDIF
    CLOSE(IDF%IU); EXIT
   ENDIF
  ENDIF
  DO I=1,SIZE(MDLKEYWS)
   J=INDEX(LINE,'('//TRIM(MDLKEYWS(I))//')')
   IF(J.NE.0)THEN
    READ(LINE,*,IOSTAT=IOS) IAMDL(I),NLMDL(I),(ILMDL(I,J),J=1,MIN(MXNLAY,NLMDL(I)))
    IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Error reading Module/Package ('//TRIM(MDLKEYWS(I))//')'))RETURN
    IF(IAMDL(I).NE.0)THEN
     NMP_ACT=NMP_ACT+1
     MDL_IPOS(NMP_ACT)=I
     MDLALIAS_ACT(NMP_ACT)=MDLALIAS(I)
    ENDIF
    EXIT
   ENDIF
  END DO
 END DO

 !## take maximum
 MODBOX(1)=IDF%XMIN
 MODBOX(2)=IDF%YMIN
 MODBOX(3)=IDF%XMAX
 MODBOX(4)=IDF%YMAX

 CLOSE(IU)

 MODEL1READRUNFILE=.TRUE.
 IDRAW=1
 
 END FUNCTION MODEL1READRUNFILE

 !###======================================================================
 LOGICAL FUNCTION MODEL1READRUNFILEERROR(IOS,IU,TXT)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: TXT
 INTEGER,INTENT(IN) :: IOS,IU

 MODEL1READRUNFILEERROR=.TRUE.

 IF(IOS.EQ.0)RETURN

 MODEL1READRUNFILEERROR=.FALSE.

 IF(IU.NE.0)CLOSE(IU)
 CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Error occured reading selected run-file'//CHAR(13)// &
      TRIM(TXT)//CHAR(13)//CHAR(13)//'Check/adjust your runfile !','Error')
 IDRAW=0

 END FUNCTION MODEL1READRUNFILEERROR

 !###======================================================================
 SUBROUTINE MODEL1TABSTATES(LSTATE,LCHECK)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LSTATE,LCHECK
 INTEGER :: ISTATE

 ISTATE=0
 IF(LSTATE)ISTATE=1

 CALL WDIALOGSELECT(ID_DMODEL)
 CALL WDIALOGTABSTATE(IDF_TAB,ID_DMDLTAB2,ISTATE)
 CALL WDIALOGTABSTATE(IDF_TAB,ID_DMDLTAB3,ISTATE)
 CALL WDIALOGTABSTATE(IDF_TAB,ID_DMDLTAB4,ISTATE)
 CALL WDIALOGTABSTATE(IDF_TAB,ID_DMDLTAB6,ISTATE)

! IF(ISTATE.EQ.0)THEN
!  CALL WDIALOGFIELDSTATE(IDOK,0)
!  IF(LCHECK)     CALL WDIALOGPUTSTRING(IDOK,'Error in runfile')
!  IF(.NOT.LCHECK)CALL WDIALOGPUTSTRING(IDOK,'Error in scenario file')
! ELSE
!  IF(LSIM)THEN
!   CALL WDIALOGPUTSTRING(IDOK,'Start Model Simulation ...')
!   CALL WDIALOGFIELDSTATE(IDOK,1)
!  ENDIF
! ENDIF
 
 IF(LCHECK)THEN
  CALL WDIALOGSELECT(ID_DMDLTAB1)
  IF(ISTATE.EQ.0)CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,0)
  CALL WDIALOGFIELDSTATE(IDF_CHECK1,ISTATE)
  CALL WDIALOGFIELDSTATE(ID_CHECKRUNFILE,ISTATE)
 ENDIF

 CALL MODEL1FIELD_SCENARIOS()
 
 END SUBROUTINE MODEL1TABSTATES

 !###====================================================================
 SUBROUTINE MODEL1FREEZESCENARIO()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
 IF(I.EQ.0)RETURN

 !## get result-directory
 CALL WDIALOGGETMENU(IDF_MENU2,I)

 CALL WDIALOGSELECT(ID_DMDLTAB4)
 CALL WDIALOGPUTOPTION(IDF_MENU1,I)
 CALL WDIALOGFIELDSTATE(IDF_MENU1,2)

 END SUBROUTINE MODEL1FREEZESCENARIO

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

 CALL WINDOWSELECT(0)
 IF(WMENUGETSTATE(ID_RUNMODEL,2).EQ.1)THEN
  CALL MODEL1CLOSE()
  RETURN
 ENDIF

 CALL MAIN1INACTMODULE(ID_RUNMODEL)

 !## other module no closed, no approvement given
 IF(IDIAGERROR.EQ.1)RETURN

 CALL WDIALOGLOAD(ID_DMODEL,ID_DMODEL)

 IF(TRIM(PREFVAL(8)).EQ.''.AND.TRIM(PREFVAL(9)).EQ.'')THEN
  CALL MODEL1CLOSE()
  CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Give MODFLOW executable in *.prf-file'//CHAR(13)//CHAR(13)// &
     'e.g. MODFLOW c:\modflow\imodflow.exe','Error')
  RETURN
 ENDIF

 CALL WMENUSETSTATE(ID_RUNMODEL,2,1)

 IF(.NOT.IOSDIREXISTS(TRIM(PREFVAL(1))//'\MODELS'))CALL UTL_CREATEDIR(TRIM(PREFVAL(1))//'\MODELS')

 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGPUTIMAGE(ID_CHECKRUNFILE,ID_ICONOKAY)
 CALL WDIALOGPUTIMAGE(ID_INFO1,ID_ICONINFO)
 CALL WDIALOGPUTIMAGE(ID_INFO2,ID_ICONINFO)
 CALL WDIALOGPUTIMAGE(ID_INFO3,ID_ICONINFO)
 CALL WDIALOGPUTIMAGE(ID_COPY,ID_ICONCOPY)
 CALL WDIALOGPUTIMAGE(ID_PRJMANAGER,ID_ICONOPENRUN)
 CALL WDIALOGPUTIMAGE(ID_ZOOMFULL,ID_ICONZOOMFULL)

 CALL WDIALOGSELECT(ID_DMDLTAB2)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL1,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL2,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL4,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL5,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL7,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL8,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDOPTIONS(IDF_REAL9,EDITFIELDCHANGED,ENABLED)
 CALL WDIALOGFIELDSTATE(IDF_REAL3,2)
 CALL WDIALOGFIELDSTATE(IDF_REAL6,2)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPENIDF)

 NRUNFILES =0
 NSCENFILES=0
 NSDFFILES =0
 NRESULTDIR=0
 SCENFNAME =''
 NSCENARIOS=0
 IDRAW     =0
! LSIM      =.FALSE.
 
 IF(.NOT.MODEL1FILL_RUNFILES())RETURN

 !## fill result-folders
 CALL MODEL1FILL_RESULTS()
 !## fill scenarios-folders
 CALL MODEL1FILL_SCENARIOS()
 !## read scenarios
 CALL MODEL1READ_SCENARIOS()

 CALL WDIALOGSELECT(ID_DMODEL)
 CALL WDIALOGSHOW(-1,-1,0,2)

 !## read selected runfile and adjust and fill in tab-fields/settings
 CALL MODEL1TABSTATES(MODEL1RUNFILE(),.TRUE.)
 CALL MODEL1DRAW_SIMBOX(.FALSE.) !## draw new one

 END SUBROUTINE MODEL1INIT

 !###======================================================================
 LOGICAL FUNCTION MODEL1FILL_RUNFILES()
 !###======================================================================
 IMPLICIT NONE

 MODEL1FILL_RUNFILES=.FALSE.

 !## fill runfiles
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL UTL_IMODFILLMENU(IDF_MENU1,TRIM(PREFVAL(1))//'\RUNFILES','*.RUN','F',NRUNFILES,0,0)
 IF(NRUNFILES.LE.0)THEN
  CALL MODEL1CLOSE()
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No runfiles (*.run) found in folder'//CHAR(13)// &
   TRIM(PREFVAL(1))//'\RUNFILES'//CHAR(13)//'Without any runfile(s) it is not possible to use the Model Tool!','Warning')
  RETURN
 ENDIF

 MODEL1FILL_RUNFILES=.TRUE.

 END FUNCTION MODEL1FILL_RUNFILES

 !###======================================================================
 SUBROUTINE MODEL1FILL_RESULTS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 !## scenario added?
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)

 CALL WDIALOGSELECT(ID_DMDLTAB4)
 IF(I.EQ.0)THEN
  CALL UTL_IMODFILLMENU(IDF_MENU1,TRIM(PREFVAL(1))//'\MODELS','*','D',NRESULTDIR,0,0)
  CALL WDIALOGPUTSTRING(IDF_LABEL4,TRIM(PREFVAL(1))//'\MODELS')
  CALL WDIALOGFIELDSTATE(IDF_MENU1,1)
 ELSE
  CALL UTL_IMODFILLMENU(IDF_MENU1,TRIM(PREFVAL(1))//'\SCENARIOS','*','D',NRESULTDIR,0,0)
  CALL WDIALOGPUTSTRING(IDF_LABEL4,TRIM(PREFVAL(1))//'\SCENARIOS')
  !## select proper map:
  CALL WDIALOGFIELDSTATE(IDF_MENU1,2)
 ENDIF

 END SUBROUTINE MODEL1FILL_RESULTS

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

 !## fill existing scenarios
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL UTL_IMODFILLMENU(IDF_MENU2,TRIM(PREFVAL(1))//'\SCENARIOS','*','D',NSCENARIOS,0,0)

 END SUBROUTINE MODEL1FILL_SCENARIOS

 !###======================================================================
 SUBROUTINE MODEL1READ_SCENARIOS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 CHARACTER(LEN=256) :: FNAME
 LOGICAL :: LEX
 
 !## no scenarios found
 IF(NSCENARIOS.EQ.0)RETURN
 !## scenarios activated?
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
 IF(I.EQ.0)THEN
  CALL MODEL1TABSTATES(.TRUE.,.TRUE.)
  SCENFNAME=''
  RETURN
 ENDIF
 
 CALL WDIALOGGETMENU(IDF_MENU2,I,FNAME)
 SCENFNAME=TRIM(PREFVAL(1))//'\SCENARIOS\'//TRIM(FNAME)//'\'//TRIM(FNAME)//'.SCN'
 INQUIRE(FILE=SCENFNAME,EXIST=LEX)
 IF(.NOT.LEX)SCENFNAME=''
 CALL MODEL1TABSTATES(LEX,.FALSE.)

 END SUBROUTINE MODEL1READ_SCENARIOS

 !###======================================================================
 LOGICAL FUNCTION MODEL1PLOTFILE_SCENARIOS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IU,I,J,N,IOS
 REAL,ALLOCATABLE,DIMENSION(:) :: XPOL,YPOL

 MODEL1PLOTFILE_SCENARIOS=.FALSE.
 NSDFFILES=0

 IF(LEN_TRIM(SCENFNAME).EQ.0)THEN
  MODEL1PLOTFILE_SCENARIOS=.TRUE.
  RETURN
 ENDIF

 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=SCENFNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED',IOSTAT=IOS)
 IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Opening '//TRIM(SCENFNAME)))RETURN

 IF(ASSOCIATED(SDFFNAME))DEALLOCATE(SDFFNAME)
 ALLOCATE(SDFFNAME(10))

 J=0
 DO
  READ(IU,*,IOSTAT=IOS)
  IF(IOS.NE.0)EXIT
  READ(IU,*,IOSTAT=IOS)
  IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Reading shape name'))RETURN
  READ(IU,*,IOSTAT=IOS)
  IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'empty line'))RETURN

  READ(IU,*,IOSTAT=IOS) N
  IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Reading number of sdf-files'))RETURN

  DO I=1,N
   NSDFFILES=NSDFFILES+1

   IF(NSDFFILES.GT.SIZE(SDFFNAME))THEN
    ALLOCATE(SDFFNAME_DUMMY(SIZE(SDFFNAME)*2))
    SDFFNAME_DUMMY(1:SIZE(SDFFNAME))=SDFFNAME
    DEALLOCATE(SDFFNAME)
    SDFFNAME=>SDFFNAME_DUMMY
   ENDIF

   READ(IU,*,IOSTAT=IOS) SDFFNAME(NSDFFILES)
   IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Reading sdf-file number '//TRIM(ITOS(NSDFFILES))))RETURN
  END DO

  READ(IU,*,IOSTAT=IOS) N
  IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Reading number of polygons'))RETURN
  N=N+1

  ALLOCATE(XPOL(N),YPOL(N))
  DO I=1,N-1
   READ(IU,*,IOSTAT=IOS) XPOL(I),YPOL(I)
   IF(.NOT.MODEL1READRUNFILEERROR(IOS,IU,'Reading polygon coordinate pair number '//TRIM(ITOS(I))))THEN
    DEALLOCATE(XPOL,YPOL)
    RETURN
   ENDIF
  END DO
  XPOL(N)=XPOL(1)
  YPOL(N)=YPOL(1)

  J=J+1

  !## plot current polygon ...
  CALL IGRLINEWIDTH(2)
  CALL IGRFILLPATTERN(OUTLINE)
  CALL IGRCOLOURN(INVERSECOLOUR(ICOLOR(J)))
  CALL IGRPOLYGONCOMPLEX(XPOL,YPOL,N)
  CALL IGRLINEWIDTH(1)

  DEALLOCATE(XPOL,YPOL)

  READ(IU,*,IOSTAT=IOS)
 ENDDO
 CLOSE(IU)

 !## put (unique) sdf files inside scn-file
 IF(ALLOCATED(SDFFNAME_SHORT))DEALLOCATE(SDFFNAME_SHORT)
 ALLOCATE(SDFFNAME_SHORT(NSDFFILES))
 
 DO I=1,NSDFFILES
  SDFFNAME(I)=ADJUSTL(SDFFNAME(I))
  SDFFNAME_SHORT(I)=SDFFNAME(I)(INDEX(SDFFNAME(I),'\',.TRUE.)+1:)
 END DO
 CALL WDIALOGSELECT(ID_DMDLTAB1)
 CALL WDIALOGPUTMENU(IDF_MENU4,SDFFNAME_SHORT,NSDFFILES,1)
 CALL WDIALOGFIELDSTATE(ID_INFO3,1)
 
 MODEL1PLOTFILE_SCENARIOS=.TRUE.
 
 END FUNCTION MODEL1PLOTFILE_SCENARIOS

 !###======================================================================
 SUBROUTINE MODEL1FIELD_SCENARIOS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: J

 CALL WDIALOGSELECT(ID_DMDLTAB1)

 IF(NSCENARIOS.LE.0)THEN
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,0)
  CALL WDIALOGCLEARFIELD(IDF_MENU2)
  CALL WDIALOGCLEARFIELD(IDF_MENU4)
 ENDIF
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,J)
 
 IF(NSDFFILES.LE.0)THEN
  CALL WDIALOGSELECT(ID_DMDLTAB1)
  CALL WDIALOGCLEARFIELD(IDF_MENU4)
  CALL WDIALOGFIELDSTATE(ID_INFO3,0)
 ELSE
  CALL WDIALOGFIELDSTATE(ID_INFO3,J)
 ENDIF
 
 CALL WDIALOGFIELDSTATE(IDF_LABEL1 ,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2 ,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL3 ,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL4 ,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL5 ,J)
 CALL WDIALOGFIELDSTATE(IDF_MENU2  ,J)
 CALL WDIALOGFIELDSTATE(IDF_MENU3  ,J)
 CALL WDIALOGFIELDSTATE(IDF_MENU4  ,J)
 CALL WDIALOGFIELDSTATE(ID_INFO2   ,J)
 CALL WDIALOGFIELDSTATE(IDF_REAL1  ,J)

 END SUBROUTINE MODEL1FIELD_SCENARIOS

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

 IDIAGERROR=1

 CALL WINDOWSELECT(0)
 CALL WMENUSETSTATE(ID_RUNMODEL,2,0)

 CALL WDIALOGSELECT(ID_DMODEL)
 CALL WDIALOGUNLOAD()

 CALL MODEL1DEALLOCATE()

 !## deallocate x for idf (possible)
 CALL IDFDEALLOCATEX(IDF)
 !## refresh window
 CALL IDFPLOTFAST(1)

 IDIAGERROR=0

 END SUBROUTINE MODEL1CLOSE

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

 IF(ALLOCATED(IAMDL))DEALLOCATE(IAMDL)
 IF(ALLOCATED(NLMDL))DEALLOCATE(NLMDL)
 IF(ALLOCATED(ILMDL))DEALLOCATE(ILMDL)
 IF(ASSOCIATED(SDFFNAME))DEALLOCATE(SDFFNAME)
 IF(ALLOCATED(SDFFNAME_SHORT))DEALLOCATE(SDFFNAME_SHORT)

 END SUBROUTINE MODEL1DEALLOCATE

END MODULE MOD_MODEL