!!  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.
!!
!###======================================================================
SUBROUTINE IMOD1MENU(ITYPE,MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MODPLOT
USE MOD_POLYGON_PAR
USE MOD_ISG_PAR, ONLY : ISELISG
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_OSD, ONLY : OSD_GETENV
USE IMOD
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
INTEGER,INTENT(IN) :: ITYPE

SELECT CASE (ITYPE)

 !## some menu-topic selected
 CASE(MENUSELECT)
  CALL IMOD1MENUSELECT(MESSAGE)
 !## close selected window - if root window terminate iMOD
 CASE(TIMEREXPIRED)
  CALL IMODSAVEIMF(TRIM(PREFVAL(1))//'\IMFILES\AUTOSAVE-IMOD_'//TRIM(OSD_GETENV('USERNAME'))//'.IMF')
 !## close selected window - if root window terminate iMOD
 CASE(CLOSEREQUEST)
  CALL IMODCLOSE(MESSAGE%WIN)
 !## mouse move
 CASE(MOUSEMOVE)
  CALL IMOD1MOUSEMOVE(MESSAGE)
 !## mouse released
 CASE(MOUSEBUTUP)
  CALL IMOD1MOUSEBUTUP(MESSAGE)
 !## mouse pressed
 CASE(MOUSEBUTDOWN)
  CALL IMOD1MOUSEBUTDOWN(MESSAGE)
 !## bitmap scrolled, renew top-left pixel coordinates
 CASE (BITMAPSCROLLED)
  CALL IMOD1BITMAPSCROLLED(MESSAGE)
 !## exposed/resized
 CASE (EXPOSE,RESIZE)
  CALL IMOD1EXPOSERESIZE()

END SELECT

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1MOUSEMOVE(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MOD_POLYGON_PAR
USE IMODVAR
USE MOD_POLYGON, ONLY : POLYGON1ADJUSTSHAPE,POLYGON1MOUSEMOVE
USE IMOD
USE MOD_LEGPLOT, ONLY : LEGADJUSTSHAPE,LEGPLOTMOUSEMOVE
USE MOD_MODEL, ONLY : MODEL1MOUSEMOVE
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
INTEGER :: ITAB

!## model tool
IF(WMENUGETSTATE(ID_RUNMODEL,2).EQ.1)THEN
 CALL MODEL1MOUSEMOVE(MESSAGE,IDOWN,DOWNX,DOWNY)
 RETURN
ELSEIF(WMENUGETSTATE(ID_SOLIDS,2).EQ.1)THEN
 CALL WDIALOGSELECT(ID_DSOLID)
 CALL WDIALOGGETTAB(IDF_TAB1,ITAB)
 IF(ITAB.EQ.ID_DSOLIDTAB1)THEN
  IF(IDOWN.NE.5.AND.IDOWN.NE.8)CALL IMODINFOPLOT(MESSAGE)
  RETURN
 ENDIF
ENDIF

SELECT CASE (IDOWN)
 !## left mouse button pressed
 CASE (4)
  IF(CRDITYPE.GT.0.AND.CRDITYPE.LE.3)THEN
   CALL POLYGON1ADJUSTSHAPE(MESSAGE%GX,MESSAGE%GY,DOWNX,DOWNY)
  ELSEIF(CRDITYPE.LT.0)THEN
   CALL LEGADJUSTSHAPE(CRDITYPE,ICRD,MESSAGE%GX,MESSAGE%GY,DOWNX,DOWNY)
  ENDIF
 !## ctrl+left/middle mouse button
 CASE (5,8)
  CALL IDFMOVEIT(MESSAGE%GX,MESSAGE%GY,0)
 !## no mouse button pressed
 CASE (0)
  ICRD=0
  CRDITYPE=0
  !## get nearby location of shape-definition; in case of IR drawing or scenario drawing!!!
  IF(SHPNO.GT.0)CALL POLYGON1MOUSEMOVE(MESSAGE%GX,MESSAGE%GY,1)
  !## try legend-positioning
  IF(CRDITYPE.EQ.0)CALL LEGPLOTMOUSEMOVE(MESSAGE%GX,MESSAGE%GY,ICRD,CRDITYPE)
END SELECT

!## get name of current visible idf-map - not during map-moving
IF(IDOWN.NE.5.AND.IDOWN.NE.8)CALL IMODINFOPLOT(MESSAGE)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1MOUSEBUTUP(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MOD_POLYGON_PAR, ONLY : CRDITYPE
USE IMOD
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE

!## mouse released
SELECT CASE (MESSAGE%VALUE1)
!## left/middle/right mouse button released
 CASE (1,2,3)
  SELECT CASE (IDOWN)
   CASE (4)
    !## refresh position of legend
    IF(CRDITYPE.LT.0)CALL IDFPLOTFAST(0)
   !## ctrl-left - stop moving
   CASE (5,8)
    CALL IDFMOVEPLOT(0)
    CALL IDFMOVECLOSE(0)
    CALL IDFMENUFIELDS(ID_MOVEMAP,0,1)
   !## shift-left
   CASE (6)
  END SELECT
END SELECT

IDOWN=0

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1MOUSEBUTDOWN(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MOD_POLYGON_PAR
USE IMODVAR
USE MODPLOT
USE MOD_POLYGON, ONLY : POLYGON1FIELDS,POLYGON1SELECT
USE MOD_ISG_PAR, ONLY : ISELISG
USE MOD_ISG, ONLY : ISGCHECKISG
USE IMOD
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
INTEGER :: ITAB

IDOWN=MESSAGE%VALUE2
SELECT CASE (IDOWN)
 !## left
 CASE (4)
  DOWNX=MESSAGE%GX
  DOWNY=MESSAGE%GY
  !## check whether line will be selected in case of isgedit only!
  IF(WMENUGETSTATE(ID_ISGEDIT,2).EQ.1)THEN
   CALL WDIALOGSELECT(ID_DISGEDIT)
   CALL WDIALOGGETTAB(IDF_TAB,ITAB)
   SELECT CASE (ITAB)
    CASE (ID_DISGEDITTAB1)
     CALL ISGCHECKISG(MESSAGE%GX,MESSAGE%GY,0)
    CASE DEFAULT
     !## check polygon
     CALL POLYGON1SELECT()
   END SELECT
  ELSE
   !## check whether polygon tab is active for startpoint
   IF(WMENUGETSTATE(ID_SPOINTS,2).EQ.1)THEN
    CALL WDIALOGSELECT(ID_DSPOINTS)
    CALL WDIALOGGETTAB(ID_DTAB,ITAB)
    IF(ITAB.EQ.ID_DSPTAB1)CALL POLYGON1SELECT()
   !## check whether polygon tab is active for solids
   ELSEIF(WMENUGETSTATE(ID_SOLIDS,2).EQ.1)THEN
    CALL WDIALOGSELECT(ID_DSOLID)
    CALL WDIALOGGETTAB(IDF_TAB1,ITAB)
    IF(ITAB.EQ.ID_DSOLIDTAB2)CALL POLYGON1SELECT()
   ELSE
    !## check polygon
    CALL POLYGON1SELECT()
   ENDIF
  ENDIF
 !## ctrl-left/middle - start moving
 CASE (5,8)
  CALL IDFMENUFIELDS(ID_MOVEMAP,1,0)
  CALL IDFMOVEINIT(1,0)
  CALL WCURSORSHAPE(ID_CURSORHANDGREP)
  PX=INT(MESSAGE%XPIX)
  PY=IH-INT(MESSAGE%YPIX)
 !## shift-left - inzoomen
 CASE (6)
  CALL IDFZOOM(ID_ZOOMINMAP,MESSAGE%GX,MESSAGE%GY,0)
  CALL IDFPLOTFAST(1)
  CALL WGRCURSORPOS(MESSAGE%GX,MESSAGE%GY)

 !## right
 CASE (16)
  !## node on polygon selected
  IF(CRDITYPE.EQ.1)THEN
   IF(SHPI.LE.SIZE(SHPNCRD))THEN
    IF(SHPNCRD(SHPI).GT.2)CALL WMENUFLOATING(ID_MENU3,MESSAGE%X,MESSAGE%Y)
   ENDIF
  !## legend on map selected
  ELSEIF(CRDITYPE.LT.0)THEN
   CALL WMENUFLOATING(ID_MENU8,MESSAGE%X,MESSAGE%Y)
  ELSE
   IF(WMENUGETSTATE(ID_CREATEIPF,2).EQ.1)THEN
    CALL WMENUFLOATING(ID_MENU10,MESSAGE%X,MESSAGE%Y)   
   ELSEIF(WMENUGETSTATE(ID_ISGEDIT,2).EQ.1)THEN
    IF(ISELISG.NE.0)THEN
     CALL WMENUFLOATING(ID_MENU5,MESSAGE%X,MESSAGE%Y)
    ELSE
     CALL WMENUFLOATING(ID_MENU1,MESSAGE%X,MESSAGE%Y)
    ENDIF
   ELSE
    CALL WMENUFLOATING(ID_MENU1,MESSAGE%X,MESSAGE%Y)
   ENDIF
  ENDIF
 !## ctrl right
 CASE (17)
 !## shift right
 CASE (18)
  CALL IDFZOOM(ID_ZOOMOUTMAP,MESSAGE%GX,MESSAGE%GY,0)
  CALL IDFPLOTFAST(1)
  CALL WGRCURSORPOS(MESSAGE%GX,MESSAGE%GY)
END SELECT

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1BITMAPSCROLLED(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE

MPW%IX=MESSAGE%VALUE1
MPW%IY=MESSAGE%VALUE2

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1EXPOSERESIZE()
!###======================================================================
USE WINTERACTER
USE RESOURCE
!USE IMOD
USE MOD_LEGPLOT, ONLY : LEGPLOTUPDATE
IMPLICIT NONE

CALL WINDOWSELECT(0)
IF(WMENUGETSTATE(ID_PLOTLEGEND,2).EQ.1)CALL LEGPLOTUPDATE(.FALSE.)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMOD1MENUSELECT(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MOD_POLYGON_PAR, ONLY : ICRD,CRDITYPE
USE MODPLOT
USE MOD_UTL, ONLY : IMESSAGE,UTL_WSELECTFILE
USE MOD_ISG_PAR, ONLY : ISELISG,NISG,ISG
USE MOD_IR, ONLY : IR1INIT
USE MOD_RO_SCEN, ONLY : ROSCENINIT
USE MOD_MANAGER, ONLY : MANAGERSHOW,MANAGERCLOSE,MANAGERGROUP,MANAGERUNGROUP,MANAGERUPDATE,MANAGERSORT,MANAGERFILL,MANAGERSORT_ALPHA
USE MOD_PMANAGER, ONLY : PMANAGERSHOW
USE MOD_PROFILE, ONLY : PROFILE_INIT
USE MOD_PROF_PAR, ONLY : ISOLID
USE MOD_IPFGETVALUE, ONLY : IPFGETVALUE_MAIN
USE MOD_PREF, ONLY : PREFMAIN
USE MOD_LEGPLOT, ONLY : LEGPLOTINIT,LEGPLOTUPDATE
USE MOD_IDFGETVALUE, ONLY : IDFGETVALUE_MAIN
USE MOD_INFO, ONLY : INFOMAIN
USE MOD_IDFTIMESERIE, ONLY : IDFTIMESERIE_MAIN
USE MOD_SETTINGS, ONLY : SETTINGS_MAIN
USE MOD_ASC2IDF, ONLY : ASC2IDF_EXPORTASC
USE MOD_IDFEDIT, ONLY : IDFEDITINIT
USE MOD_POLYGON, ONLY : POLYGON1DELNODE,POLYGON1LINECOLOR,POLYGON1LINETHICKNESS
USE MOD_EXTRACTIPF, ONLY : EXTRACTIPF1INIT
USE MOD_TOOLS, ONLY : TOOLS1INIT
USE MOD_SCEN, ONLY : SCEN1INIT
USE MOD_CREATEIDF, ONLY : CREATEIDF1INIT
USE MOD_CREATEISG, ONLY : CREATEISG1INIT
USE MOD_PLINES, ONLY : PLINES1INIT
USE MOD_SPOINTS,ONLY : STARTP1INIT
USE MOD_LEGEND, ONLY : LEGMAIN,LEGCREATEINIT
USE MOD_MATH, ONLY : MATH1MAIN
USE MOD_3D, ONLY : IMOD3D_INIT
USE MOD_MODEL, ONLY : MODEL1INIT
USE MOD_IMPORT, ONLY : IMPORT_MAIN
USE MOD_SCENTOOL, ONLY : ST1INIT
USE MOD_PLUGIN, ONLY : PLUGIN_MAIN,PLUGIN_EXE
USE MOD_NC2IDF, ONLY : NC2IDF_EXPORTNC,NC2IDF_EXPORTNC_CLOSE
USE MOD_TOPO, ONLY : TOPO1MAIN,TOPOINIT
USE MOD_SOBEK, ONLY : SOBEK1MAIN
USE MOD_TSTAT, ONLY : TSTAT1INIT
USE MOD_SOLID, ONLY : SOLIDINIT
USE MOD_ABOUT, ONLY : IMOD_AGREEMENT,IMOD_ABOUT
USE MOD_QUICKOPEN, ONLY : IDFQUICKOPEN_INIT
USE MOD_ISG, ONLY : ISGEDITINIT,ISGISPRESET,ISGISPSAVE,ISGISPSTOP,ISGFIELDS,ISGATTRIBUTES,ISGDEL,ISGPOSITIONCRSCLC,ISGDELCLOSE
USE MOD_CREATEGEN, ONLY : CREATEGEN1INIT
USE MOD_CREATEIPF, ONLY : CREATEIPF1INIT,CREATEIPF1MAIN
USE MOD_BATCH, ONLY : CREATEIMODBATCHINIT
USE MOD_SUBSURFEX, ONLY : SUBSURFEXINIT
USE IMOD
IMPLICIT NONE
TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
INTEGER :: I,IP,JP,IB,JB
CHARACTER(LEN=256) :: FNAME
             
SELECT CASE (MESSAGE%VALUE1)
 CASE (ID_QUICKOPEN)
  CALL IDFQUICKOPEN_INIT(2,(/'MODELS   ','SCENARIOS'/))
 !## edit/create solids
 CASE (ID_SOLIDS)
  CALL SOLIDINIT()
 !## 3d
 CASE (ID_3DTOOL)
  CALL IMOD3D_INIT(0)
!## agreement
 CASE(ID_UAGREEMENT)
  I=1; CALL IMOD_AGREEMENT(I)
!## about
 CASE (ID_ABOUT)
  CALL IMOD_ABOUT()
!## display of idf info or ipf info
 CASE (ID_IMODINFO,ID_INFO)
  CALL INFOMAIN()
  CALL MANAGERFILL()
!## start imod batch
 CASE (ID_IMODBATCH)
  CALL CREATEIMODBATCHINIT
 CASE (ID_ANALYSEIPF)
  CALL IPFGETVALUE_MAIN()
 !##  display settings for plotting purposes
 CASE (ID_IPFCONFIGURE,ID_IFFCONFIGURE,ID_GENCONFIGURE,ID_ISGCONFIGURE)
  CALL SETTINGS_MAIN()
  CALL IDFPLOTFAST(0)
  CALL MANAGERUPDATE()
 !## export
 CASE (ID_POSTSCRIPT)
  IF(UTL_WSELECTFILE('Postscript File (*.ps)|*.ps|', &
    SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save current view as BMP,PCX,PNG-file'))THEN

   IP=WINFOGRHARDCOPY(PAPERWIDTH)  !## in points
   JP=WINFOGRHARDCOPY(PAPERHEIGHT) !## in points
   IB=WINFOBITMAP(MPW%IBITMAP,BITMAPWIDTH)
   JB=WINFOBITMAP(MPW%IBITMAP,BITMAPHEIGHT)

   CALL IGRSELECT(2,MPW%IBITMAP)
!, OPTIONAL IDRIVR Image dump driver number : 
!  PostScript (2) PostScript/EPS (X Windows default) 
!  RasterPrinter (4) HP (PCL) or Epson (ESC/P or ESC/P2) printer 
!  WinPrintMgr (10) Windows Print Manager (Windows default) 

   CALL IGRPRINTIMAGESELECT(2)  !EPS

   CALL IGRPRINTIMAGEOPTIONS(1,IP)
   !## adjust image height
   JB=IP*REAL(JB)/REAL(IB); CALL IGRPRINTIMAGEOPTIONS(2,JB) 

   CALL IGRPRINTIMAGEOPTIONS(3,0) !## horizontal adjustment
   CALL IGRPRINTIMAGEOPTIONS(4,0) !## vertical adjustment      

!   CALL WPRINTIMAGEOPTIONS(4,FNAME)
!   IF(WINFODIALOG(4).NE.1)RETURN
   CALL IGRPRINTIMAGE(FNAME)
   CALL IGRSELECT(DRAWWIN)
   CALL WINDOWSELECT(0)
  ENDIF

 !## bmp/pcx/png
 CASE (ID_RASTER)
  IF(.NOT.UTL_WSELECTFILE('All Known Files (*.bmp;*.pcx;*.png;*.jpg)|*.bmp;*.pcx;*.png;*.jpg|BitMap (*.bmp)|*.bmp| &
                           ZSoft PC Paintbrush (*.pcx)|*.pcx|Portable Network Graphic image (*.png)|*.png|JPEG Image (*.jpg)|*.jpg|',&
                   SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,&
                   'Save Current Image to BitMap (*.bmp;*.pcx;*.png;*.jpg)'))RETURN
  CALL WBITMAPSAVE(MPW%IBITMAP,FNAME)
 !## printen
 CASE (ID_PRINT)
  IF(.FALSE.)then
   CALL IGRHARDCOPYSELECT(1,10)
   CALL WHARDCOPYOPTIONS(4)!IUNITS,FILENAME)
!    IWPAPER=InfoGrHardcopy(PaperWidth)
!    IHPAPER=InfoGrHardcopy(PaperHEIGHT)
!###image ratio given by options 1,2
!    RAT=InfoGrHardcopy(AspectRatio)
!## hoeveel inch CQ points is dit
!    IWINCH=IWPAPER*39.37*72.0
!    IHINCH=IHPAPER*39.37*72.0  !1M=39.37INCH*PT
!    CALL IGRHARDCOPYOPTIONS(1,IWPAPER)  !IMAGEWIDTH
!    CALL IGRHARDCOPYOPTIONS(2,IHPAPER)  !IMAGEHEIGHT
!    CALL IGRHARDCOPYOPTIONS(3,IHORADJ)
!    CALL IGRHARDCOPYOPTIONS(4,IVERADJ)
!    WRITE(*,*) IWPAPER,IHPAPER,IWINCH,IHINCH,RAT
   IF(WINFODIALOG(4).NE.1)RETURN
   CALL IGRINIT('H')                     ! HARDCOPY ONLY OUTPUT
   CALL IGRCOLOURMODEL(24)
   CALL IGRHARDCOPY(DOCNAME='IMOD PRINT') ! INITIATE HARDCOPY
   CALL IDFPLOTFAST(0)!(1)
   CALL IGRHARDCOPY('S')                  ! SEND DATA TO PRINTER
   CALL IGRINIT('')                      ! RE-ENABLE GRAPHICS
   CALL IGRCOLOURMODEL(24)
  ELSE
   CALL IGRSELECT(2,MPW%IBITMAP)
   CALL IGRPRINTIMAGESELECT(10)  !PRINT MANAGER
   CALL WPRINTIMAGEOPTIONS(4)
   IF(WINFODIALOG(4).NE.1)RETURN
   CALL IGRPRINTIMAGE()
   CALL IGRSELECT(DRAWWIN)
   CALL WINDOWSELECT(0)
  ENDIF
!## start new plot
 CASE (ID_NEW)
  CALL IMODCLOSE(MPW%IWIN)
!## stop iMOD
 CASE(ID_QUIT)
  CALL IMODCLOSE(0)
!## save drawing
 CASE (ID_SAVE,ID_SAVEAS,ID_OPEN)
  CALL IMODLOADSAVE(MESSAGE%VALUE1,I)
!## view idf-files
 CASE (ID_OPENIDF)
  CALL IDFINIT()
 !## sort selected IDF files
 CASE(ID_SORTTTOB)
  CALL MANAGERSORT()
 CASE(ID_SORTALPHA_AZ,ID_SORTALPHA_ZA)
  CALL MANAGERSORT_ALPHA(MESSAGE%VALUE1)
!## export maps
 CASE (ID_MAPEXPORT1,ID_MAPEXPORT2,ID_MAPEXPORT3)
  CALL ASC2IDF_EXPORTASC(MESSAGE%VALUE1)
 CASE (ID_MAPEXPORTNC1,ID_MAPEXPORTNC2,ID_MAPEXPORTNC3)
  CALL NC2IDF_EXPORTNC(MESSAGE%VALUE1)
  CALL NC2IDF_EXPORTNC_CLOSE()
 !## zooming maps
 CASE(ID_ZOOMINMAP,ID_ZOOMOUTMAP,ID_ZOOMRECTANGLEMAP,ID_ZOOMFULLMAP,ID_ZOOMTAG,ID_ZOOMPREVIOUS,ID_ZOOMNEXT)
  CALL IDFMENUFIELDS(MESSAGE%VALUE1,1,0)
  CALL IDFZOOM(MESSAGE%VALUE1,(MPW%XMAX+MPW%XMIN)/2.0,(MPW%YMAX+MPW%YMIN)/2.0,0)
  CALL IDFPLOTFAST(1)
  CALL IDFMENUFIELDS(MESSAGE%VALUE1,0,1)
 !## idf-values
 CASE(ID_IDFVALUE)
  CALL IDFGETVALUE_MAIN()
  CALL WINDOWSELECT(0)
 !## idf group
 CASE(ID_IDFGROUP)
  IF(.NOT.MANAGERGROUP(LPLOT=.TRUE.))THEN
  ENDIF
 !## idf ungroup
 CASE(ID_IDFUNGROUP)
  CALL MANAGERUNGROUP()
 CASE(ID_IDFSHAPEVALUEPOINTS,ID_IDFSHAPEVALUERECTANGLE,ID_IDFSHAPEVALUEPOLYGON,ID_IDFSHAPEVALUECIRCLE)
  IF(WMENUGETSTATE(ID_IDFSHAPEVALUEPOINTS,2).EQ.1)   CALL WMENUSETSTATE(ID_IDFSHAPEVALUEPOINTS,2,0)
  IF(WMENUGETSTATE(ID_IDFSHAPEVALUERECTANGLE,2).EQ.1)CALL WMENUSETSTATE(ID_IDFSHAPEVALUERECTANGLE,2,0)
  IF(WMENUGETSTATE(ID_IDFSHAPEVALUEPOLYGON,2).EQ.1)  CALL WMENUSETSTATE(ID_IDFSHAPEVALUEPOLYGON,2,0)
  IF(WMENUGETSTATE(ID_IDFSHAPEVALUECIRCLE,2).EQ.1)   CALL WMENUSETSTATE(ID_IDFSHAPEVALUECIRCLE,2,0)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
 !## get how idfgetvalue will be presented
 CASE(ID_IDFGETVALUE_NONE,ID_IDFGETVALUE_ALL,ID_IDFGETVALUE_FIRST)
  IF(WMENUGETSTATE(ID_IDFGETVALUE_NONE,2).EQ.1) CALL WMENUSETSTATE(ID_IDFGETVALUE_NONE,2,0)
  IF(WMENUGETSTATE(ID_IDFGETVALUE_ALL,2).EQ.1)  CALL WMENUSETSTATE(ID_IDFGETVALUE_ALL,2,0)
  IF(WMENUGETSTATE(ID_IDFGETVALUE_FIRST,2).EQ.1)CALL WMENUSETSTATE(ID_IDFGETVALUE_FIRST,2,0)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
!## idf-edit
 CASE(ID_IDFEDIT)
  CALL IDFEDITINIT()
!## ISG-edit
 CASE(ID_ISGEDIT)
  CALL ISGEDITINIT()
!## reset segment-edit
 CASE (ID_ISGISPRESET)
  CALL ISGISPRESET()
!## save segment-edit
 CASE (ID_ISGISPSAVE)
  CALL ISGISPSAVE()
!## stop segment-edit
 CASE(ID_ISGISPSTOP)
  CALL ISGISPSTOP(0)
  ISG%ILIST=0
  CALL WDIALOGSELECT(ID_DISGEDITTAB1)
  CALL WDIALOGPUTOPTION(IDF_MENU1,ISG(1:NISG)%ILIST)
  CALL ISGFIELDS()
!## open attributes
 CASE(ID_ISGATTRIBUTES)
  CALL ISGATTRIBUTES()
!## add cross-section/calculation points to segment
 CASE(ID_ADDCROSSSECTION,ID_DELETECROSSSECTION,ID_MOVECROSSSECTION, &
      ID_ADDCALCPOINT,ID_DELETECALCPOINT,ID_MOVECALCPOINT,          &
      ID_ADDWEIR,ID_DELETEWEIR,ID_MOVEWEIR,                         &
      ID_ADDQH,ID_DELETEQH,ID_MOVEQH)
  CALL ISGPOSITIONCRSCLC(MESSAGE%VALUE1)
!## delete segment
 CASE (ID_ISGDEL)
  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to delete segment ['//TRIM(ISG(ISELISG)%SNAME)//'] ?','Question')
  IF(WINFODIALOG(4).EQ.1)THEN
   CALL WCURSORSHAPE(CURHOURGLASS)
   CALL ISGDEL()
   CALL ISGDELCLOSE()
   CALL WCURSORSHAPE(CURARROW)
  ENDIF
!## adjust show-mode segments
 CASE(ID_ISGNODES,ID_ISGSEGNODES,ID_ISGCRSSCTNS,ID_ISGCLCNODES,ID_ISGSTUWEN,ID_ISGQHR)
  I=WMENUGETSTATE(MESSAGE%VALUE1,2)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,ABS(I-1))
  I=WMENUGETSTATE(ID_ISGEDIT,2)
  IF(I.EQ.1)THEN
   CALL WDIALOGSELECT(ID_DISGEDIT)
   IF(MESSAGE%VALUE1.EQ.ID_ISGNODES)   CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,I)
   IF(MESSAGE%VALUE1.EQ.ID_ISGCLCNODES)CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,I)
   IF(MESSAGE%VALUE1.EQ.ID_ISGCRSSCTNS)CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,I)
   IF(MESSAGE%VALUE1.EQ.ID_ISGSEGNODES)CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,I)
  ENDIF
  CALL IDFPLOTFAST(0)
!## adjust accuracy
 CASE(ID_LOWACCURACY,ID_MEDIUMACCURACY,ID_HIGHACCURACY,ID_EXCELLENTACCURACY)
  IF(WMENUGETSTATE(ID_LOWACCURACY,2).EQ.1)       CALL WMENUSETSTATE(ID_LOWACCURACY,2,0)
  IF(WMENUGETSTATE(ID_MEDIUMACCURACY,2).EQ.1)    CALL WMENUSETSTATE(ID_MEDIUMACCURACY,2,0)
  IF(WMENUGETSTATE(ID_HIGHACCURACY,2).EQ.1)      CALL WMENUSETSTATE(ID_HIGHACCURACY,2,0)
  IF(WMENUGETSTATE(ID_EXCELLENTACCURACY,2).EQ.1) CALL WMENUSETSTATE(ID_EXCELLENTACCURACY,2,0)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
  CALL IDFPLOTFAST(0)
 CASE (ID_IDFRASTERLINES,ID_IDFEXTENT)
  I=WMENUGETSTATE(MESSAGE%VALUE1,2)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,ABS(I-1))
  CALL IDFPLOTFAST(0)
 CASE(ID_MOVEMAP)
  CALL IDFMENUFIELDS(MESSAGE%VALUE1,1,0)
  CALL IDFMOVE(0)
  CALL IDFMENUFIELDS(MESSAGE%VALUE1,0,1)
!## legend adjustments
 CASE (ID_CDLNL,ID_CDLL,ID_TDLNL,ID_TDLL,ID_TDUV,ID_CDUV)
  CALL LEGCREATEINIT(MESSAGE%VALUE1)
  CALL IDFPLOTFAST(1)
!## plot legend on map
 CASE(ID_PLOTLEGEND)
  CALL LEGPLOTINIT()
 CASE(ID_LEGENDCOLUMNS1,ID_LEGENDCOLUMNS2,ID_LEGENDCOLUMNS3,ID_LEGENDCOLUMNS4,ID_LEGENDCOLUMNS5)
  IF(WMENUGETSTATE(ID_LEGENDCOLUMNS1,2).EQ.1)CALL WMENUSETSTATE(ID_LEGENDCOLUMNS1,2,0)
  IF(WMENUGETSTATE(ID_LEGENDCOLUMNS2,2).EQ.1)CALL WMENUSETSTATE(ID_LEGENDCOLUMNS2,2,0)
  IF(WMENUGETSTATE(ID_LEGENDCOLUMNS3,2).EQ.1)CALL WMENUSETSTATE(ID_LEGENDCOLUMNS3,2,0)
  IF(WMENUGETSTATE(ID_LEGENDCOLUMNS4,2).EQ.1)CALL WMENUSETSTATE(ID_LEGENDCOLUMNS4,2,0)
  IF(WMENUGETSTATE(ID_LEGENDCOLUMNS5,2).EQ.1)CALL WMENUSETSTATE(ID_LEGENDCOLUMNS5,2,0)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
  CALL LEGPLOTUPDATE(.FALSE.)
!## adjust legend
 CASE(ID_ADJUSTLEGEND)
  CALL LEGMAIN(0)
  CALL IDFPLOTFAST(1)
!## synchronize legends
 CASE(ID_SYNLEGENDS)
  CALL LEGMAIN(-1)
!## adjust preference dialog
 CASE (ID_PREFERENCES)
  CALL PREFMAIN()
!## math calc idf.
 CASE (ID_IDFCALC)
  CALL MATH1MAIN()
!## view manager
 CASE (ID_MANAGER)
  CALL MANAGERSHOW()
!## view manager
 CASE (ID_PMANAGER)
  CALL PMANAGERSHOW(0)
 !## view subsurface explorer
 CASE (ID_SUBSURFEX)
  CALL SUBSURFEXINIT()
!## profiles
 CASE (ID_PROFILE)
  ISOLID=0  
  CALL PROFILE_INIT()
  CALL IDFPLOT(1)
!## timeseries
 CASE (ID_TIMESERIES)
  CALL IDFTIMESERIE_MAIN()
!## model-manager
 CASE (ID_RUNMODEL)
  CALL MODEL1INIT()
!## import modflow model
 CASE (ID_IMPORTMODFLOW)
  CALL IMPORT_MAIN()
!## import modflow model
 CASE (ID_IMPORTSOBEK)
  CALL SOBEK1MAIN()
!## scenario-manager
 CASE (ID_SCENARIO)
  CALL SCEN1INIT()
!## scenario tool
 CASE (ID_SCENTOOL)
  CALL ST1INIT()
!## Plugin tool manager
 CASE (ID_MANAGE_PLUGIN1,ID_MANAGE_PLUGIN2)
  CALL PLUGIN_MAIN(MESSAGE%VALUE1)
 CASE(ID_PLUGIN1,ID_PLUGIN2,ID_PLUGIN3,ID_PLUGIN4,ID_PLUGIN5, &
        ID_PLUGIN6,ID_PLUGIN7,ID_PLUGIN8,ID_PLUGIN9,ID_PLUGIN10)
  CALL PLUGIN_EXE(MESSAGE%VALUE1)
!## startpoints
 CASE (ID_SPOINTS)
  CALL STARTP1INIT()
!## pathlines
 CASE (ID_PATHLINES)
  CALL PLINES1INIT()
!## (tools) waterbalance; GxG; compute timeseries
 CASE (ID_WBAL,ID_GXG,ID_TS,ID_MEAN)
  CALL TOOLS1INIT(MESSAGE%VALUE1)
!## time-variant statistics
 CASE (ID_TSTAT)
  CALL TSTAT1INIT()
!## ipf extract
 CASE (ID_EXTRACTIPF)
  CALL EXTRACTIPF1INIT()
!## ir-manager
 CASE (ID_IRDATABASE)
  CALL IR1INIT()
!## ro-tool ro (equivalent of waternood)
 CASE (ID_ROTOOL)
  CALL ROSCENINIT()
!## copy to clipboard
 CASE (ID_COPY)
  CALL WCLIPBOARDPUTBITMAP(MPW%IBITMAP)
!## draw topography
 CASE (ID_TOPOGRAPHY)
  CALL TOPOINIT()
!## add topo-information
 CASE (ID_ADDTOPO)
  CALL TOPO1MAIN()
  CALL MANAGERUPDATE()
  CALL IDFPLOTFAST(0)!(1)
!## adjust accuracy/show visible extent
 CASE (ID_TOPTRANSPARACY,ID_TRANSPARANTIDF,ID_TRANSPARANTNODATAIDF,ID_SHOWOPAQUE)
  CALL WINDOWSELECT(0)
  IF(WMENUGETSTATE(MESSAGE%VALUE1,2).EQ.1)THEN
   CALL WMENUSETSTATE(MESSAGE%VALUE1,2,0)
  ELSE
   CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
  ENDIF
  CALL IDFPLOTFAST(1)
!## autosave
 CASE (ID_AUTOSAVE)
  CALL WINDOWSELECT(0)
  IF(WMENUGETSTATE(MESSAGE%VALUE1,2).EQ.1)THEN
   CALL WMENUSETSTATE(MESSAGE%VALUE1,2,0)
   CALL WMENUSETSTRING(MESSAGE%VALUE1,'AutoSave Off')
   CALL WMESSAGETIMER(0)
   IMESSAGE(TIMEREXPIRED)=0
  ELSE
   CALL WMENUSETSTATE(MESSAGE%VALUE1,2,1)
   CALL WMENUSETSTRING(MESSAGE%VALUE1,'AutoSave On (1 minute)')
   CALL WMESSAGETIMER(60*1000,IREPEAT=1)  !minutes
   IMESSAGE(TIMEREXPIRED)=1
  ENDIF
 CASE (ID_HELP)
  CALL IMODGETHELP('','')

 CASE (ID_DELNODE)
  CALL POLYGON1DELNODE()
 CASE (ID_LINECOLOR)
  CALL POLYGON1LINECOLOR()
 CASE (ID_LTHICKNESS1,ID_LTHICKNESS2,ID_LTHICKNESS3)
  CALL POLYGON1LINETHICKNESS(MESSAGE%VALUE1)

 CASE (ID_LOADMASK,ID_SAVEMASK)
  CALL IMODLOADSAVEMASK(MESSAGE%VALUE1)
 CASE (ID_ZOOMMASK)
  CALL IMODZOOMMASK()
 CASE (ID_GOTOXY)
  CALL IMODGOTOXY
 CASE (ID_DISTANCE)
  CALL IMODMEASUREMAIN()
 CASE (ID_CREATEGEN)
  CALL CREATEGEN1INIT()
 CASE (ID_CREATEIPF)
  CALL CREATEIPF1INIT()
 CASE (ID_CREATEISG)
  CALL CREATEISG1INIT()
 CASE (ID_CREATEIDF_IPF,ID_CREATEIDF_GEN,ID_CREATEIDF_IFF,ID_CREATEIDF_SCRATCH)
  CALL CREATEIDF1INIT(MESSAGE%VALUE1)
! CASE (ID_GOOGLEEARTH)
!  CALL GOOGLE_MAIN()
 CASE(ID_SHOWSCALEBAR,ID_SHOWAXES,ID_SHOWNARROW)
  I=WMENUGETSTATE(MESSAGE%VALUE1,2)
  I=ABS(I-1)
  CALL WMENUSETSTATE(MESSAGE%VALUE1,2,I)
  CALL IDFPLOTFAST(1)
 CASE (ID_FCUREXT,ID_FENTDOM,ID_DESELECTALL,ID_FZOOMBOX)
  CALL CREATEIPF1MAIN(MENUSELECT,MESSAGE)
  
END SELECT

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODINFOPLOT(MESSAGE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MODPLOT
USE MOD_UTL, ONLY : ITOS
IMPLICIT NONE
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: IPLOT

IF(MESSAGE%WIN.NE.0.AND.MPW%XMAX-MPW%XMIN.GT.0.0.AND.MPW%YMAX-MPW%YMIN.GT.0.0)THEN
 CALL WINDOWSELECT(MESSAGE%WIN)
 CALL IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)
!## evaluate which idf currently selected
 CALL WINDOWSELECT(0)
 DO IPLOT=1,MXMPLOT
  IF(DRWLIST(IPLOT).EQ.1)THEN
   IF(MP(IPLOT)%IDF%XMIN.LE.MESSAGE%GX.AND.MP(IPLOT)%IDF%XMAX.GE.MESSAGE%GX.AND. &
      MP(IPLOT)%IDF%YMIN.LE.MESSAGE%GY.AND.MP(IPLOT)%IDF%YMAX.GE.MESSAGE%GY)THEN
    CALL WINDOWOUTSTATUSBAR(4,'Visible Map: '//TRIM(MP(IPLOT)%IDFNAME))
    EXIT
   ENDIF
  ENDIF
 END DO
 IF(IPLOT.GT.MXMPLOT)CALL WINDOWOUTSTATUSBAR(4,'')
 CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(ITOS(INT(MESSAGE%GX)))//' m, Y:'//TRIM(ITOS(INT(MESSAGE%GY)))//' m')
ELSE
 CALL WINDOWOUTSTATUSBAR(1,'')
 CALL WINDOWOUTSTATUSBAR(2,'')
 CALL WINDOWOUTSTATUSBAR(4,'')
ENDIF

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODCLOSE(CODE)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR, ONLY : IDIAGERROR,OPENDIR,SAVEDIR
USE MODPLOT
USE MOD_MANAGER, ONLY : MANAGERCLOSE
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_IR, ONLY : IR1CLOSE
USE MOD_START, ONLY : START_MAIN
USE MOD_IDFEDIT, ONLY : IDFEDITCALCCLOSE
USE MOD_TOOLS, ONLY : TOOLS1CLOSE
USE MOD_SCEN, ONLY : SCEN1CLOSE
USE MOD_SPOINTS,ONLY : STARTP1CLOSE
USE MOD_SCENTOOL, ONLY : ST1CLOSE
USE IMOD
IMPLICIT NONE
INTEGER,INTENT(IN) :: CODE
INTEGER :: IPLOT,I
INTEGER,DIMENSION(22) :: ID

IDIAGERROR=0

DATA ID/ID_RUNMODEL,ID_IRDATABASE,ID_IDFEDIT,ID_ISGEDIT,ID_SCENARIO,ID_SPOINTS, &
        ID_WBAL,ID_GXG,ID_MEAN,ID_TS,ID_CREATEGEN,ID_CREATEIDF_IPF,ID_CREATEIDF_GEN, &
        ID_CREATEIDF_IFF,ID_EXTRACTIPF,ID_PROFILE,ID_TIMESERIES,ID_MANAGER,ID_ANALYSEIPF, &
        ID_ANALYSEIPF,ID_SCENTOOL,ID_MOVIE/

DO I=1,SIZE(ID)
 CALL MAIN1INACTMODULE(ID(I)); IF(IDIAGERROR.EQ.1)RETURN
END DO

!## termimate iMOD
IF(CODE.EQ.0)THEN
 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONOK,'Are you sure to terminate iMOD session ?','Question')
 IF(WINFODIALOG(4).NE.1)RETURN
ELSE
 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONOK,'Are you sure to refresh iMOD ?','Question')
 IF(WINFODIALOG(4).NE.1)RETURN
ENDIF

!## termimate iMOD
IF(CODE.EQ.0)THEN
 CALL WINDOWCLOSE()
 STOP
ENDIF

!## close manager if opened!
CALL MANAGERCLOSE()

CALL WINDOWCLOSECHILD(MPW%IWIN)
IF(MPW%IBITMAP.NE.0)CALL WBITMAPDESTROY(MPW%IBITMAP)
MPW%IBITMAP=0  !no bitmap anymore
!## remove/destroy all plot that were placed on current window
DO IPLOT=1,MXMPLOT
 IF(MP(IPLOT)%IACT)THEN
  MP(IPLOT)%IACT=.FALSE.
 ENDIF
END DO

CALL IMODINIT()
CALL START_MAIN('IMF',IPLOT)
IF(IPLOT.EQ.0)THEN
 CALL WINDOWCLOSE()
 STOP
ENDIF

!## reset opendir
OPENDIR=''
SAVEDIR=''

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODLOADSAVE(ID,IOKAY)
!###======================================================================
!## subroutine to load and save imf-files
USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MODPLOT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_UTL, ONLY : UTL_GETUNIT,UTL_WSELECTFILE
IMPLICIT NONE
INTEGER,INTENT(OUT) :: IOKAY
INTEGER,INTENT(IN)         :: ID
INTEGER                    :: IU
CHARACTER(LEN=256)         :: FNAME

IOKAY=0
IU=UTL_GETUNIT()

SELECT CASE (ID)
 CASE (ID_SAVE,ID_SAVEAS)
  IF(IMFFNAME.EQ.''.OR.ID.EQ.ID_SAVEAS)THEN
   FNAME=TRIM(PREFVAL(1))//'\IMFILES\*.imf'
   IF(.NOT.UTL_WSELECTFILE('iMOD Project (*.imf)|*.imf|',SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,&
        FNAME,'Select iMOD Project'))RETURN
   CALL WINDOWSELECT(MPW%IWIN)
   IMFFNAME=FNAME
   CALL WINDOWTITLE('Current iMOD Project: '//TRIM(IMFFNAME))
  ENDIF
  CALL IMODSAVEIMF(IMFFNAME)
  CALL WINDOWSELECT(0)
  CALL WMENUSETSTATE(ID_SAVE,1,1)

 CASE(ID_OPEN)

  FNAME=TRIM(PREFVAL(1))//'\IMFILES\*.imf'
  IF(.NOT.UTL_WSELECTFILE('iMOD Project (*.imf)|*.imf|',LOADDIALOG+PROMPTON+DIRCHANGE+APPENDEXT+MUSTEXIST,&
       FNAME,'Select iMOD Project'))RETURN
  IMFFNAME=FNAME
  CALL IMODLOADIMF()

END SELECT

CLOSE(IU)
IOKAY=1

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODSAVEIMF(FNAME)
!###======================================================================
USE IMODVAR
USE MODPLOT
USE MOD_GENPLOT, ONLY : GEN,MXGEN
USE BMPVAR
USE MOD_UTL, ONLY : UTL_GETUNIT
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_PLUGIN
USE MOD_PREF_PAR, ONLY : PREFVAL
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: FNAME
CHARACTER(LEN=256) :: LINE
INTEGER :: IU,I,J,K,IOS

IU=UTL_GETUNIT()
CALL OSD_OPEN(IU,FILE=FNAME,STATUS='UNKNOWN',FORM='FORMATTED',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
IF(IOS.NE.0)RETURN

WRITE(IU,'(A/)') 'IMOD META-FILE VERSIE '//TRIM(RVERSION)

WRITE(IU,'(A8,I10)')   'NACT=   ',MPW%NACT
WRITE(IU,'(A8,E15.7)') 'XMIN=   ',MPW%XMIN
WRITE(IU,'(A8,E15.7)') 'XMAX=   ',MPW%XMAX
WRITE(IU,'(A8,E15.7)') 'YMIN=   ',MPW%YMIN
WRITE(IU,'(A8,E15.7)') 'YMAX=   ',MPW%YMAX

WRITE(IU,'(50A1)') ('=',I=1,50)

DO I=1,MXMPLOT
 IF(MP(I)%IACT)THEN
  WRITE(IU,'(50A1)') ('+',K=1,50)
  WRITE(IU,'(A8,A)')   'IDFNAME=',TRIM(MP(I)%IDFNAME)
  WRITE(IU,'(A8,A)')   'ALIAS=  ',TRIM(MP(I)%ALIAS)
  WRITE(IU,'(A8,L10)') 'ISEL=   ',MP(I)%ISEL
  WRITE(IU,'(A8,I10)') 'SCOLOR= ',MP(I)%SCOLOR
  WRITE(IU,'(A8,I10)') 'THICKNS=',MP(I)%THICKNESS
  !## ipf/iff-settings
  IF(MP(I)%IPLOT.EQ.2.OR.MP(I)%IPLOT.EQ.3.OR.MP(I)%IPLOT.EQ.6)THEN
   WRITE(IU,'(A8,I10)') 'ILEG=   ',MP(I)%ILEG
  ENDIF
  !## ipf-settings
  IF(MP(I)%IPLOT.EQ.2)THEN
   WRITE(IU,'(A8,I10)')  'XCOL=   ',MP(I)%XCOL
   WRITE(IU,'(A8,I10)')  'YCOL=   ',MP(I)%YCOL
   WRITE(IU,'(A8,I10)')  'ZCOL=   ',MP(I)%ZCOL
   WRITE(IU,'(A8,I10)')  'Z2COL=  ',MP(I)%Z2COL
   WRITE(IU,'(A8,I10)')  'HCOL=   ',MP(I)%HCOL
   WRITE(IU,'(A8,10I1)') 'IAXES=  ',MP(I)%IAXES
   WRITE(IU,'(A8,I10)')  'TSIZE=  ',MP(I)%TSIZE
   WRITE(IU,'(A8,I10)')  'ASSCOL1=',MP(I)%ASSCOL1
   WRITE(IU,'(A8,I10)')  'ASSCOL2=',MP(I)%ASSCOL2
  ENDIF
  !## mdf-settings
  IF(MP(I)%IPLOT.EQ.5)THEN
   WRITE(IU,'(A8,10I1)') 'NLIDF=  ',MP(I)%NLIDF
  ENDIF
  !## gen-settings
!  IF(MP(I)%IPLOT.EQ.6)THEN
!   WRITE(IU,'(A8,I10)') 'GENTYPE=',MP(I)%PRFTYPE  
!   WRITE(IU,'(A8,I10)') 'LTYPE=  ',MP(I)%SYMBOL  
!   WRITE(IU,'(A8,I10)') 'LWIDTH= ',MP(I)%LWIDTH  
!   WRITE(IU,'(A8,I10)') 'LCOLOR= ',MP(I)%SCOLOR  
!   WRITE(IU,'(A8,I10)') 'LATTRIB=',MP(I)%IATTRIB  
!  ENDIF
  IF(MP(I)%IPLOT.NE.4)THEN !## ne isg
   WRITE(IU,'(A8,I10)') 'IATTRIB=',MP(I)%IATTRIB
   WRITE(IU,'(A8,I10)') 'IDFI=   ',MP(I)%IDFI
   WRITE(IU,'(A8,I10)') 'IEQ=    ',MP(I)%IEQ
   WRITE(IU,'(A8,I10)') 'IDFKIND=',MP(I)%IDFKIND
   WRITE(IU,'(A8,I10)') 'SYMBOL= ',MP(I)%SYMBOL
   WRITE(IU,'(A8,I10)') 'FADEOUT=',MP(I)%FADEOUT
   WRITE(IU,'(A8,I10)') 'UNITS=  ',MP(I)%UNITS
   WRITE(IU,'(A8,I10)') 'PRFTYPE=',MP(I)%PRFTYPE
   WRITE(IU,'(A8,I10)') 'ISCREEN=',MP(I)%ISCREEN
   WRITE(IU,'(A8,I10)') 'NCLR=   ',MP(I)%LEG%NCLR
   WRITE(IU,'(50A1)') ('-',K=1,50)
   WRITE(IU,'(A)') 'LEGEND DEFINITION'
   WRITE(IU,'(50A1)') ('-',K=1,50)
   WRITE(IU,'(A8,A)') 'HEDTXT= ',TRIM(MP(I)%LEG%HEDTXT)
   WRITE(IU,'(18X,A8,G15.7)') 'CLASS=  ',MP(I)%LEG%CLASS(0)
   DO J=1,MP(I)%LEG%NCLR
    WRITE(LINE,'(A8,I10,A8,G15.7,A8,A)',IOSTAT=IOS) 'RGB=    ',MP(I)%LEG%RGB(J),'CLASS=  ',MP(I)%LEG%CLASS(J),'LEGTXT= ',TRIM(MP(I)%LEG%LEGTXT(J))
    WRITE(IU,'(A)',IOSTAT=IOS) TRIM(LINE)
   END DO
   DO J=1,MXCGRAD
    WRITE(IU,'(A8,I10)') 'CGRAD=  ',MP(I)%LEG%CGRAD(J)
   END DO
  ENDIF
  WRITE(IU,'(50A1)') ('+',K=1,50)
 ENDIF
END DO

WRITE(IU,'(50A1)') ('/',K=1,50)

DO I=1,MXGEN
 IF(GEN(I)%IACT)THEN
  WRITE(IU,'(50A1)') ('+',K=1,50)
  WRITE(IU,'(A8,A)')   'GENNAME=',TRIM(GEN(I)%GENFNAME)
  WRITE(IU,'(A8,L10)') 'ISEL=   ',GEN(I)%ISEL
  WRITE(IU,'(A8,I10)') 'ITYPE=  ',GEN(I)%ITYPE
  WRITE(IU,'(A8,I10)') 'SYMBOL= ',GEN(I)%SYMBOL
  WRITE(IU,'(A8,I10)') 'THICKNS=',GEN(I)%THICKNESS
  WRITE(IU,'(A8,I10)') 'RGB=    ',GEN(I)%RGB
  WRITE(IU,'(50A1)') ('+',K=1,50)
 ENDIF
ENDDO

WRITE(IU,'(50A1)') ('[',K=1,50)

DO I=1,MXBMP
 IF(BMP(I)%IACT.EQ.1)THEN
  WRITE(IU,'(50A1)') ('+',K=1,50)
  WRITE(IU,'(A8,A)')     'BMPNAME=',TRIM(BMP(I)%BMPFNAME)
  WRITE(IU,'(A8,I10)')   'ITYPE=  ',BMP(I)%ITYPE
  WRITE(IU,'(A8,I10)')   'NCOL=   ',BMP(I)%NCOL
  WRITE(IU,'(A8,I10)')   'NROW=   ',BMP(I)%NROW
  WRITE(IU,'(A8,E15.7)') 'XMIN=   ',BMP(I)%XMIN
  WRITE(IU,'(A8,E15.7)') 'YMIN=   ',BMP(I)%YMIN
  WRITE(IU,'(A8,E15.7)') 'XMAX=   ',BMP(I)%XMAX
  WRITE(IU,'(A8,E15.7)') 'YMAX=   ',BMP(I)%YMAX
  WRITE(IU,'(A8,F10.2)') 'DX=     ',BMP(I)%DX
  WRITE(IU,'(A8,F10.2)') 'DY=     ',BMP(I)%DY
  WRITE(IU,'(50A1)') ('+',K=1,50)
 ENDIF
ENDDO

WRITE(IU,'(50A1)') ('*',K=1,50)

IF(SIZE(PI1).GE.1)THEN !If at least 1 plugin available call to plugin is performed
 WRITE(IU,'(A8,I2)') 'PLUGIN1=',SIZE(PI1)
 WRITE(IU,'(A)') TRIM(PREFVAL(27))
 DO J=1,SIZE(PI1,1)
  WRITE(IU,'(A,I1)') TRIM(PI1(J)%PNAME)//',',PI1(J)%IACT
 ENDDO
 WRITE(IU,'(50A1)') ('*',K=1,50)
ENDIF

WRITE(IU,'(50A1)') ('*',K=1,50)

IF(SIZE(PI2).GE.1)THEN !If at least 1 plugin available call to plugin is performed
 WRITE(IU,'(A8,I2)') 'PLUGIN2=',SIZE(PI2)
 WRITE(IU,'(A)') TRIM(PREFVAL(28))
 DO J=1,SIZE(PI2,1)
  WRITE(IU,'(A,I1)') TRIM(PI2(J)%PNAME)//',',PI2(J)%IACT
 ENDDO
 WRITE(IU,'(50A1)') ('*',K=1,50)
ENDIF

CLOSE(IU)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODLOADIMF()
!###======================================================================
USE WINTERACTER
USE IMODVAR
USE IMOD
USE MODPLOT
USE MOD_GENPLOT, ONLY : GEN,MXGEN
USE BMPVAR
USE MOD_UTL, ONLY : UTL_GETUNIT
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_PLUGIN
IMPLICIT NONE
INTEGER,PARAMETER :: MAXMPWKEYS=5
INTEGER,PARAMETER :: MAXMPKEYS =26
INTEGER,PARAMETER :: MAXGENKEYS=6
INTEGER,PARAMETER :: MAXBMPKEYS=10
INTEGER,PARAMETER :: MAXPLKEYS=2
INTEGER :: IU,I,J,IOS,IVALUE,IPLOT
REAL :: RVALUE
LOGICAL :: LEX,LVALUE
CHARACTER(LEN=10) :: STRING
CHARACTER(LEN=8) :: CKEY
CHARACTER(LEN=300) :: LINE
CHARACTER(LEN=256) :: CVALUE
CHARACTER(LEN=8),DIMENSION(MAXMPWKEYS) :: MPWKEYS
CHARACTER(LEN=8),DIMENSION(MAXMPKEYS)  :: MPKEYS
CHARACTER(LEN=8),DIMENSION(MAXGENKEYS) :: GENKEYS
CHARACTER(LEN=8),DIMENSION(MAXBMPKEYS) :: BMPKEYS
CHARACTER(LEN=8),DIMENSION(MAXPLKEYS) :: PLKEYS
DATA MPWKEYS/'NACT=','XMIN=','XMAX=','YMIN=','YMAX='/
DATA MPKEYS/'IDFNAME=','ALIAS=','ISEL=','IDFI=','IEQ=','IDFKIND=','SYMBOL=',      &
            'FADEOUT=','UNITS=','SCOLOR=','PRFTYPE=','NCLR=','THICKNS=','XCOL=',  &
            'YCOL=','ZCOL=','HCOL=','IAXES=','ILEG=','Z2COL=','IATTRIB=','NLIDF=',&
            'TSIZE=','ISCREEN=','ASSCOL1=','ASSCOL2='/
DATA GENKEYS/'GENNAME=','ISEL=','ITYPE=','SYMBOL=','THICKNS=','RGB='/
DATA BMPKEYS/'BMPNAME=','ITYPE=','NCOL=','NROW=','XMIN=','YMIN=','XMAX=','YMAX=','DX=','DY='/
DATA PLKEYS/'PLUGIN1=','PLUGIN2='/

INQUIRE(FILE=IMFFNAME,EXIST=LEX)
IF(.NOT.LEX)THEN
 CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not find '//TRIM(IMFFNAME),'Error')
 RETURN
ENDIF

MP%IACT =.FALSE.
MP%ISEL =.FALSE.
GEN%IACT=.FALSE.
GEN%ISEL=.FALSE.
BMP%IACT =0

INQUIRE(FILE=IMFFNAME,UNFORMATTED=STRING)
IF(TRIM(STRING).EQ.'YES')THEN
 CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'This version of iMOD can not read old version of IMF files (v1.10) ','Error')
 RETURN
ENDIF

IU=UTL_GETUNIT()
CALL OSD_OPEN(IU,FILE=IMFFNAME,STATUS='OLD',FORM='FORMATTED',ACTION='READ,DENYWRITE')
READ(IU,*) !'IMOD META-FILE VERSIE 1.0, DEFINITION: APRIL 2007'
READ(IU,*)

!## read header
DO
 READ(IU,'(A256)',IOSTAT=IOS) LINE
 IF(IOS.NE.0)EXIT

 !## stop header
 IF(LINE(1:10).EQ.'==========')EXIT
 READ(LINE,'(A8)') CKEY
 CALL IUPPERCASE(CKEY)
 !## find keyword
 DO I=1,MAXMPWKEYS
  IF(TRIM(CKEY).EQ.MPWKEYS(I))EXIT
 END DO
 IF(I.LE.MAXMPWKEYS)THEN
  SELECT CASE (I)
   !## integer
   CASE (1)
    READ(LINE,'(8X,I10)')   IVALUE
   !## real
   CASE (2:5)
    READ(LINE,'(8X,F15.0)') RVALUE
  END SELECT
  SELECT CASE (I)
   CASE (1)
    MPW%NACT=IVALUE
   CASE (2)
    MPW%XMIN=RVALUE
   CASE (3)
    MPW%XMAX=RVALUE
   CASE (4)
    MPW%YMIN=RVALUE
   CASE (5)
    MPW%YMAX=RVALUE
  END SELECT
 ENDIF
END DO

DO IPLOT=1,MXMPLOT

 READ(IU,'(A256)',IOSTAT=IOS) LINE !reading ++++++-en
 IF(IOS.NE.0)EXIT

 IF(LINE(1:10).EQ.'//////////')EXIT

 !## read INFORMATION for each plot
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  !## stop INFORMATION for particular plot
  IF(LINE(1:10).EQ.'++++++++++')EXIT

  !## reading legend
  IF(LINE(1:10).EQ.'----------')THEN
   READ(IU,*)  !## legend
   READ(IU,*)  !## ----------

   !## try to read legend-header-text
   READ(IU,'(A256)') LINE
   READ(LINE,'(A8)') CKEY
   CALL IUPPERCASE(CKEY) 
   IF(TRIM(CKEY).EQ.'HEDTXT=')THEN
    READ(LINE,'(8X,A)') MP(IPLOT)%LEG%HEDTXT
    READ(IU,'(26X,F15.0)') MP(IPLOT)%LEG%CLASS(0)
   ELSE
    READ(LINE,'(26X,F15.0)') MP(IPLOT)%LEG%CLASS(0)
   ENDIF

   DO J=1,MP(IPLOT)%LEG%NCLR
    READ(IU,'(A256)',IOSTAT=IOS) LINE
    READ(LINE,'(8X,I10,8X,F15.0,8X,A32)',IOSTAT=IOS) MP(IPLOT)%LEG%RGB(J),MP(IPLOT)%LEG%CLASS(J),MP(IPLOT)%LEG%LEGTXT(J)
    !## old legend format
    IF(IOS.NE.0)READ(LINE,'(8X,I10,8X,F10.0,8X,A32)',IOSTAT=IOS) MP(IPLOT)%LEG%RGB(J),MP(IPLOT)%LEG%CLASS(J),MP(IPLOT)%LEG%LEGTXT(J)
   END DO
   DO J=1,MXCGRAD
    READ(IU,'(8X,I10)',IOSTAT=IOS) MP(IPLOT)%LEG%CGRAD(J)
   END DO
   
  ENDIF

  MP(IPLOT)%IACT=.TRUE.

  READ(LINE,'(A8)') CKEY
  CALL IUPPERCASE(CKEY)

  !## find keyword
  DO I=1,MAXMPKEYS
   IF(TRIM(CKEY).EQ.MPKEYS(I))EXIT
  END DO
  IF(I.LE.MAXMPKEYS)THEN
   SELECT CASE (I)
    !## character
    CASE (1:2,18)
     READ(LINE,'(8X,A256)')  CVALUE
    !## integer
    CASE (4:17,19:26)
     READ(LINE,'(8X,I10)')   IVALUE
    !## real
    CASE (0)
     READ(LINE,'(8X,F10.2)') RVALUE
    !## logical
    CASE (3)
     READ(LINE,'(8X,L10)')   LVALUE
   END SELECT
   SELECT CASE (I)
    CASE (1)
     MP(IPLOT)%IDFNAME=CVALUE
    CASE (2)
     MP(IPLOT)%ALIAS=CVALUE
    CASE (3)
     MP(IPLOT)%ISEL=LVALUE
    CASE (4)
     MP(IPLOT)%IDFI=IVALUE
    CASE (5)
     MP(IPLOT)%IEQ=IVALUE
    CASE (6)
     MP(IPLOT)%IDFKIND=IVALUE
    CASE (7)
     MP(IPLOT)%SYMBOL=IVALUE
    CASE (8)
     MP(IPLOT)%FADEOUT=IVALUE
    CASE (9)
     MP(IPLOT)%UNITS=IVALUE
    CASE (10)
     MP(IPLOT)%SCOLOR=IVALUE
    CASE (11)
     MP(IPLOT)%PRFTYPE=IVALUE
    CASE (12)
     MP(IPLOT)%LEG%NCLR=IVALUE
    CASE (13)
     MP(IPLOT)%THICKNESS=IVALUE
    CASE (14)
     MP(IPLOT)%XCOL=IVALUE
    CASE (15)
     MP(IPLOT)%YCOL=IVALUE
    CASE (16)
     MP(IPLOT)%ZCOL=IVALUE
    CASE (17)
     MP(IPLOT)%HCOL=IVALUE
    CASE (18)
     READ(CVALUE,'(10I1)') MP(IPLOT)%IAXES!=CVALUE
     !## first two are always plotted on first y-axes
     MP(IPLOT)%IAXES(1:2)=1
     DO J=3,SIZE(MP(IPLOT)%IAXES)
      MP(IPLOT)%IAXES(J)=MAX(1,MP(IPLOT)%IAXES(J))
     END DO
    CASE (19)
     MP(IPLOT)%ILEG=IVALUE
    CASE (20)
     MP(IPLOT)%Z2COL=IVALUE
    CASE (21)
     MP(IPLOT)%IATTRIB=IVALUE
    CASE (22)
     MP(IPLOT)%NLIDF=IVALUE
    CASE (23)
     MP(IPLOT)%TSIZE=IVALUE
    CASE (24)
     MP(IPLOT)%ISCREEN=IVALUE     
    CASE (25)
     MP(IPLOT)%ASSCOL1=IVALUE     
    CASE (26)
     MP(IPLOT)%ASSCOL2=IVALUE     
   END SELECT
  ENDIF
 ENDDO
END DO

DO IPLOT=1,MXGEN

 READ(IU,*,IOSTAT=IOS) LINE !reading ++++++-en
 IF(IOS.NE.0)EXIT

 IF(LINE(1:10).EQ.'[[[[[[[[[[')EXIT

!#read INFORMATION for each plot
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
!#stop INFORMATION for particular plot
  IF(LINE(1:10).EQ.'++++++++++')EXIT

  GEN(IPLOT)%IACT=.TRUE.

  READ(LINE,'(A8)') CKEY
  CALL IUPPERCASE(CKEY)

  !## find keyword
  DO I=1,MAXGENKEYS
   IF(TRIM(CKEY).EQ.GENKEYS(I))EXIT
  END DO
  IF(I.LE.MAXGENKEYS)THEN
   SELECT CASE (I)
    !## character
    CASE (1)
     READ(LINE,'(8X,A256)')  CVALUE
    !## integer
    CASE (3:7)
     READ(LINE,'(8X,I10)')   IVALUE
    !## real
    CASE (0)
     READ(LINE,'(8X,F10.2)') RVALUE
    !## logical
    CASE (2)
     READ(LINE,'(8X,L10)')   LVALUE
   END SELECT
   SELECT CASE (I)
    CASE (1)
     GEN(IPLOT)%GENFNAME=CVALUE
    CASE (2)
     GEN(IPLOT)%ISEL=LVALUE
    CASE (3)
     GEN(IPLOT)%ITYPE=IVALUE
    CASE (4)
     GEN(IPLOT)%SYMBOL=IVALUE
    CASE (5)
     GEN(IPLOT)%THICKNESS=IVALUE
    CASE (6)
     GEN(IPLOT)%RGB=IVALUE
   END SELECT
  ENDIF
 ENDDO
END DO

NBMP=0
DO IPLOT=1,MXBMP

 READ(IU,*,IOSTAT=IOS) LINE !reading ++++++-en
 IF(IOS.NE.0)EXIT
 
 IF(LINE(1:10).EQ.'**********')EXIT
 
!#read INFORMATION for each plot
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
!#stop INFORMATION for particular plot
  IF(LINE(1:10).EQ.'++++++++++')EXIT

  BMP(IPLOT)%IACT=1

  READ(LINE,'(A8)') CKEY
  CALL IUPPERCASE(CKEY)

!#find keyword
  DO I=1,MAXBMPKEYS
   IF(TRIM(CKEY).EQ.BMPKEYS(I))EXIT
  END DO
  IF(I.LE.MAXBMPKEYS)THEN
   SELECT CASE (I)
    !## character
    CASE (1)
     READ(LINE,'(8X,A256)')  CVALUE
    !## integer
    CASE (2:4)
     READ(LINE,'(8X,I10)')   IVALUE
    !## real
    CASE (5:9)
     READ(LINE,'(8X,F15.0)') RVALUE
    !## logical
    CASE (0)
     READ(LINE,'(8X,L10)')   LVALUE
   END SELECT
   SELECT CASE (I)
    CASE (1)
     BMP(IPLOT)%BMPFNAME=CVALUE
    CASE (2)
     BMP(IPLOT)%ITYPE=IVALUE
    CASE (3)
     BMP(IPLOT)%NCOL=IVALUE
    CASE (4)
     BMP(IPLOT)%NROW=IVALUE
    CASE (5)
     BMP(IPLOT)%XMIN=RVALUE
    CASE (6)
     BMP(IPLOT)%YMIN=RVALUE
    CASE (7)
     BMP(IPLOT)%XMAX=RVALUE
    CASE (8)
     BMP(IPLOT)%YMAX=RVALUE
    CASE (9)
     BMP(IPLOT)%DX=RVALUE
    CASE (10)
     BMP(IPLOT)%DY=RVALUE
   END SELECT
  ENDIF
 ENDDO
 NBMP=NBMP+1
END DO

!## Read in plug-ins from .imf file into Plugin-manager en Plugin-menu
DO
 READ(IU,'(A256)',IOSTAT=IOS) LINE !reading ******-en
 IF(IOS.NE.0)EXIT
 
 IF(LINE(1:10).EQ.'**********')CYCLE

 DO 
   READ(LINE,'(A)') CKEY
   CALL IUPPERCASE(CKEY)

   DO I=1,MAXPLKEYS
    IF(TRIM(CKEY).EQ.PLKEYS(I))EXIT
   END DO

   IF(I.LE.MAXPLKEYS)THEN
    
    IF(I.EQ.1)THEN
     CALL IMODSAVEPLUGIN(PI1,27,LINE,IU)
    ELSE
     CALL IMODSAVEPLUGIN(PI2,28,LINE,IU)
    ENDIF
    READ(IU,'(A256)',IOSTAT=IOS) LINE !reading ******-en
    IF(IOS.NE.0)EXIT
    IF(LINE(1:10).EQ.'**********')EXIT
   
   ENDIF 

  ENDDO
 
ENDDO

CLOSE(IU)

CALL IMODLOAD()

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODSAVEPLUGIN(PI,IPI,LINE,IU)
!###======================================================================
USE MOD_PLUGIN
IMPLICIT NONE
TYPE(PIOBJ),POINTER,DIMENSION(:),INTENT(INOUT) :: PI
CHARACTER(LEN=300),INTENT(IN) :: LINE
INTEGER, INTENT(IN) :: IPI,IU
INTEGER :: I,IVALUE,IOS
CHARACTER(LEN=256) :: PLUGDIR

IF(.NOT.ASSOCIATED(PI))THEN
 READ(LINE,'(8X,I2)') IVALUE
 ALLOCATE(PI(IVALUE))
ELSE
 READ(LINE,'(8X,I2)') IVALUE
 DEALLOCATE(PI); ALLOCATE(PI(IVALUE))
ENDIF

READ(IU,*,IOSTAT=IOS) PLUGDIR !# plugin-directory (not) equal to prefval test
IF(TRIM(PLUGDIR).NE.TRIM(PREFVAL(IPI)))THEN
 CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Given plugin-directory ('//TRIM(PLUGDIR)//') in .imf file is not similar to given directory in preference file ('//TRIM(PREFVAL(IPI))//')','Error')     
ENDIF    
DO I=1,IVALUE
 READ(IU,*,IOSTAT=IOS) PI(I)%PNAME,PI(I)%IACT
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot found plugin: '//TRIM(PI(I)%PNAME)//'in plugin folder.','Error')
  DEALLOCATE(PI); EXIT
 ENDIF
ENDDO 

IF(PLUGIN_UPDATEMENU_FILL())THEN;ENDIF

END SUBROUTINE IMODSAVEPLUGIN

!###======================================================================
SUBROUTINE IMODLOADSAVEMASK(ID)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE IMODVAR
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_UTL, ONLY : UTL_GETUNIT,UTL_WSELECTFILE
USE MOD_OSD, ONLY : OSD_OPEN
IMPLICIT NONE
INTEGER,INTENT(IN) :: ID
INTEGER            :: IU,I
CHARACTER(LEN=256) :: FNAME

SELECT CASE (ID)
 CASE (ID_SAVEMASK)
  FNAME=TRIM(PREFVAL(1))//'\MASKS\*.msk'
  IF(.NOT.UTL_WSELECTFILE('iMOD Mask File (*.msk)|*.msk|',SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,&
       FNAME,'Select iMOD Mask File (*.msk)'))RETURN
  IU=UTL_GETUNIT()
  CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',FORM='UNFORMATTED',ACTION='WRITE,DENYREAD')
  MASKXMIN=MPW%XMIN
  MASKXMAX=MPW%XMAX
  MASKYMIN=MPW%YMIN
  MASKYMAX=MPW%YMAX
  WRITE(IU) MASKXMIN,MASKXMAX,MASKYMIN,MASKYMAX       !coordinates current bitmap (m)
  CLOSE(IU)
 CASE(ID_LOADMASK)
  FNAME=TRIM(PREFVAL(1))//'\MASKS\*.msk'
  IF(.NOT.UTL_WSELECTFILE('iMOD Mask File (*.msk)|*.msk|',LOADDIALOG+PROMPTON+DIRCHANGE+APPENDEXT+MUSTEXIST,&
       FNAME,'Select iMOD Mask File (*.msk)'))RETURN
  IU=UTL_GETUNIT()
  CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED',ACTION='READ,DENYWRITE')
  READ(IU) MASKXMIN,MASKXMAX,MASKYMIN,MASKYMAX       !coordinates current bitmap (m)
  CLOSE(IU)
  CALL IMODZOOMMASK()
END SELECT

CALL WINDOWSELECT(0)
IF(WMENUGETSTATE(ID_ZOOMMASK,ITEMENABLED).NE.1)CALL WMENUSETSTATE(ID_ZOOMMASK,ITEMENABLED,1)
I=INDEX(FNAME,'\',.TRUE.)+1
CALL WMENUSETSTRING(ID_ZOOMMASK,'Mask Zoom: '//TRIM(FNAME(I:)))

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODZOOMMASK()
!###======================================================================
USE MODPLOT
USE IMODVAR
IMPLICIT NONE

MPW%XMIN=MASKXMIN
MPW%XMAX=MASKXMAX
MPW%YMIN=MASKYMIN
MPW%YMAX=MASKYMAX
CALL IDFPLOTFAST(1)

END SUBROUTINE IMODZOOMMASK

!###======================================================================
SUBROUTINE IMODGOTOXY()
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE MOD_IDF, ONLY : IDFREAD
USE IMOD
IMPLICIT NONE
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: ITYPE,IX,IY,IDX,I,K,IOS,IPLOT
CHARACTER(LEN=10) :: CVALUE

CALL WDIALOGLOAD(ID_DGOTOXY,ID_DGOTOXY)
IX=INT((MPW%XMIN+MPW%XMAX)/2.0)
IY=INT((MPW%YMIN+MPW%YMAX)/2.0)
CALL WDIALOGPUTINTEGER(IDF_INTEGER1,IX)
CALL WDIALOGPUTINTEGER(IDF_INTEGER2,IY)

DO IPLOT=1,MXMPLOT
 IF(MP(IPLOT)%ISEL)EXIT
END DO
IF(IPLOT.GT.MXMPLOT)IPLOT=1
IF(MPW%NACT.GT.0)CALL WDIALOGPUTMENU(IDF_MENU2,MP%ALIAS,MPW%NACT,IPLOT)

CALL IMODGOTOFIELDS()
CALL WDIALOGSHOW(0,0,0,3)

DO
 CALL WMESSAGE(ITYPE,MESSAGE)
 SELECT CASE (ITYPE)
  CASE (FIELDCHANGED)
   SELECT CASE (MESSAGE%VALUE2)
    CASE (IDF_RADIO1,IDF_RADIO2,IDF_MENU2)
     CALL IMODGOTOFIELDS()
   END SELECT

  CASE (PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (IDOK)
     CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,K)
     I=INFOERROR(1)
     I=0
     CALL WDIALOGGETMENU(IDF_MENU1,IDX,CVALUE)
     IF(INFOERROR(1).NE.0)I=I+1
     READ(CVALUE,*,IOSTAT=IOS) IDX
     IF(IOS.NE.0)I=I+1
     IF(IDX.LE.0)I=I+1
     IF(K.EQ.1)THEN
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,IX)
      IF(INFOERROR(1).NE.0)I=I+1
      CALL WDIALOGGETINTEGER(IDF_INTEGER2,IY)
      IF(INFOERROR(1).NE.0)I=I+1
     ELSEIF(K.EQ.2)THEN
      CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)
      CALL WDIALOGGETINTEGER(IDF_INTEGER3,IX)
      CALL WDIALOGGETINTEGER(IDF_INTEGER4,IY)
      !## check whether xmax=xmin+ncol*cs = only for constant dx/dy
      IF(IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))THEN
       IF(MP(IPLOT)%IDF%IEQ.EQ.0)THEN
        IX=INT(MP(IPLOT)%IDF%XMIN+REAL(IX)*MP(IPLOT)%IDF%DX)
        IY=INT(MP(IPLOT)%IDF%YMAX-REAL(IY)*MP(IPLOT)%IDF%DY)
       ELSE
        IX=INT(MP(IPLOT)%IDF%SX(IX))
        IY=INT(MP(IPLOT)%IDF%SY(IY))
       ENDIF
       CLOSE(MP(IPLOT)%IDF%IU)
      ELSE
       I=1
      ENDIF
     ENDIF
     IF(I.EQ.0)THEN
      MPW%XMIN=REAL(IX-IDX)
      MPW%XMAX=REAL(IX+IDX)
      MPW%YMIN=REAL(IY-IDX)
      MPW%YMAX=REAL(IY+IDX)
      CALL IDFPLOTFAST(1)
      EXIT
     ELSE
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Errors found in input fields!','Error')
     ENDIF

    CASE (IDHELP)
     CALL IMODGETHELP('3.3.2','VMO.GotoXY')
    CASE (IDCANCEL)
     EXIT
   END SELECT

  !## bitmap scrolled, renew top-left pixel coordinates
  CASE (BITMAPSCROLLED)
   MPW%IX=MESSAGE%VALUE1
   MPW%IY=MESSAGE%VALUE2

 END SELECT
END DO

CALL WDIALOGSELECT(ID_DGOTOXY)
CALL WDIALOGUNLOAD()

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODGOTOFIELDS()
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE MOD_UTL, ONLY : ITOS
IMPLICIT NONE
INTEGER :: I,J,K,IPLOT,IRADIO

CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IRADIO)

IF(MPW%NACT.GT.0)THEN
 CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)
 IF(MP(IPLOT)%IPLOT.EQ.1)THEN
  CALL WDIALOGFIELDSTATE(IDOK,1)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,1)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,1)
  CALL WDIALOGRANGEINTEGER(IDF_INTEGER3,1,MP(IPLOT)%IDF%NCOL)
  CALL WDIALOGRANGEINTEGER(IDF_INTEGER4,1,MP(IPLOT)%IDF%NROW)
  CALL WDIALOGPUTSTRING(IDF_RADIO2,'iCOL (max. '//TRIM(ITOS(MP(IPLOT)%IDF%NCOL))//')'//CHAR(13)// &
                                   'iROW (max. '//TRIM(ITOS(MP(IPLOT)%IDF%NROW))//')')
 ELSEIF(MP(IPLOT)%IPLOT.EQ.2)THEN
  CALL WDIALOGPUTSTRING(IDF_RADIO2,'IPF selected !')
  CALL WDIALOGFIELDSTATE(IDOK,IRADIO)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,0)
 ELSEIF(MP(IPLOT)%IPLOT.EQ.3)THEN
  CALL WDIALOGPUTSTRING(IDF_RADIO2,'IFF selected !')
  CALL WDIALOGFIELDSTATE(IDOK,IRADIO)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,0)
 ELSEIF(MP(IPLOT)%IPLOT.EQ.4)THEN
  CALL WDIALOGPUTSTRING(IDF_RADIO2,'ISG selected !')
  CALL WDIALOGFIELDSTATE(IDOK,IRADIO)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER3,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER4,0)
 ENDIF
ELSE
 CALL WDIALOGPUTSTRING(IDF_RADIO2,'No Files active')
 CALL WDIALOGFIELDSTATE(IDF_RADIO2,0)
 CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
ENDIF

CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
IF(I.EQ.1)THEN
 J=1
 K=2
ELSE
 J=2
 K=1
ENDIF
CALL WDIALOGFIELDSTATE(IDF_INTEGER1,J)
CALL WDIALOGFIELDSTATE(IDF_INTEGER2,J)
CALL WDIALOGFIELDSTATE(IDF_MENU2,K)
CALL WDIALOGFIELDSTATE(IDF_LABEL5,K)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODLOAD()
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MODPLOT
USE MOD_IDF, ONLY : IDFREAD
USE MOD_GENPLOT, ONLY : TOPOGENUPDATE,TOPOGENFILL
USE MOD_MANAGER, ONLY : MANAGERFILL,MANAGERUPDATE,MANAGERSHOW
USE MOD_UTL, ONLY : ITOS,UTL_READARRAY
IMPLICIT NONE
INTEGER :: I,J,IPLOT,JPLOT
LOGICAL :: LEX

CALL WINDOWSELECT(MPW%IWIN)
PLOTNAME='iMOD-Map Configuration : '//TRIM(IMFFNAME)
CALL WINDOWTITLE(PLOTNAME)

!## OVERRULE SCHERMS SETTINGS
!## root window - size for the bitmap
!MPW%DIX    =WINFOSCREEN(SCREENWIDTH) *MPW%DIX_BAR
!MPW%DIY    =WINFOSCREEN(SCREENHEIGHT)*MPW%DIY_BAR
MPW%DIX    =WINFOWINDOW(WINDOWWIDTH) 
MPW%DIY    =WINFOWINDOW(WINDOWHEIGHT)

!## compute start pixels such that mid of plot is in screen centre
MPW%IX=(MPW%DIX/2)-(WINFOWINDOW(WINDOWWIDTH)/2)
MPW%IY=(MPW%DIY/2)-(WINFOWINDOW(WINDOWHEIGHT)/2)

MPW%IBITMAP=0

!## update statistics
IPLOT=0
J    =0
DO JPLOT=1,MXMPLOT
 IF(MP(JPLOT)%IACT)THEN
  INQUIRE(FILE=MP(JPLOT)%IDFNAME,EXIST=LEX)
  IF(LEX)THEN

   IPLOT=IPLOT+1
   IF(IPLOT.NE.JPLOT)THEN
    MP(IPLOT)=MP(JPLOT)
    MP(JPLOT)%IACT=.FALSE.
    MP(JPLOT)%ISEL=.FALSE.
   ENDIF

   I=INDEXNOCASE(MP(IPLOT)%IDFNAME,'.',.TRUE.)+1
   CALL IUPPERCASE(MP(IPLOT)%IDFNAME)
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'IDF')MP(IPLOT)%IPLOT=1 !## IDF
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'IPF')MP(IPLOT)%IPLOT=2 !## IPF
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'IFF')MP(IPLOT)%IPLOT=3 !## IFF
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'ISG')MP(IPLOT)%IPLOT=4 !## ISG
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'MDF')MP(IPLOT)%IPLOT=5 !## MDF
   IF(MP(IPLOT)%IDFNAME(I:I+2).EQ.'GEN')MP(IPLOT)%IPLOT=6 !## GEN
   MP(IPLOT)%ISCREEN=MAX(MP(IPLOT)%ISCREEN,1)
   SELECT CASE (MP(IPLOT)%IPLOT)
    CASE (1)
     IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))MP(IPLOT)%IPLOT=0
     IF(MP(IPLOT)%IDF%IU.GT.0)CLOSE(MP(IPLOT)%IDF%IU)
     IF(MP(IPLOT)%IDFKIND.EQ.0)CALL UTL_READARRAY((/1,0,0/),3,MP(IPLOT)%IDFKIND)
    !## ipf
    CASE (2)
     IF(MP(IPLOT)%PRFTYPE.LT.0)MP(IPLOT)%PRFTYPE=0  !non-active
     IF(MP(IPLOT)%PRFTYPE.GT.0)MP(IPLOT)%PRFTYPE=1  !active
     MP(IPLOT)%IDFKIND=0                       !type of plotting for associate file
     MP(IPLOT)%IDFI=MAX(0,MP(IPLOT)%IDFI)      !sight (m)
     MP(IPLOT)%SCOLOR=MAX(0,MP(IPLOT)%SCOLOR)  !no colouring, attribute colouring
     MP(IPLOT)%TSIZE =MAX(1,MIN(10,MP(IPLOT)%TSIZE))
     IF(MP(IPLOT)%ASSCOL1.LE.0)MP(IPLOT)%ASSCOL1=2 !## borehole plotting
     MP(IPLOT)%ASSCOL2=0 !## borehole plotting
    !## iff
    CASE (3)
     IF(MP(IPLOT)%PRFTYPE.LT.0)MP(IPLOT)%PRFTYPE=0
     IF(MP(IPLOT)%PRFTYPE.GT.0)MP(IPLOT)%PRFTYPE=1
     MP(IPLOT)%IDFI=MAX(0,MP(IPLOT)%IDFI)      !sight (m)
     MP(IPLOT)%SCOLOR=MAX(0,MP(IPLOT)%SCOLOR)  !no colouring, attribute colouring
     MP(IPLOT)%IDFKIND=0    !nog vrij te gebruiken
     IF(MP(IPLOT)%IEQ.LT.0)MP(IPLOT)%IEQ=0     !no value plotted
     MP(IPLOT)%UNITS  =0    !nog vrij te gebruiken
    !## isg
    CASE (4)
    !## mdf
    CASE (5)
     MP(IPLOT)%NLIDF=MAX(1,MP(IPLOT)%NLIDF) !## default take the first to be plotted
    !## gen
    CASE (6)
   END SELECT
  ELSE
   J=J+1
   MP(JPLOT)%IACT=.FALSE.
   MP(JPLOT)%ISEL=.FALSE.
  ENDIF
 ENDIF
ENDDO

IF(J.GT.0)CALL WMESSAGEBOX(OKONLY,COMMONOK,INFORMATIONICON,'iMOD removed '//TRIM(ITOS(J))// &
          ' files from the iMOD-manager that did not exist anymore','Info')

CALL MANAGERFILL()
CALL MANAGERUPDATE()
CALL TOPOGENFILL()
CALL TOPOGENUPDATE()

CALL IDFPLOTFAST(1)

CALL MANAGERSHOW()

CALL WINDOWSELECT(0)
CALL WMENUSETSTATE(ID_SAVE,1,1)

!## reset opendir
OPENDIR=''
SAVEDIR=''

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODMEASUREMAIN()
!###======================================================================
USE IMOD
IMPLICIT NONE
INTEGER,PARAMETER :: MAXCRD=50
REAL,DIMENSION(:),ALLOCATABLE :: XCRD,YCRD
INTEGER :: NCRD

ALLOCATE(XCRD(MAXCRD),YCRD(MAXCRD))

CALL IMODMEASURE(XCRD,YCRD,MAXCRD,NCRD)

DEALLOCATE(XCRD,YCRD)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODMEASURE(XCRD,YCRD,MAXCRD,NCRD)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE MOD_UTL, ONLY : RTOS,ITOS,IDFPLOT1BITMAP,IDFPLOT2BITMAP
USE MOD_LEGPLOT, ONLY : LEGPLOTUPDATE
IMPLICIT NONE
INTEGER,INTENT(IN) :: MAXCRD
REAL,DIMENSION(MAXCRD),INTENT(INOUT) :: XCRD,YCRD
INTEGER,INTENT(OUT) :: NCRD
TYPE(WIN_MESSAGE)             :: MESSAGE
INTEGER                       :: ITYPE
LOGICAL                       :: LEX

CALL IGRPLOTMODE(MODEXOR)
CALL IGRCOLOURN(WRGB(255,255,255))

NCRD=1
LEX =.FALSE.
CALL WCURSORSHAPE(ID_CURSORDISTANCE)

CALL IGRFILLPATTERN(OUTLINE)
CALL IGRLINETYPE(SOLIDLINE)
CALL WINDOWOUTSTATUSBAR(2,'Press right mouse button to stop')

DO WHILE(.TRUE.)
 CALL WMESSAGE(ITYPE,MESSAGE)
 SELECT CASE (ITYPE)

  !## mouse-move
  CASE (MOUSEMOVE)

   CALL WINDOWSELECT(0)

   CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(RTOS(MESSAGE%GX/1000.,'F',7))//' km, Y:'//TRIM(RTOS(MESSAGE%GY/1000.,'F',7))//' km')
   
   !## first point set!
   IF(NCRD.GT.1)THEN
    CALL IDFPLOT1BITMAP()
    IF(LEX)CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
    LEX=.TRUE.
    XCRD(NCRD)=MESSAGE%GX
    YCRD(NCRD)=MESSAGE%GY
    CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
    CALL IDFPLOT2BITMAP()
   ENDIF

  CASE (PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (IDCANCEL)
     EXIT
   END SELECT

  CASE (MOUSEBUTDOWN)
   CALL IDFPLOT1BITMAP()
   IF(LEX)CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (1)  !## left button
     XCRD(NCRD:MIN(MAXCRD,NCRD+1))=MESSAGE%GX
     YCRD(NCRD:MIN(MAXCRD,NCRD+1))=MESSAGE%GY
     NCRD=MIN(MAXCRD,NCRD+1)
     IF(NCRD.EQ.MAXCRD)CALL WINDOWOUTSTATUSBAR(3,'Max='//TRIM(ITOS(MAXCRD))//'points!')
     CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
     CALL IDFPLOT2BITMAP()
    CASE (3)  !## right button
     EXIT
   END SELECT

  !## bitmap scrolled, renew top-left pixel coordinates
  CASE (BITMAPSCROLLED)
   MPW%IX=MESSAGE%VALUE1
   MPW%IY=MESSAGE%VALUE2

  CASE (EXPOSE)
    IF(WMENUGETSTATE(ID_PLOTLEGEND,2).EQ.1)CALL LEGPLOTUPDATE(.FALSE.)
    CALL IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)

 END SELECT
END DO

NCRD=NCRD-1

CALL IDFPLOT1BITMAP()
CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
CALL IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
CALL IDFPLOT2BITMAP()

CALL WCURSORSHAPE(CURARROW)
CALL IGRPLOTMODE(MODECOPY)
CALL IGRFILLPATTERN(OUTLINE)
CALL IGRLINETYPE(SOLIDLINE)
CALL WINDOWSELECT(0)
CALL WINDOWOUTSTATUSBAR(2,'')
CALL WINDOWOUTSTATUSBAR(3,'')
CALL WINDOWOUTSTATUSBAR(4,'')

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODMEASUREPLOTSHAPE(XCRD,YCRD,NCRD,MAXCRD)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MOD_UTL, ONLY : RTOS
IMPLICIT NONE
INTEGER,INTENT(IN) :: MAXCRD,NCRD
REAL,DIMENSION(MAXCRD) :: XCRD,YCRD
INTEGER :: I
REAL :: TDIST,DIST
CHARACTER(LEN=256) :: STRING
CHARACTER(LEN=256) :: CDIST,CTDIST

CALL IGRFILLPATTERN(OUTLINE)
CALL IGRPOLYLINE(XCRD,YCRD,NCRD)
TDIST=0.0
DIST =0.0
DO I=2,NCRD
 DIST =SQRT((XCRD(I)-XCRD(I-1))**2.0+(YCRD(I)-YCRD(I-1))**2.0)
 TDIST=DIST+TDIST
END DO

IF(TDIST.LT.1.0)THEN
 CTDIST=TRIM(RTOS(TDIST*100.0 ,'F',3))//' cm'
ELSEIF(TDIST.LT.1000.0)THEN
 CTDIST=TRIM(RTOS(TDIST       ,'F',3))//' m'
ELSE
 CTDIST=TRIM(RTOS(TDIST/1000.0,'F',3))//' km'
ENDIF
IF(DIST.LT.1.0)THEN
 CDIST=TRIM(RTOS(DIST*100.0 ,'F',3))//' cm'
ELSEIF(DIST.LT.1000.0)THEN
 CDIST=TRIM(RTOS(DIST       ,'F',3))//' m'
ELSE
 CDIST=TRIM(RTOS(DIST/1000.0,'F',3))//' km'
ENDIF

STRING='Total distance= '//TRIM(CTDIST)//'; Distance last segment= '//TRIM(CDIST)

CALL WINDOWOUTSTATUSBAR(4,STRING)

RETURN
END SUBROUTINE

!###=========================================================================
SUBROUTINE IMODGETHELP(TOPIC,CTOPIC) 
!###=========================================================================
USE WINTERACTER
USE MOD_PREF_PAR, ONLY : PREFVAL
USE IMODVAR, ONLY : IDPROC
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: TOPIC,CTOPIC
LOGICAL :: LEX,LACROBAT
INTEGER :: ISTATUS,IEXCOD
CHARACTER(LEN=256) :: LINE

!## error/warning checking
IF(PREFVAL(4).EQ.'')THEN
 CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'You should specify the keyword HELPFILE in the Preference file of iMOD.'// &
              'E.g. HELPFILE=D:\IMOD\HELP.PDF','Warning')
 RETURN
ENDIF
INQUIRE(FILE=PREFVAL(4),EXIST=LEX)
IF(.NOT.LEX)THEN
 CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Can not find the specified HELPFILE='//TRIM(PREFVAL(4)),'Warning')
 RETURN
ENDIF

LACROBAT=.TRUE.

!## acrobat reader
IF(PREFVAL(13).EQ.'')THEN
 CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'You should specify the keyword ACROBATREADER in the Preference file of iMOD.'// &
              'E.g. ACROBATREADER=c:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe','Warning')
 RETURN
ENDIF
INQUIRE(FILE=PREFVAL(13),EXIST=LEX)
IF(.NOT.LEX)THEN
 CALL WMESSAGEBOX(OKONLY,COMMONOK,EXCLAMATIONICON,'Can not find the specified ACROBATREADER='//TRIM(PREFVAL(13)),'Warning')
 RETURN
ENDIF

!## acrobat reader
IF(LACROBAT)THEN
 LINE='"'//TRIM(PREFVAL(13))//'" /A "nameddest='//TRIM(CTOPIC)//'" "'//TRIM(PREFVAL(4))//'"'
!## sumatra pdf
ELSE
 LINE='"'//TRIM(PREFVAL(13))//'" -reuse-instance -named-dest sec:'//TRIM(CTOPIC)//' "'//TRIM(PREFVAL(4))//'"'
ENDIF

IF(IDPROC(1).NE.0)THEN
#if (defined(WINTERACTER9))
  CALL IOSCOMMANDCHECK(IDPROC,ISTATUS,IEXCOD=IEXCOD)
#endif
 !## killed
 IF(ISTATUS.EQ.0)THEN

 !## still running, kill it
 ELSEIF(ISTATUS.EQ.1)THEN
#if (defined(WINTERACTER9))
  CALL IOSCOMMANDKILL(IDPROC,0)
#endif
 ENDIF
ENDIF

CALL IOSCOMMAND(LINE,PROCSILENT,IDPROC=IDPROC)

!## SumatraPDF:
!"c:\Program Files (x86)\SumatraPDF\SumatraPDF.exe" -reuse-instance -named-dest sec:5.3 imod_um.pdf
!## AdobeReader:
!"c:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe" /n /s /A "nameddest=sec:5.3" imod_um.pdf

END SUBROUTINE IMODGETHELP

!###======================================================================
SUBROUTINE MAIN1INACTMODULE(ID)
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE IMODVAR, ONLY : IDIAGERROR
USE MOD_IR, ONLY : IR1CLOSE
USE MOD_PROFILE, ONLY : PROFILE_CLOSE
USE MOD_IDFTIMESERIE, ONLY : IDFTIMESERIE_CLOSE
USE MOD_MANAGER, ONLY : MANAGERCLOSE
USE MOD_IDFEDIT, ONLY : IDFEDITCLOSE
USE MOD_EXTRACTIPF, ONLY : EXTRACTIPF1CLOSE
USE MOD_IPFGETVALUE, ONLY : IPFGETVALUE_CLOSE
USE MOD_TOOLS, ONLY : TOOLS1CLOSE
USE MOD_SCEN, ONLY : SCEN1CLOSE
USE MOD_CREATEIDF, ONLY : CREATEIDF1CLOSE
USE MOD_SPOINTS,ONLY : STARTP1CLOSE
USE MOD_MODEL, ONLY : MODEL1CLOSE
USE MOD_SCENTOOL, ONLY : ST1CLOSE
USE MOD_SOLID, ONLY : SOLIDCLOSE
USE MOD_ISG, ONLY : ISGEDITCLOSE
USE MOD_CREATEGEN, ONLY : CREATEGEN1CLOSE
USE MOD_CREATEIPF, ONLY : CREATEIPF1CLOSE
IMPLICIT NONE
INTEGER,INTENT(IN) :: ID

IF(ID.NE.ID_RUNMODEL.AND.WMENUGETSTATE(ID_RUNMODEL,2).EQ.1)          CALL MODEL1CLOSE()
IF(ID.NE.ID_IRDATABASE.AND.WMENUGETSTATE(ID_IRDATABASE,2).EQ.1)      CALL IR1CLOSE(1)
IF(ID.NE.ID_IDFEDIT.AND.WMENUGETSTATE(ID_IDFEDIT,2).EQ.1)            CALL IDFEDITCLOSE()
IF(ID.NE.ID_ISGEDIT.AND.WMENUGETSTATE(ID_ISGEDIT,2).EQ.1)            CALL ISGEDITCLOSE(1)
IF(ID.NE.ID_SCENARIO.AND.WMENUGETSTATE(ID_SCENARIO,2).EQ.1)          CALL SCEN1CLOSE(1)
IF(ID.NE.ID_SPOINTS.AND.WMENUGETSTATE(ID_SPOINTS,2).EQ.1)            CALL STARTP1CLOSE(1)
IF(ID.NE.ID_WBAL.AND.WMENUGETSTATE(ID_WBAL,2).EQ.1)                  CALL TOOLS1CLOSE()
IF(ID.NE.ID_GXG.AND.WMENUGETSTATE(ID_GXG,2).EQ.1)                    CALL TOOLS1CLOSE()
IF(ID.NE.ID_MEAN.AND.WMENUGETSTATE(ID_MEAN,2).EQ.1)                  CALL TOOLS1CLOSE()
IF(ID.NE.ID_TS.AND.WMENUGETSTATE(ID_TS,2).EQ.1)                      CALL TOOLS1CLOSE()
IF(ID.NE.ID_CREATEGEN.AND.WMENUGETSTATE(ID_CREATEGEN,2).EQ.1)        CALL CREATEGEN1CLOSE()
IF(ID.NE.ID_CREATEIPF.AND.WMENUGETSTATE(ID_CREATEIPF,2).EQ.1)        CALL CREATEIPF1CLOSE()
IF(ID.NE.ID_CREATEIDF_IPF.AND.WMENUGETSTATE(ID_CREATEIDF_IPF,2).EQ.1)CALL CREATEIDF1CLOSE()
IF(ID.NE.ID_CREATEIDF_GEN.AND.WMENUGETSTATE(ID_CREATEIDF_GEN,2).EQ.1)CALL CREATEIDF1CLOSE()
IF(ID.NE.ID_CREATEIDF_IFF.AND.WMENUGETSTATE(ID_CREATEIDF_IFF,2).EQ.1)CALL CREATEIDF1CLOSE()
IF(ID.NE.ID_EXTRACTIPF.AND.WMENUGETSTATE(ID_EXTRACTIPF,2).EQ.1)      CALL EXTRACTIPF1CLOSE()
IF(ID.NE.ID_PROFILE.AND.WMENUGETSTATE(ID_PROFILE,2).EQ.1)            CALL PROFILE_CLOSE()
IF(ID.NE.ID_TIMESERIES.AND.WMENUGETSTATE(ID_TIMESERIES,2).EQ.1)      CALL IDFTIMESERIE_CLOSE()
IF(ID.NE.ID_MANAGER.AND.WMENUGETSTATE(ID_MANAGER,2).EQ.1)            CALL MANAGERCLOSE()
IF(ID.NE.ID_ANALYSEIPF.AND.WMENUGETSTATE(ID_ANALYSEIPF,2).EQ.1)      CALL IPFGETVALUE_CLOSE()
!IF(ID.NE.ID_SCENTOOL.AND.WMENUGETSTATE(ID_SCENTOOL,2).EQ.1)          CALL ST1CLOSE()

!## close only if not equal profile-tool/3d tool
IF(ID.NE.ID_PROFILE.AND.&
   ID.NE.ID_3DTOOL.AND. &
   ID.NE.ID_SOLIDS.AND.WMENUGETSTATE(ID_SOLIDS,2).EQ.1)CALL SOLIDCLOSE()

!IF(IDIAGERROR.EQ.0)CALL WMENUSETSTATE(ID,2,1)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODINIT()
!###======================================================================
USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE MOD_UTL, ONLY : IMESSAGE
USE MOD_GENPLOT, ONLY : GEN,NGEN,TOPOGENUPDATE
USE IMODVAR, ONLY : IMFFNAME
USE MOD_PREF_PAR, ONLY : PREFVAL
USE BMPVAR
USE MOD_MANAGER, ONLY : MANAGERFILL,MANAGERUPDATE
USE MOD_UTL, ONLY : UTL_MESSAGEHANDLE
USE IMOD
IMPLICIT NONE
LOGICAL :: LEX

CALL WMENU(ID_MAINMENU1,0)
CALL WMENUTOOLBAR(ID_TOOLBAR1,0,1)

PLOTNAME='iMOD-Map Configuration'
!## start graphical window
CALL WINDOWOPENCHILD(MPW%IWIN, &
                     FLAGS=SYSMENUON+MINBUTTON+MAXBUTTON+INSIDEPARENT+MAXWINDOW, &
                     TITLE=PLOTNAME)

MPW%DIX    =WINFOWINDOW(WINDOWWIDTH) !*MPW%DIX_BAR
MPW%DIY    =WINFOWINDOW(WINDOWHEIGHT)!*MPW%DIY_BAR

!## root window - size for the bitmap
!MPW%DIX    =WINFOSCREEN(SCREENWIDTH) *MPW%DIX_BAR
!MPW%DIY    =WINFOSCREEN(SCREENHEIGHT)*MPW%DIY_BAR

!WRITE(*,*) WINFOSCREEN(SCREENWIDTH),WINFOWINDOW(WINDOWWIDTH)
!WRITE(*,*) WINFOSCREEN(SCREENHEIGHT),WINFOWINDOW(WINDOWHEIGHT)

MPW%IBITMAP=0
!## compute start pixels such that mid of plot is in screen centre
MPW%IX=(MPW%DIX/2)-(WINFOWINDOW(WINDOWWIDTH)/2)
MPW%IY=(MPW%DIY/2)-(WINFOWINDOW(WINDOWHEIGHT)/2)
!## coordinates of current zoom-level
MPW%XMIN=-1.0
MPW%YMIN=-1.0
MPW%XMAX= 1.0
MPW%YMAX= 1.0
!## number of active plots
MPW%NACT =0
MP%IACT  =.FALSE.
MP%ISEL  =.FALSE.
IMFFNAME =''
DRWLIST  =0

CALL MANAGERFILL()
CALL MANAGERUPDATE()

NGEN=0
CALL TOPOGENUPDATE()

!## no bmp active
NBMP=0

IF(LEN_TRIM(PREFVAL(2)).GT.0)THEN
 INQUIRE(FILE=TRIM(PREFVAL(2)),EXIST=LEX)
ELSE
 LEX=.FALSE.
ENDIF
IF(LEX)THEN
 IF(WMENUGETSTATE(ID_TOPOGRAPHY,1).EQ.0)THEN
  CALL WMENUSETSTATE(ID_TOPOGRAPHY,1,1)
  CALL WMENUSETSTATE(ID_TOPTRANSPARACY,1,1)
 ENDIF
ELSE
 IF(WMENUGETSTATE(ID_TOPOGRAPHY,1).EQ.1)THEN
  CALL WMENUSETSTATE(ID_TOPOGRAPHY,1,0)
  CALL WMENUSETSTATE(ID_TOPTRANSPARACY,1,0)
 ENDIF
ENDIF
CALL WMENUSETSTATE(ID_SHOWNARROW,1,0)
IF(LEN_TRIM(PREFVAL(11)).GT.0)THEN
 INQUIRE(FILE=PREFVAL(11),EXIST=LEX)    
 IF(LEX)CALL WMENUSETSTATE(ID_SHOWNARROW,1,1)
ENDIF

CALL IMODINITMESSAGE()
CALL UTL_MESSAGEHANDLE(1)

CALL WINDOWSELECT(0)
CALL WMENUSETSTATE(ID_SAVEAS,1,1)
CALL WMENUSETSTATE(ID_SAVE,1,0)
CALL WINDOWSELECT(MPW%IWIN)

RETURN
END SUBROUTINE

!###======================================================================
SUBROUTINE IMODINITMESSAGE()
!###======================================================================
USE WINTERACTER
USE MOD_UTL, ONLY : IMESSAGE

!## turn imod-messages on
IMESSAGE=0
IMESSAGE(EXPOSE)=1
IMESSAGE(RESIZE)=1
IMESSAGE(TABCHANGED)=1
IMESSAGE(EDITORCOMMAND)=1
IMESSAGE(FIELDCHANGED)=1
IMESSAGE(MOUSEBUTDOWN)=1
IMESSAGE(MOUSEBUTUP)=1
IMESSAGE(MOUSEMOVE)=1

IMESSAGE(TIMEREXPIRED)=1
CALL WMESSAGETIMER(60*1000,IREPEAT=1)  !1 minute

IMESSAGE(BITMAPSCROLLED)=1

END SUBROUTINE IMODINITMESSAGE