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

USE WINTERACTER
USE RESOURCE
USE MOD_DBL
USE MOD_IDFPLOT
USE MOD_QKSORT
USE MOD_MAIN_UTL
USE MODPLOT, ONLY : MP,MPW,DRWLIST,MXMPLOT,MXCLR,MXCGRAD,ZM
USE MOD_PREF_PAR, ONLY : PREFVAL
USE IMODVAR, ONLY : DP_KIND,SP_KIND,IDIAGERROR,IMFFNAME
USE MOD_UTL, ONLY : ITOS,RTOS,UTL_GETUNIT,UTL_CLOSEUNITS,UTL_HIDESHOWDIALOG,UTL_INVERSECOLOUR,UTL_DRAWLEGENDBOX,UTL_DIST,UTL_EQUALS_REAL,NEWLINE, &
                    UTL_READARRAY,UTL_FILLARRAY,UTL_GETUNIQUE,UTL_IDFCRDCOR,UTL_IDFGETCLASS,UTL_MESSAGEHANDLE,UTL_WSELECTFILE,UTL_CAP,&
                    UTL_PROFILE_COMPVIEWBOX,UTL_PROFILE_GETVIEWBOX,UTL_CAP_BIG,UTL_DEBUGLEVEL,UTL_GETHELP
USE MOD_IFF, ONLY : IFFPLOT,IFFGETUNIT
USE MOD_IPF, ONLY : IPFPLOT,IPFREAD,IPFINIT
USE MOD_PROFILE_PAR
USE MOD_PROFILE_UTL
USE MOD_IDF, ONLY : IDFGETVAL,IDFREAD,IDFDEALLOCATEX,IDFIROWICOL
USE MOD_IDF_PAR, ONLY : IDFTRANSFORM
USE MOD_IDFGETVALUE, ONLY : IDFGETVALUE_COLOURCELL,IDFGETVALUE_SETPLACES
USE MOD_IPFGETVALUE, ONLY : IPFGETVALUE_QUICKVIEW,IPFGETVALUE_QUICKVIEW_INIT,GXMIN,GYMIN,GXMAX,GYMAX,IPFGETVALUE_QUICKVIEW_CLOSE
USE MOD_IPFGETVALUE_COLOURS, ONLY : IPFGETVALUE_PLOTCOLOURS,IPFGETVALUE_OPENSAVECOLOURS,IPFGETVALUE_GETCOLOURS
USE MOD_LEGEND, ONLY : LEG_MAIN,LEG_CREATE_INIT
USE MOD_LEGEND_UTL, ONLY : LEG_READ,LEG_ALLOCATE
USE MOD_COLOURS, ONLY : ICOLOR,MAXCOLOUR
USE MOD_GRAPH, ONLY : GRAPH_PLOTAXES
USE MOD_POLINT, ONLY : POL1LOCATE
USE MOD_IPF_LABEL, ONLY : IMOD3D_LABELS
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_SOLID_PROFILE, ONLY : SOLID_PROFILEDRAW,SOLID_PROFILEMOUSE,SOLID_PROFILEADJUST,SOLID_PROFILEDELETE,SOLID_PROFILEFITDRILL, &
     SOLID_PROFILEDELNODE,SOLID_PROFILELINECOLOR,SOLID_PROFILELINETHICKNESS,SOLID_PROFILEMINMAX, &
     ILOCK,ISSNAP,IFIND,SOLID_PROFILEFIT,SOLID_PROFILEDRAW_POLYGON,SOLID_PROFILEDRAW_MASK, &
     SOLID_PROFILEDRAW_INTERSECTIONS,SOLID_PROFILESELECTNODES
USE MOD_SOLID_UTL, ONLY : SOLIDOPENSOL,GETSOLNAME
USE MOD_SOLID_PAR, ONLY : ISPF,NSPF,SPF,IMASK
USE MOD_GEN2GEN_PUZZLE, ONLY : GENFNAME,PUZZLEMAIN
USE MOD_DEMO_PAR
USE MOD_QKSORT
USE MOD_PLUGIN_PAR

!## local module variables
TYPE(WIN_MESSAGE),PRIVATE :: MESSAGE
INTEGER,PRIVATE :: ITYPE
TYPE(AXESOBJ),PRIVATE :: AXES
INTEGER,DIMENSION(7),PRIVATE :: IPRF

INTEGER,PRIVATE :: ICURSOR_SOLID,ICRD_SOLID,JCRD_SOLID,IELEV_SOLID,IDOWN_SOLID,ICURSOR_BITMAP,ICRD_BITMAP,ICURSOR_SURVEY,ICRD_SURVEY
INTEGER,PRIVATE :: ISOL,JSOLID
INTEGER,PRIVATE :: IQUICK
INTEGER,PRIVATE :: IMOVEIPF,IMOVEIFF
INTEGER ,PRIVATE :: IFIX,IHIDE

CONTAINS

 !###======================================================================
 SUBROUTINE PROFILE_INIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ICONFIG,I

 CALL MAIN_UTL_INACTMODULE(ID_PROFILE)
 IF(IDIAGERROR.EQ.1)RETURN

 CALL WMENUSETSTATE(ID_PROFILE,2,1)

 IHIDE=0; IFIX=0; ICCOL=0
 CALL WMENUSETSTATE(ID_HIDEBITMAP,1,0)
 CALL WMENUSETSTATE(ID_FIXBITMAP,1,0)
 CALL WMENUSETSTATE(ID_REMOVEBITMAP,1,0)
 CALL WMENUSETSTATE(ID_FLIPBITMAP_HORIZONTAL,1,0)
 CALL WMENUSETSTATE(ID_FLIPBITMAP_VERTICAL,1,0)

 !## neccessary for plotting drills
 CALL WDIALOGLOAD(ID_DIPFINFO,ID_DIPFINFO)
 CALL WDIALOGLOAD(ID_DSERIESPROP,ID_DSERIESPROP)
 CALL WDIALOGLOAD(ID_DSERIESLEGEND,ID_DSERIESLEGEND)
 CALL WDIALOGTITLE('Cross-Section Legend')

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETDOUBLE(IDF_REAL2,XSIGHT)
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,ICOL1)
 CALL WDIALOGGETINTEGER(IDF_INTEGER2,ICOL2)

 !## already loaded from solid
 IF(ISOLID.EQ.0)THEN
  CALL WDIALOGLOAD(ID_DSERIES,ID_DSERIES)
  CALL WDIALOGFIELDSTATE(ID_SAVE,3)
 ENDIF
 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL WDIALOGPUTIMAGE(ID_DRAW,ID_ICONDRAW,1)
 CALL WDIALOGPUTIMAGE(ID_PROP,ID_ICONPROPERTIES,1)
 CALL WDIALOGPUTIMAGE(ID_FLIP,ID_ICONFLIP,1)
 CALL WDIALOGPUTIMAGE(ID_LEGEND,ID_ICONLEGEND,1)
 CALL WDIALOGPUTIMAGE(ID_MOVIE,ID_ICONMOVIE,1)
 CALL WDIALOGPUTIMAGE(ID_SNAPPEN,ID_ICONSNAPPEN_NOT,1)
 CALL WDIALOGPUTIMAGE(ID_INFO,ID_ICONINFO,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMINMAP,ID_ICONZOOMIN,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMOUTMAP,ID_ICONZOOMOUT,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMFULLMAP,ID_ICONZOOMFULL,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMRECTANGLEMAP,ID_ICONZOOMBOX,1)
 CALL WDIALOGPUTIMAGE(ID_MOVEMAP,ID_ICONMOVE,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMPREVIOUS,ID_ICONZOOMPREVIOUS,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMNEXT,ID_ICONZOOMNEXT,1)

 !## zoomprevious and zoomnext settings
 I=0; IF(ZM%IZOOM.GT.1)I=1
 CALL WDIALOGFIELDSTATE(ID_ZOOMPREVIOUS,I)
 I=0; IF(ZM%IZOOM.LT.ZM%NZOOM)I=1
 CALL WDIALOGFIELDSTATE(ID_ZOOMNEXT,I)

 CALL WDIALOGLOAD(ID_DSERIESMOVIE,ID_DSERIESMOVIE)
 CALL WDIALOGPUTIMAGE(ID_LEFT,ID_ICONLEFT,1)
 CALL WDIALOGPUTIMAGE(ID_FASTLEFT,ID_ICONFASTLEFT,1)
 CALL WDIALOGPUTIMAGE(ID_TOTALLEFT,ID_ICONTOTALLEFT,1)
 CALL WDIALOGPUTIMAGE(ID_RIGHT,ID_ICONRIGHT,1)
 CALL WDIALOGPUTIMAGE(ID_FASTRIGHT,ID_ICONFASTRIGHT,1)
 CALL WDIALOGPUTIMAGE(ID_TOTALRIGHT,ID_ICONTOTALRIGHT,1)
 CALL WDIALOGPUTIMAGE(ID_STOP,ID_ICONSTOP,1)

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB1)
 
 !## initialisation of state blocklines vs blockfills demo-version vs normal-version
 ILINEBLACK=0
 IF(DEMO%IDEMO.EQ.1)THEN
  IBLOCKLINES = DEMO%IBLOCKLINES
  IBLOCKFILLS = DEMO%IBLOCKFILLS
 ELSE
  IBLOCKLINES=0
  IBLOCKFILLS=1
 ENDIF
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,IBLOCKLINES) !## blocklines
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,IBLOCKFILLS) !## blockfills
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,ISKIPSHORTS) !## skip shorts
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,ILINEBLACK) !## make lines black on profile
 
 CALL WDIALOGGETMENU(IDF_MENU4,ICONFIG)
 CALL WDIALOGPUTSTRING(IDF_STRING1,PROFILE_CONFIGTXT(ICONFIG))
 
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB2)
 CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVEAS,1)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
 CALL WDIALOGPUTIMAGE(ID_FLIP,ID_ICONFLIP,1)

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB6)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN)
 CALL WDIALOGPUTIMAGE(ID_SAVEAS,ID_ICONSAVEAS)

 CALL WDIALOGSELECT(ID_DSERIESTAB1)

 !## close manager if opened!
 CALL UTL_HIDESHOWDIALOG(ID_DMANAGER,0)
 !## minimize window "0"
 CALL WINDOWSELECT(MPW%IWIN)
 CALL WINDOWSIZEPOS(ISTATE=WINHIDDEN)

 ICLRRASTER=WRGB(220,220,220) !WRGB(191,191,191)
 ICLRKNIKCP=WRGB(255,0,0)
 ICLRVIEWAR=UTL_INVERSECOLOUR(WRGB(255,0,0))
 LINEWIDTHPLOT=3
 LINECOLORPLOT=UTL_INVERSECOLOUR(WRGB(255,0,0))

 IQUICK  =0
 IMOVEIPF=1     !## move ipf while hoovering
 IMOVEIFF=0     !## still iff while hoovering
 DWIDTHCOL=0.25D0 !## minimal width of columns in ipf plot
 
 XSURVEY(1)=0.7D0; XSURVEY(2)=0.9D0 !## initial location of the survey box
 YSURVEY(1)=0.7D0; YSURVEY(2)=0.9D0 !## initial location of the survey box

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

 CALL PROFILE_MAIN()

 END SUBROUTINE PROFILE_INIT

 !###====================================================================
 SUBROUTINE PROFILE_CREATEWINDOWS()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I,IW,IH
 
 CALL PROFILE_CLOSEWINDOWS()
 
 !## create new windows 
 ALLOCATE(IWINPROFILE(NSCREEN),PRF_IBITMAP(NSCREEN),GRAPHUNITS(6,NSCREEN),GRAPHAREA(4,NSCREEN))
 DO I=1,NSCREEN
  IF(I.EQ.1)THEN
   !## create new window, inside parent-window
   CALL WINDOWOPENCHILD(IWINPROFILE(I),FLAGS=SYSMENUON+MINBUTTON+MAXBUTTON+INSIDEPARENT+MAXWINDOW+STATUSBAR, &
                        TOOLID=(/0,0,ID_TOOLBAR2,0/),TITLE='iMOD Cross-Section CHILD window')
  ELSE
   !## create new window, floated
   CALL WINDOWOPENCHILD(IWINPROFILE(I),FLAGS=SYSMENUON+MINBUTTON+MAXBUTTON+STATUSBAR, & !+OWNEDBYPARENT, &
                        TOOLID=(/0,0,ID_TOOLBAR2,0/),TITLE='iMOD Cross-Section FLOATING window', &
                        WIDTH=INT(MPW%DIX/1.5),HEIGHT=INT(MPW%DIY/1.5))
  ENDIF
  CALL WINDOWSTATUSBARPARTS(2,(/3000,-1/),(/1,1/))
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(I)) 
  IW=WINFODRAWABLE(DRAWABLEWIDTH)
  IH=WINFODRAWABLE(DRAWABLEHEIGHT)
  CALL WBITMAPCREATE(PRF_IBITMAP(I),IW,IH)
  GRAPHAREA(1,I) =0.0D0 !## xmin
  GRAPHAREA(2,I) =0.0D0 !## ymin
  GRAPHAREA(3,I) =1.0D0 !## xmax
  GRAPHAREA(4,I) =1.0D0 !## ymax
  GRAPHUNITS(1,I)=0.0D0 !## xmin
  GRAPHUNITS(2,I)=0.0D0 !## ymin
  GRAPHUNITS(3,I)=1.0D0 !## xmax
  GRAPHUNITS(4,I)=1.0D0 !## ymax
  GRAPHUNITS(5,I)=0.0D0 !## y2min
  GRAPHUNITS(6,I)=1.0D0 !## y2max

  IF(MXNIDF.LE.0)THEN
   CALL WINDOWSELECT(IWINPROFILE(I))
   CALL WMENUSETSTATE(ID_FLOATLEGEND,ITEMENABLED,DISABLED)
  ENDIF

 ENDDO

 END SUBROUTINE PROFILE_CREATEWINDOWS

 !###====================================================================
 SUBROUTINE PROFILE_MAIN()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IEXIT,I
 LOGICAL :: LEX
 
 !## initialisation, array (de)allocation e.g.
 IF(.NOT.PROFILE_ALLOCATE())THEN; CALL PROFILE_CLOSE(); RETURN; ENDIF
 
 !## create windows
 CALL PROFILE_CREATEWINDOWS()

 IF(DEMO%IDEMO.EQ.1)THEN
  CALL PROFILE_FIELDTOOLBAR(0,1)
 ELSE
  CALL PROFILE_FIELDTOOLBAR(0,0)
 ENDIF

 IXY  =0
 IP   =0
 NXY  =0
 XPOSPROF =0.0D0
 XMIN =0.0D0
 XMAX =0.0D0
 YMIN =0.0D0
 YMAX =0.0D0
 ISNAP=0
 IDOWN_PRF=0
 IDOWN_SOLID=0

 ICURSOR_SOLID=0
 ICRD_SOLID=0
 IELEV_SOLID=0
 ICURSOR_BITMAP=0 
 ICRD_BITMAP=0
 
 !## see whether colouring is active
 ICCOL=0; DO I=1,MXNIDF
  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
  !## colouring
  IF(IPRF(5).EQ.1)THEN; ICCOL=1; EXIT; ENDIF
 ENDDO

 !## draw first selected cross-section if solid tool is active
 IF(ISOLID.EQ.1)CALL SOLID_PROFILEUPDATECROSS(0,0)
 
 !## stop whenever isavebmp.eq.1
 CALL PROFILE_DEMO()
 
 LEX=.TRUE.; IF(DEMO%ISAVEBMP.EQ.1)LEX=.FALSE.

 IF(LEX)THEN

  DO

   !## get messages
   CALL WMESSAGE(ITYPE,MESSAGE)

   CALL PROFILE_MAIN_MESSAGE(IEXIT) 
   IF(IEXIT.EQ.1)EXIT

  ENDDO
 
 ENDIF
 
 IF(NXY.GT.0)CALL PROFILE_CLEAR()

 !## herstel selektie
 MP%ISEL=LISEL

 CALL UTL_MESSAGEHANDLE(0)
 CALL PROFILE_CLOSE()
 CALL UTL_MESSAGEHANDLE(1)

 END SUBROUTINE PROFILE_MAIN

 !###====================================================================
 SUBROUTINE PROFILE_MAIN_MESSAGE(IEXIT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 INTEGER :: I
 
 IEXIT=0
  
 IF(IQUICK.EQ.1)THEN
  CALL IPFGETVALUE_QUICKVIEW(ITYPE,MESSAGE,IWINPROFILE(1),1,IEXIT)
  IF(IEXIT.EQ.1)THEN
   CALL UTL_HIDESHOWDIALOG(ID_DSERIES,2)

   !## create new windows 
   ALLOCATE(GRAPHUNITS(6,NSCREEN),GRAPHAREA(4,NSCREEN))
   DO I=1,NSCREEN
    GRAPHAREA(1,I) =0.0D0 !## xmin
    GRAPHAREA(2,I) =0.0D0 !## ymin
    GRAPHAREA(3,I) =1.0D0 !## xmax
    GRAPHAREA(4,I) =1.0D0 !## ymax
    GRAPHUNITS(1,I)=0.0D0 !## xmin
    GRAPHUNITS(2,I)=0.0D0 !## ymin
    GRAPHUNITS(3,I)=1.0D0 !## xmax
    GRAPHUNITS(4,I)=1.0D0 !## ymax
    GRAPHUNITS(5,I)=0.0D0 !## y2min
    GRAPHUNITS(6,I)=1.0D0 !## y2max
   ENDDO
 
   !## redraw cross-sections
   CALL PROFILE_PLOT()
   IQUICK=0; ITYPE=0; IEXIT=0
  ENDIF
  !## message already processed by quickview
  IF(IEXIT.EQ.-1)ITYPE=0
 ENDIF
    
 SELECT CASE (ITYPE)

  !## message from fieldchanged
  CASE (TABCHANGED)
   SELECT CASE (MESSAGE%VALUE2)
    CASE (ID_DSERIESTAB1)
     MESSAGE%WIN=ID_DSERIESTAB1
     CALL PROFILE_EXPOSE()
   END SELECT
    
  !## message from fieldchanged
  CASE (FIELDCHANGED)

   SELECT CASE (MESSAGE%WIN)
    CASE (ID_DSERIESTAB2)
     CALL SOLID_PROFILEMAIN(ITYPE,MESSAGE,IEXIT)
    CASE DEFAULT
     CALL PROFILE_FIELDCHANGED(IEXIT)
   END SELECT

  !## message from pushbutton
  CASE(PUSHBUTTON)

   SELECT CASE (MESSAGE%WIN)
    CASE (ID_DSERIESTAB2)
     CALL SOLID_PROFILEMAIN(ITYPE,MESSAGE,IEXIT)
    CASE DEFAULT
     CALL PROFILE_PUSHBUTTON(IEXIT)

   END SELECT

  !## messages from menu
  CASE (MENUSELECT)
   CALL PROFILE_MENUSELECT(IEXIT)

  !## mouse move
  CASE(MOUSEMOVE)
   CALL PROFILE_MOUSEMOVE()

  !## mouse released
  CASE(MOUSEBUTUP)
   CALL PROFILE_MOUSEBUTUP()

  !## mouse pressed
  CASE(MOUSEBUTDOWN)
   CALL PROFILE_MOUSEBUTDOWN()

  !## close selected window - if root window terminate iMOD
  CASE(CLOSEREQUEST)
   !## if quick view is opened, close this one
   IF(IQUICK.EQ.1)THEN
    CALL IPFGETVALUE_QUICKVIEW_CLOSE(1); IQUICK=0
   ENDIF
   IF(IP.EQ.0)THEN
    CALL WCURSORSHAPE(CURARROW)
    IEXIT=1
   ENDIF

  CASE(RESIZE)
   CALL PROFILE_RESIZE()
  CASE(EXPOSE)
   CALL PROFILE_EXPOSE()

 END SELECT

 END SUBROUTINE PROFILE_MAIN_MESSAGE

 !###======================================================================
 SUBROUTINE SOLID_PROFILEMAIN(ITYPE,MESSAGE,IEXIT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER,INTENT(IN) :: ITYPE
 INTEGER :: J
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ISEL
 
 SELECT CASE(ITYPE)

  CASE(FIELDCHANGED)
   SELECT CASE (MESSAGE%VALUE2)
    CASE (IDF_CHECK1)
     CALL WDIALOGSELECT(ID_DSERIESTAB2)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,ILOCK)
     IF(ILOCK.EQ.1)THEN
      CALL WDIALOGPUTIMAGE(IDF_CHECK1,ID_ICONLOCK_CLOSE,1)
     ELSE
      CALL WDIALOGPUTIMAGE(IDF_CHECK1,ID_ICONLOCK_OPEN,1)
     ENDIF
    CASE (IDF_CHECK2)
     CALL WDIALOGSELECT(ID_DSERIESTAB2)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IMASK)
     CALL PROFILE_PLOT()
    CASE (IDF_CHECK3)
     CALL WDIALOGSELECT(ID_DSERIESTAB2)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK3,ISSNAP)
     IF(ISSNAP.EQ.1)THEN
      CALL WDIALOGPUTIMAGE(IDF_CHECK3,ID_ICONSNAPPEN,1)
     ELSE
      CALL WDIALOGPUTIMAGE(IDF_CHECK3,ID_ICONSNAPPEN_NOT,1)
     ENDIF     
    CASE (IDF_CHECK4)
     CALL WDIALOGSELECT(ID_DSERIESTAB2)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK4,IFIND)
!     ISOLID=1
     CALL PROFILE_PLOT()
    CASE (IDF_MENU1)
!     ISOLID=1; 
     CALL SOLID_PROFILEUPDATECROSS(1,1)    
   END SELECT

  CASE(PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_NEW)
     !## start drawing a cross-section without those extra lines
!     ISOLID=1; 
     CALL SOLID_PROFILEFIT(1)
     CALL SOLID_PROFILEUPDATECROSS(1,0)
    CASE (ID_DELETE)
     CALL WDIALOGSELECT(ID_DSERIESTAB2)
     CALL WDIALOGGETMENU(IDF_MENU1,J)
     ALLOCATE(ISEL(NSPF)); ISEL=0; ISEL(J)=1
     IF(SOLID_PROFILEDELETE(ID_DSERIESTAB2,ISEL))THEN
      CALL SOLID_PROFILEUPDATECROSS(1,0)    
     ENDIF
     DEALLOCATE(ISEL)
    !## fit cross-section to current cross-sectional lines
    CASE (ID_FIT)
!     ISOLID=1
     CALL SOLID_PROFILEFIT(0)
     CALL SOLID_PROFILEUPDATECROSS(1,0)
    CASE (ID_FITDRILL)
!     ISOLID=1
     CALL SOLID_PROFILEFITDRILL()
     CALL SOLID_PROFILEUPDATECROSS(1,0)    
    CASE (IDHELP)
       CALL UTL_GETHELP('5.4.2','TMO.ST.CrossSec')
    CASE(IDCANCEL,ID_CLOSE)
     !## make sure to take over the (adjusted) coordinates
!     ISOLID=1; 
     CALL SOLID_PROFILEUPDATECROSS(1,1)    
     IF(IP.EQ.0)IEXIT=1
   END SELECT
 END SELECT

 END SUBROUTINE SOLID_PROFILEMAIN

 !###======================================================================
 SUBROUTINE SOLID_PROFILEUPDATECROSS(IMODE,IADJCRD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IMODE,IADJCRD
 INTEGER :: I,IACT
 
 CALL WDIALOGSELECT(ID_DSERIESTAB2)

 !## copy settings for background-bitmap
 IF(ISPF.GT.0.AND.ISPF.LE.SIZE(SPF).AND.IMODE.EQ.1)THEN 
  !## get correct x- and y-coordinates
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX1,PBITMAP%IY1,PBITMAP%GX1,PBITMAP%GY1,IORIGIN=1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX2,PBITMAP%IY2,PBITMAP%GX2,PBITMAP%GY2,IORIGIN=1)
  SPF(ISPF)%PBITMAP=PBITMAP

  !## copy coordinates - only when changing menu
  IF(IADJCRD.EQ.1)THEN
   DO I=1,SPF(ISPF)%NXY
    SPF(ISPF)%X(I)=XY(1,I)
    SPF(ISPF)%Y(I)=XY(2,I)
   END DO      
  ENDIF
  
 ENDIF
 
 ISPF=0
 IF(NSPF.GT.0)CALL WDIALOGGETMENU(IDF_MENU1,ISPF)
 IF(ISPF.LE.0)RETURN
 
 !## copy saved settings for current background-bitmap
 PBITMAP=SPF(ISPF)%PBITMAP
 
 CALL PROFILE_CLEAR()
 !## put the right coordinates ...
 NXY=SPF(ISPF)%NXY
 
 IF(ASSOCIATED(XY))DEALLOCATE(XY); IF(ASSOCIATED(XYLABEL))DEALLOCATE(XYLABEL)
 ALLOCATE(XY(2,MAX(MXCRD,NXY))); XY=0.0D0
 ALLOCATE(XYLABEL(MAX(MXCRD,NXY))); XYLABEL=''

 DO I=1,NXY
  XY(1,I)=SPF(ISPF)%X(I)
  XY(2,I)=SPF(ISPF)%Y(I)
 END DO      
 CALL PROFILE_COMPUTEPLOT()
 CALL PROFILE_IDFMINMAX()

 IACT=PBITMAP%IACT
 PBITMAP%IACT=0

 CALL PROFILE_PLOT()

 PBITMAP%IACT=IACT

 !## get correct dimensions whenever a bitmap has been read
 IF(PBITMAP%IACT.NE.0)THEN
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSTOPIXELS(PBITMAP%GX1,PBITMAP%GY1,PBITMAP%IX1,PBITMAP%IY1,IORIGIN=1)
  CALL DBL_IGRUNITSTOPIXELS(PBITMAP%GX2,PBITMAP%GY2,PBITMAP%IX2,PBITMAP%IY2,IORIGIN=1)
  !## read bitmap - if available
  CALL PROFILE_BACKGROUND_BITMAP_READ()
  CALL PROFILE_PLOT()

  CALL WINDOWSELECT(0)
  CALL WMENUSETSTATE(ID_HIDEBITMAP,1,1)
  CALL WMENUSETSTATE(ID_FIXBITMAP,1,1)
  IF(IHIDE.EQ.0)CALL WMENUSETSTRING(ID_HIDEBITMAP,'Hide Background Image')
  IF(IHIDE.EQ.1)CALL WMENUSETSTRING(ID_HIDEBITMAP,'Show Background Image')
  IF(IFIX.EQ.0)CALL WMENUSETSTRING(ID_FIXBITMAP,'Lock Background Image')
  IF(IFIX.EQ.1)CALL WMENUSETSTRING(ID_FIXBITMAP,'Unlock Background Image')
  CALL WMENUSETSTATE(ID_HIDEBITMAP,2,IHIDE)
  CALL WMENUSETSTATE(ID_FIXBITMAP,2,IFIX)
  CALL WMENUSETSTATE(ID_REMOVEBITMAP,1,1)
  CALL WMENUSETSTATE(ID_FLIPBITMAP_HORIZONTAL,1,1)
  CALL WMENUSETSTATE(ID_FLIPBITMAP_VERTICAL,1,1)
  
 ELSE

  CALL WINDOWSELECT(0)
  CALL WMENUSETSTATE(ID_HIDEBITMAP,1,0)
  CALL WMENUSETSTATE(ID_FIXBITMAP,1,0)
  CALL WMENUSETSTATE(ID_REMOVEBITMAP,1,0)
  CALL WMENUSETSTATE(ID_FLIPBITMAP_HORIZONTAL,1,0)
  CALL WMENUSETSTATE(ID_FLIPBITMAP_VERTICAL,1,0)
  
 ENDIF

 XPOSPROF=0.0D0 
 CALL PROFILE_CLEAR()
 CALL PROFILE_COORDINATES(0)
 CALL PROFILE_FIELDTOOLBAR(0,1)

 END SUBROUTINE SOLID_PROFILEUPDATECROSS

 !###====================================================================
 SUBROUTINE PROFILE_MOUSEBUTUP()
 !###====================================================================
 IMPLICIT NONE
 LOGICAL :: LEX
 INTEGER :: I
 
 SELECT CASE (MESSAGE%VALUE1)
  !## left mouse button
  CASE (1)
   IF(LMOVEPROF)THEN
    LMOVEPROF=.FALSE.
    XPOSPROF=0.0D0
    CALL WCURSORSHAPE(CURARROW)
   ENDIF
   IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN
    !## profile drawing for iff's en ipf's during shiftmode
    IF(IDOWN_PRF.EQ.0)THEN
     IF(MXNIFF.GT.0)KU=ABS(KU)
     NIPF=ABS(NIPF)
     LEX=MXNIFF.GT.0
     IF(.NOT.LEX)LEX=NIPF.GT.0
     IF(ALLOCATED(IPIPET))NPIPET=SIZE(IPIPET)
     IF(.NOT.LEX)LEX=ALLOCATED(IPIPET)
     IF(LEX)CALL PROFILE_PLOT()
    ENDIF
   ELSE
    DO I=1,SIZE(IWINPROFILE)
     IF(MESSAGE%WIN.EQ.IWINPROFILE(I))IDOWN_SOLID=0   
    ENDDO
    IELEV_SOLID=0; ICURSOR_BITMAP=0
   ENDIF
 END SELECT

 END SUBROUTINE PROFILE_MOUSEBUTUP

 !###====================================================================
 SUBROUTINE PROFILE_MOUSEBUTDOWN()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I
 REAL(KIND=DP_KIND) :: MOUSEX,MOUSEY

! !## snap coordinates ... yes-or-no
! CALL PROFILE_SNAPCOORDINATES(MOUSEX,MOUSEY)
 
 SELECT CASE (MESSAGE%VALUE1)

  CASE (1)

   IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN

    !## shift mouse coordinates
    MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
    MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

    !## snap coordinates ... yes-or-no
    CALL PROFILE_SNAPCOORDINATES(MOUSEX,MOUSEY)

    !## draw profile
    IF(IP.EQ.1)THEN 
     IDOWN_PRF    =1
     NXY      =NXY+1
     IF(NXY.GT.MXCRD)THEN
      NXY     =MXCRD
     ELSE
      XY(1,NXY) =MOUSEX 
      XY(2,NXY) =MOUSEY 
     ENDIF
    ENDIF
    !## move profile currently drawn
    IF(NXY.GT.0.AND.IP.EQ.0)THEN 
     IF(WINFOMOUSE(MOUSECURSOR).EQ.ID_CURSORMOVE.OR. &
        WINFOMOUSE(MOUSECURSOR).EQ.ID_CURSORADJUSTPOINT)THEN

      LMOVEPROF=.TRUE.
      PROFX    =MOUSEX 
      PROFY    =MOUSEY 

     ENDIF
    ENDIF
    !## no profile drawing for iff's en ipf's during shiftmode
    IF(IMOVEIFF.EQ.0)THEN
     IF(MXNIFF.GT.0)KU=-1*ABS(KU)
    ENDIF
    IF(IMOVEIPF.EQ.0)THEN
     NIPF=-1*ABS(NIPF)
    ENDIF
   ELSE
    DO I=1,SIZE(IWINPROFILE)
     IF(MESSAGE%WIN.EQ.IWINPROFILE(I))IDOWN_SOLID=1
    ENDDO
    !## pushlocation
    LMBXPIX=MESSAGE%XPIX; LMBYPIX=MESSAGE%YPIX
   ENDIF

  CASE (3)

   IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN

    !## shift mouse coordinates
    MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
    MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

    !## dropdown menu
    IF(IP.EQ.0)THEN
     CALL WMENUFLOATING(ID_MENU4,MESSAGE%X,MESSAGE%Y)
    ELSEIF(IP.EQ.1)THEN
     !## remove last line
     IF(IDOWN_PRF.EQ.1)THEN
      !## if only one point before break, add last point
      IF(NXY.EQ.1)THEN
       NXY       =NXY+1
       XY(1,NXY) =MOUSEX
       XY(2,NXY) =MOUSEY
      ENDIF

      !## profile drawing for iff's en ipf's during shiftmode
      IF(MXNIFF.GT.0)KU=ABS(KU)
      NIPF=ABS(NIPF)
      IF(ALLOCATED(IPIPET))NPIPET=SIZE(IPIPET)

      CALL PROFILE_ZOOM(ID_ZOOMFULL) 

      !## remove last part of line?
      CALL PROFILE_EXTENT_2DBITMAP()
      CALL IGRLINEWIDTH(LINEWIDTHPLOT)
      IF(LLINE)THEN
       CALL IGRCOLOURN(LINECOLORPLOT)
       CALL DBL_IGRJOIN(XY(1,NXY),XY(2,NXY),XCRD,YCRD,IOFFSET=1)
       CALL PROFILE_PLOTVIEWBOX(XY(1,NXY),XY(2,NXY),XCRD,YCRD)
      ENDIF
      CALL IGRLINEWIDTH(1)

      CALL PROFILE_PUTBITMAP(MPW%IBITMAP) 

      XPOSPROF=0.0D0
     ENDIF

     CALL WDIALOGSELECT(ID_DSERIESTAB1)

     IF(NXY.LE.1)THEN
      CALL WDIALOGFIELDSTATE(ID_MOVIE,0)
      CALL WDIALOGFIELDSTATE(ID_FLIP,0)
     ELSE
      CALL WDIALOGFIELDSTATE(ID_MOVIE,1)
      CALL WDIALOGFIELDSTATE(ID_FLIP,1)
     ENDIF

     CALL WDIALOGFIELDSTATE(ID_SNAPPEN,0)
     CALL WDIALOGFIELDSTATE(ID_INFO,0)
     IF(NIPF.GT.0)THEN 
      CALL WDIALOGFIELDSTATE(ID_SNAPPEN,1)
      CALL WDIALOGFIELDSTATE(ID_INFO,1)
     ENDIF

     !## make tab for cross-sections available
     IF(ISOLID.EQ.1)THEN
      CALL WDIALOGSELECT(ID_DSERIES)
      IF(NXY.GT.1)CALL WDIALOGTABSTATE(ID_DSERIESTAB,ID_DSERIESTAB2,1)
      CALL WDIALOGSELECT(ID_DSERIESTAB1)
     ENDIF

     CALL PROFILE_FIELDTOOLBAR(0,1)

     IDOWN_PRF=0
     IP   =0
     CALL WCURSORSHAPE(CURARROW)
     CALL IGRPLOTMODE(MODECOPY)
     CALL WINDOWSELECT(0)
     CALL WINDOWOUTSTATUSBAR(2,'')
     CALL WDIALOGSELECT(ID_DSERIESTAB1)
     CALL WDIALOGFIELDSTATE(ID_DRAW,1)
     IF(MXNIDF.GT.0)CALL WDIALOGFIELDSTATE(ID_LEGEND,1)
     CALL WDIALOGFIELDSTATE(ID_PROP,1)
     IF(NXY.NE.0)CALL PROFILE_COORDINATES(0)

    ENDIF
   
   ELSE
    DO I=1,SIZE(IWINPROFILE)
     IF(MESSAGE%WIN.EQ.IWINPROFILE(I))THEN
      !## option whenever a node is selected 
      IF(ISOLID.NE.0.AND.ICURSOR_SOLID.EQ.1)THEN
       CALL WMENUFLOATING(ID_MENU3,MESSAGE%X,MESSAGE%Y)
      ELSE
       CALL WMENUFLOATING(ID_WTIMENU,MESSAGE%X,MESSAGE%Y)
      ENDIF
      EXIT
     ENDIF
    ENDDO
   ENDIF

 END SELECT

 END SUBROUTINE PROFILE_MOUSEBUTDOWN

 !###====================================================================
 SUBROUTINE PROFILE_MOUSEMOVE()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I,IWINID
 REAL(KIND=DP_KIND) :: CRITDIST,CRITPROF,DXY,X1,Y1,MOUSEX,MOUSEY

 CRITDIST=SQRT((MPW%XMAX-MPW%XMIN)**2.0D0+(MPW%YMAX-MPW%YMIN)**2.0D0)/100.0D0
 CRITPROF=0.0D0

 !## message from 2d-plot window
 IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN

  CALL DBL_IGRAREA(AREA(1),AREA(2),AREA(3),AREA(4))
  CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

  !## shift mouse coordinates
  MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
  MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

  CALL WINDOWSELECT(0)
  CALL WINDOWOUTSTATUSBAR(1,'X: '//TRIM(RTOS(MOUSEX,'F',3))//' m, Y: '//TRIM(RTOS(MOUSEY,'F',3))//' m')

  IF(IP.EQ.0.AND..NOT.LMOVEPROF)THEN
   DXY=(SQRT((MPW%XMAX-MPW%XMIN)**2.0D0+(MPW%YMAX-MPW%YMIN)**2.0D0))/100.0D0
   !## check box
   IXY=0
   DO I=1,NXY
    IF(MOUSEX.GT.XY(1,I)-DXY.AND.MOUSEX.LT.XY(1,I)+DXY.AND. &
       MOUSEY.GT.XY(2,I)-DXY.AND.MOUSEY.LT.XY(2,I)+DXY)EXIT
   END DO
   IF(I.GT.NXY)THEN
    DO I=2,NXY
     IF(DBL_IGRDISTANCELINE(XY(1,I-1),XY(2,I-1),XY(1,I),XY(2,I),MOUSEX,MOUSEY,0).LE.CRITDIST)EXIT
    END DO
    IF(I.LE.NXY)THEN
     IF(WINFOMOUSE(MOUSECURSOR).NE.ID_CURSORMOVE)CALL WCURSORSHAPE(ID_CURSORMOVE)
    ELSE
     IF(WINFOMOUSE(MOUSECURSOR).NE.CURARROW)CALL WCURSORSHAPE(CURARROW)
    ENDIF
   ELSE
    IXY=I
    IF(WINFOMOUSE(MOUSECURSOR).NE.ID_CURSORADJUSTPOINT)CALL WCURSORSHAPE(ID_CURSORADJUSTPOINT)
   ENDIF
  ENDIF

  !## move current drawn profile
  IF(LMOVEPROF)THEN
   CALL PROFILE_CLEAR()
   !## move entire line(s)
   IF(IXY.EQ.0)THEN
    XY(1,1:NXY)=XY(1,1:NXY)+(MOUSEX-PROFX)
    XY(2,1:NXY)=XY(2,1:NXY)+(MOUSEY-PROFY)
   !## move current point
   ELSE
    !## snap new point ... yes-or-no
    CALL PROFILE_SNAPCOORDINATES(MOUSEX,MOUSEY)
    XY(1,IXY)=XY(1,IXY)+(MOUSEX-PROFX)
    XY(2,IXY)=XY(2,IXY)+(MOUSEY-PROFY)
   ENDIF
   PROFX=MOUSEX
   PROFY=MOUSEY
   CALL PROFILE_COMPUTEPLOT()
   CALL PROFILE_IDFMINMAX()
   CALL PROFILE_PLOT()
   XPOSPROF=0.0D0
   CALL PROFILE_CLEAR()
  ENDIF

  !## first point set!
  IF(IDOWN_PRF.EQ.1)THEN

   CALL WCURSORSHAPE(ID_CURSORPROFILE)

   !## update profile-line - within bitmap
   CALL PROFILE_EXTENT_2DBITMAP()

   CALL IGRLINEWIDTH(LINEWIDTHPLOT)
   CALL IGRCOLOURN(LINECOLORPLOT)

   IF(LLINE)THEN
    CALL DBL_IGRJOIN(XY(1,NXY),XY(2,NXY),XCRD,YCRD,IOFFSET=1)
    !## removing optional plot viewing 'window' for particle/point plotting
    CALL PROFILE_PLOTVIEWBOX(XY(1,NXY),XY(2,NXY),XCRD,YCRD)
    CALL IGRLINEWIDTH(LINEWIDTHPLOT)
    CALL IGRCOLOURN(LINECOLORPLOT)
   ENDIF
   !## plot profile line and optional viewing 'window' for particle/point plotting
   LLINE=.TRUE.

   !## snap coordinates ... yes-or-no
   CALL PROFILE_SNAPCOORDINATES(MOUSEX,MOUSEY)

   X1   =MOUSEX 
   Y1   =MOUSEY 
   CALL DBL_IGRJOIN(XY(1,NXY),XY(2,NXY),X1,Y1,IOFFSET=1)
   CALL PROFILE_PLOTVIEWBOX(XY(1,NXY),XY(2,NXY),X1,Y1)
   CALL IGRLINEWIDTH(1)

   IF(ABS(XCRD-MOUSEX).GT.CRITPROF.OR.ABS(YCRD-MOUSEY).GT.CRITPROF)THEN

    XCRD=MOUSEX 
    YCRD=MOUSEY 

    !## temporary increase number of points, especially for iff/ipf plotting purposes
    NXY=NXY+1; CALL PROFILE_WTIADDPOINT_MEMORY(NXY)
    XY(1,NXY)=MOUSEX 
    XY(2,NXY)=MOUSEY 
    CALL PROFILE_COMPUTEPLOT()
    CALL PROFILE_IDFMINMAX()
    CALL PROFILE_PLOT()
    NXY=NXY-1

    !## position 2d-plot
    CALL PROFILE_PUTBITMAP(MPW%IBITMAP) 

   ELSE
    CALL DBL_IGRAREA(AREA(1),AREA(2),AREA(3),AREA(4))
    CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)
   ENDIF
  ENDIF

 !## graphical window for the cross-section 
 ELSE

  !## find window
  DO I=1,SIZE(IWINPROFILE); IF(MESSAGE%WIN.EQ.IWINPROFILE(I))EXIT; ENDDO
  IF(I.LE.SIZE(IWINPROFILE))THEN
   !## update all windows
   DO IWINID=1,SIZE(IWINPROFILE)
    !## activate current window   
    CALL PROFILE_EXTENT_GRAPH(IWINID)   
    CALL WINDOWOUTSTATUSBAR(1,'Distance: '//TRIM(RTOS(REAL(MESSAGE%GX,8),'F',3))//' m, Map Value: '//TRIM(RTOS(REAL(MESSAGE%GY,8),'F',3))) 
   ENDDO
   !## solid adjustment?
   IF(NXY.GT.0)THEN
    IF(IDOWN_SOLID.EQ.0)THEN 
     CALL SOLID_PROFILEMOUSE(REAL(MESSAGE%GX,8),REAL(MESSAGE%GY,8),ICURSOR_SOLID,ICRD_SOLID,IELEV_SOLID,I) 
     IF(ICURSOR_SOLID.EQ.0)THEN
      CALL PROFILE_BACKGROUND_BITMAP_MOUSEMOVE(MESSAGE%XPIX,MESSAGE%YPIX,ICURSOR_BITMAP,ICRD_BITMAP)
      !## selected bitmap
      IF(ICURSOR_BITMAP.NE.0)THEN
       ICURSOR_SOLID=0; ICRD_SOLID=0; IELEV_SOLID=0
      ELSE
       !## try to select survey plot
       CALL PROFILE_PLOTSURVEY_MOUSEMOVE(REAL(MESSAGE%XPIX,8),REAL(MESSAGE%YPIX,8),ICURSOR_SURVEY,ICRD_SURVEY)
       IF(ICURSOR_SURVEY.NE.0)THEN
        ICURSOR_SOLID=0; ICRD_SOLID=0; IELEV_SOLID=0
       ENDIF
      ENDIF
     ELSE
      ICURSOR_BITMAP=0; ICRD_BITMAP=0
     ENDIF
    ELSE
     IF(IELEV_SOLID.NE.0)THEN
      !## remove previous selected line ... draw profile to be editable only
      DO IWINID=1,SIZE(IWINPROFILE)
       CALL SOLID_PROFILEDRAW(IELEV_SOLID,IELEV_SOLID,ICRD_SOLID,ICURSOR_SOLID,IWINID)
      ENDDO
      CALL SOLID_PROFILEADJUST(REAL(MESSAGE%GX,8),REAL(MESSAGE%GY,8),ICURSOR_SOLID,ICRD_SOLID,IELEV_SOLID,I) 
      !## draw new profile to be editable only
      DO IWINID=1,SIZE(IWINPROFILE)
       CALL SOLID_PROFILEDRAW(IELEV_SOLID,IELEV_SOLID,ICRD_SOLID,ICURSOR_SOLID,IWINID) 
       !## putbitmap on entire screen or ratio
       CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
       CALL WBITMAPPUT(PRF_IBITMAP(IWINID),0,1)
      ENDDO
     ENDIF
     IF(ICURSOR_BITMAP.NE.0)THEN
      CALL PROFILE_BACKGROUND_BITMAP_ADJUST(MESSAGE%XPIX,MESSAGE%YPIX,ICURSOR_BITMAP) 
      CALL PROFILE_PLOT()
     ENDIF
     IF(ICURSOR_SURVEY.NE.0)THEN
      CALL PROFILE_PLOTSURVEY_ADJUST(REAL(MESSAGE%XPIX,8),REAL(MESSAGE%YPIX,8),ICURSOR_SURVEY) 
      CALL PROFILE_PLOT()
     ENDIF
    ENDIF
   ENDIF
   !## view on 2d-plot old position of cross-section
   CALL PROFILE_CLEAR(); XPOSPROF=DBLE(MESSAGE%GX); CALL PROFILE_CLEAR()
   CALL PROFILE_EXTENT_GRAPH(I)   
  ENDIF
   
 ENDIF

 END SUBROUTINE PROFILE_MOUSEMOVE

 !###====================================================================
 SUBROUTINE PROFILE_ADDLINELABEL()  
 !###====================================================================
 IMPLICIT NONE
 
 IF(ISPF.EQ.0.OR.IELEV_SOLID.EQ.0)RETURN
 
 CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER1,3)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2,3)
 CALL WDIALOGSHOW(-1,-1,0,3)
 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Give a Line Label Name')
 CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(SPF(ISPF)%PROF(IELEV_SOLID)%LNAME)) 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK,IDCANCEL)
      CALL WDIALOGGETSTRING(IDF_STRING1,SPF(ISPF)%PROF(IELEV_SOLID)%LNAME); EXIT
    END SELECT
  END SELECT
 ENDDO
 CALL WDIALOGUNLOAD(); IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
 
 CALL PROFILE_PLOT()

 END SUBROUTINE PROFILE_ADDLINELABEL

 !###====================================================================
 SUBROUTINE PROFILE_WTIADDPOINT()  
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: X,Y
 INTEGER :: ISEG,I
 CHARACTER(LEN=52) :: LABELNAME
  
 CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER1,3)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2,3)
 CALL WDIALOGSHOW(-1,-1,0,3)
 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Give a KnickPoint Name')
 CALL WDIALOGPUTSTRING(IDF_STRING1,'')
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK,IDCANCEL)
      CALL WDIALOGGETSTRING(IDF_STRING1,LABELNAME); EXIT
    END SELECT
  END SELECT
 ENDDO
 CALL WDIALOGUNLOAD(); IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
 
 IF(PROFILE_GETLOCATION(X,Y,XPOSPROF,ISEG))THEN; ENDIF

 !## check double points, can happen, change label and return
 DO I=1,NXY
  IF(UTL_EQUALS_REAL(XY(1,I),X).AND.UTL_EQUALS_REAL(XY(2,I),Y))THEN
   XYLABEL(I)='DP '//TRIM(XYLABEL(I)); RETURN
  ENDIF
 ENDDO

 NXY=NXY+1; CALL PROFILE_WTIADDPOINT_MEMORY(NXY)

 !## shift locations
 DO I=NXY,ISEG+1,-1
  XY(1,I)   =XY(1,I-1)
  XY(2,I)   =XY(2,I-1)
  XYLABEL(I)=XYLABEL(I-1)
 ENDDO
 XY(1,ISEG)=X; XY(2,ISEG)=Y; XYLABEL(ISEG)=TRIM(LABELNAME)
  
 CALL PROFILE_PLOT()

 END SUBROUTINE PROFILE_WTIADDPOINT
 
 !###====================================================================
 SUBROUTINE PROFILE_WTIADDPOINT_MEMORY(N)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: N
 INTEGER :: I
 
 I=SIZE(XY,2)
 IF(N.GT.I)THEN
  I=I+100; ALLOCATE(XYDUMMY(2,I),XYLABELDUMMY(I))
  DO I=1,SIZE(XY,2); XYDUMMY(1,I)=XY(1,I); XYDUMMY(2,I)=XY(2,I); XYLABELDUMMY(I)=XYLABEL(I); ENDDO
  DEALLOCATE(XY,XYLABEL); XY=>XYDUMMY; XYLABEL=>XYLABELDUMMY
 ENDIF

 END SUBROUTINE PROFILE_WTIADDPOINT_MEMORY
 
 !###====================================================================
 SUBROUTINE PROFILE_PUSHBUTTON(IEXIT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 TYPE(WIN_MESSAGE) :: MES
 INTEGER :: IT,IDIR
 REAL(KIND=DP_KIND) :: STEP

 IEXIT=0

 SELECT CASE (MESSAGE%WIN)

  !## movie dialog
  CASE (ID_DSERIESMOVIE)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_FASTLEFT,ID_FASTRIGHT,ID_LEFT,ID_RIGHT,ID_TOTALLEFT,ID_TOTALRIGHT)
     CALL WDIALOGSELECT(ID_DSERIESMOVIE)
     CALL WDIALOGGETDOUBLE(IDF_REAL1,STEP)
     CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IDIR)
     IF(MESSAGE%VALUE1.EQ.ID_FASTLEFT.OR.MESSAGE%VALUE1.EQ.ID_FASTRIGHT)THEN
      CALL PROFILE_FIELDSPLAY(ID_STOP,0)
      CALL WDIALOGFIELDSTATE(ID_STOP,1)
      DO
       CALL WDIALOGSELECT(ID_DSERIESMOVIE)
       CALL WMESSAGEPEEK(IT,MES)
       IF(IT.EQ.PUSHBUTTON.AND.MES%VALUE1.EQ.ID_STOP)EXIT
       CALL PROFILE_PROFWALK(MESSAGE%VALUE1,IDIR,STEP)
      END DO
      CALL PROFILE_FIELDSPLAY(ID_STOP,1)
      CALL WDIALOGFIELDSTATE(ID_STOP,0)
     ELSE
      CALL PROFILE_PROFWALK(MESSAGE%VALUE1,IDIR,STEP)
     ENDIF
     CALL PROFILE_COORDINATES(0)
     XPOSPROF=0.0D0

    CASE(IDCANCEL)
     CALL WDIALOGSELECT(ID_DSERIESMOVIE)
     CALL WDIALOGHIDE()
     CALL WDIALOGSELECT(ID_DSERIESTAB1)
     CALL WDIALOGPUTCHECKBOX(ID_MOVIE,0)
   END SELECT

  !## main dialog
  CASE (ID_DSERIESTAB1)
   SELECT CASE (MESSAGE%VALUE1)
!    CASE(IDCANCEL,ID_CLOSE)
!     IF(IP.EQ.0)IEXIT=1
    CASE(ID_PROP)
     !## remove current line
     CALL PROFILE_PROPMAIN()
    !## draw profile
    CASE(ID_DRAW)
     CALL PROFILE_STARTPROFILE(0)
    !## adjust legend
    CASE (ID_LEGEND)
     IF(LEG_MAIN(0))THEN
      CALL IDFPLOTFAST(1)
      CALL PROFILE_REPLOT2D(IEXIT)
     ENDIF
    CASE (ID_FLIP)
     CALL PROFILE_CLEAR()
     CALL PROFILE_TRANSFORMXY()
     CALL PROFILE_COMPUTEPLOT()
     CALL PROFILE_IDFMINMAX()
     CALL PROFILE_PLOT()
     XPOSPROF=0.0D0
     CALL PROFILE_CLEAR()
     CALL PROFILE_COORDINATES(0)

    !## zoom
    CASE (ID_ZOOMINMAP,ID_ZOOMOUTMAP,ID_ZOOMFULLMAP,ID_ZOOMPREVIOUS,ID_ZOOMNEXT)
     CALL IDFZOOM(MESSAGE%VALUE1,(MPW%XMAX+MPW%XMIN)/2.0,(MPW%YMAX+MPW%YMIN)/2.0,ID_DSERIESTAB1) 
     CALL PROFILE_REPLOT2D(IEXIT)

    !## quickview
    CASE(ID_INFO)
     IQUICK=1
     CALL UTL_HIDESHOWDIALOG(ID_DSERIES,0)
!     CALL WDIALOGSELECT(ID_DIPFINFOSERIE); CALL WDIALOGUNLOAD() 

     !## start quick-view mode
     CALL IPFGETVALUE_QUICKVIEW_INIT(1)

    !## help
    CASE(IDHELP)
       CALL UTL_GETHELP('5.4.2','TMO.ST.CrossSec')
   END SELECT

  !## main dialog
  CASE (ID_DSERIES)
   SELECT CASE (MESSAGE%VALUE1)
    CASE(IDCANCEL,ID_CLOSE)
     IF(IP.EQ.0)IEXIT=1
    !## help
    CASE(IDHELP)
     CALL UTL_GETHELP('5.4.2','TMO.ST.CrossSec')
    CASE(ID_SAVE)
     !## read entire sol, incl. spf-files
     IF(.NOT.SOLIDOPENSOL('W',GETSOLNAME(),IQ=1,TXT='Cross-Sections'))THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD could not save your cross-sections','Error')
      RETURN
     ENDIF
   END SELECT
   
  !## legend dialog
  CASE (ID_DSERIESLEGEND)
   SELECT CASE (MESSAGE%VALUE1)
    CASE(IDCANCEL,ID_CLOSE)
     IF(WMENUGETSTATE(ID_FLOATLEGEND,2).EQ.1)CALL PROFILE_LEGEND()     
   END SELECT
   
 END SELECT

 END SUBROUTINE PROFILE_PUSHBUTTON

 !###====================================================================
 SUBROUTINE PROFILE_STARTPROFILE(IMODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IMODE
 INTEGER :: I
 
 ISOL=IMODE

! !## turn this off temporarily
! ISOLID=0
  
 CALL IGRCOLOURN(WRGB(255,255,255))
 IF(NXY.GT.0)THEN
  DO I=1,SIZE(IWINPROFILE)
   CALL IGRSELECT(DRAWBITMAP,PRF_IBITMAP(I))
   CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
   CALL IGRAREACLEAR()
   CALL IGRSELECT(DRAWWIN,IWINPROFILE(I))
   CALL WBITMAPPUT(PRF_IBITMAP(I),0,1)
  ENDDO
 ENDIF
 IF(NXY.GT.0)CALL PROFILE_CLEAR()
 IP        =1
 NXY       =0
 IDOWN_PRF     =0
 LLINE     =.FALSE.
 SERIE%N=0

 NPIPET=0

 CALL WCURSORSHAPE(ID_CURSORPROFILE)
 CALL IGRFILLPATTERN(OUTLINE)
 CALL IGRLINETYPE(SOLIDLINE)
 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL WDIALOGFIELDSTATE(ID_DRAW,0)
 CALL WDIALOGFIELDSTATE(ID_PROP,0)
 CALL WDIALOGFIELDSTATE(ID_LEGEND,0)
 CALL WDIALOGFIELDSTATE(ID_FLIP,0)
 CALL WDIALOGPUTCHECKBOX(ID_MOVIE,0)
 CALL WDIALOGFIELDSTATE(ID_MOVIE,0)
 CALL WDIALOGFIELDSTATE(ID_SNAPPEN,0)
 CALL WDIALOGFIELDSTATE(ID_INFO,0)
 
 END SUBROUTINE PROFILE_STARTPROFILE
 
 !###====================================================================
 SUBROUTINE PROFILE_DIALOGFIELDS(ID,K,J)
 !###====================================================================
 USE WINTERACTER
 USE RESOURCE
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,J,K
 INTEGER :: I
 INTEGER,DIMENSION(5) :: ID1
 DATA (ID1(I),I=1,5) /ID_ZOOMINMAP,ID_ZOOMOUTMAP, &
                      ID_ZOOMRECTANGLEMAP,ID_ZOOMFULLMAP,ID_MOVEMAP/ 

 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 !## (de)activate buttons
 DO I=1,SIZE(ID1)
  IF(ID1(I).NE.ID)CALL WDIALOGFIELDSTATE(ID1(I),J)
  IF(ID1(I).EQ.ID)CALL WDIALOGPUTCHECKBOX(ID1(I),K) 
 END DO

 END SUBROUTINE PROFILE_DIALOGFIELDS

 !###====================================================================
 SUBROUTINE PROFILE_FIELDCHANGED(IEXIT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 INTEGER :: IX,IY,I

 SELECT CASE (MESSAGE%VALUE2)

  CASE (ID_ZOOMRECTANGLEMAP)
   CALL PROFILE_DIALOGFIELDS(MESSAGE%VALUE2,1,2)
   CALL IDFZOOM(MESSAGE%VALUE2,(MPW%XMAX+MPW%XMIN)/2.0,(MPW%YMAX+MPW%YMIN)/2.0,ID_DSERIESTAB1)
   CALL PROFILE_DIALOGFIELDS(MESSAGE%VALUE2,0,1)
   CALL PROFILE_REPLOT2D(IEXIT)
  !## move
  CASE(ID_MOVEMAP)
   CALL PROFILE_DIALOGFIELDS(MESSAGE%VALUE2,1,2)
   CALL IDFMOVE(ID_DSERIESTAB1)
   CALL PROFILE_DIALOGFIELDS(MESSAGE%VALUE2,0,1)
   CALL PROFILE_REPLOT2D(IEXIT)
  CASE(ID_MOVIE)
   CALL WDIALOGSELECT(ID_DSERIESTAB1)
   CALL WDIALOGGETCHECKBOX(ID_MOVIE,I)
   IF(I.EQ.1)THEN
    CALL WDIALOGSELECT(ID_DSERIES)
    IX=WINFODIALOG(DIALOGXPOS)+WINFODIALOG(DIALOGWIDTH)
    IY=WINFODIALOG(DIALOGYPOS)
    CALL WDIALOGSELECT(ID_DSERIESMOVIE)
    CALL WDIALOGSHOW(IX,IY,0,2)
   ELSE
    CALL WDIALOGSELECT(ID_DSERIESMOVIE)
    CALL WDIALOGHIDE()
   ENDIF
  CASE(ID_SNAPPEN)
   CALL WDIALOGSELECT(ID_DSERIESTAB1)
   CALL WDIALOGGETCHECKBOX(ID_SNAPPEN,ISNAP)
   IF(ISNAP.EQ.0)THEN
    CALL WDIALOGPUTIMAGE(ID_SNAPPEN,ID_ICONSNAPPEN_NOT,1)
   ELSE
    CALL WDIALOGPUTIMAGE(ID_SNAPPEN,ID_ICONSNAPPEN,1)
   ENDIF
   
  CASE (IDF_RADIO1,IDF_RADIO2)

 END SELECT

 END SUBROUTINE PROFILE_FIELDCHANGED

 !###====================================================================
 SUBROUTINE PROFILE_MENUSELECT(IEXIT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 INTEGER :: ID,I

 IEXIT=0
 
 SELECT CASE (MESSAGE%VALUE1)
  !## add label to line below line
  CASE (ID_ADDLINELABEL)
   CALL PROFILE_ADDLINELABEL()
  CASE (ID_WTIADD)
   CALL PROFILE_WTIADDPOINT()  
  CASE (ID_SELECTNODES)
   CALL SOLID_PROFILESELECTNODES()  
   CALL PROFILE_PLOT()
  CASE (ID_DRAWLINEASSPLINE)
   CALL WINDOWSELECT(0)
   I=WMENUGETSTATE(ID_DRAWLINEASSPLINE,2)
   CALL WMENUSETSTATE(ID_DRAWLINEASSPLINE,2,ABS(I-1))
   CALL PROFILE_PLOT()
  CASE (ID_REDRAW)
   CALL PROFILE_PLOT()
  CASE (ID_ZOOMWINDOW,ID_ZOOMIN,ID_ZOOMOUT,ID_MOVE,ID_ZOOMFULL)
   ID=MESSAGE%VALUE1
   CALL PROFILE_ZOOM(ID)
   GXMIN=GRAPHUNITS(1,1)
   GXMAX=GRAPHUNITS(3,1)
   GYMIN=GRAPHUNITS(2,1)
   GYMAX=GRAPHUNITS(4,1)
  !## save profile
  CASE (ID_SAVEAS)
   CALL PROFILE_SAVE('',0)
  !## print profile
  CASE (ID_PRINT)
   DO I=1,SIZE(IWINPROFILE)
    CALL IGRSELECT(2,PRF_IBITMAP(I))
    !## start print manager
    CALL IGRPRINTIMAGESELECT(10)  
    CALL WPRINTIMAGEOPTIONS(4)
    IF(WINFODIALOG(4).NE.1)RETURN
    CALL IGRPRINTIMAGE()
   ENDDO
  !## determine layer
  CASE (ID_SELECT) 
   CALL PROFILE_PIPET(MESSAGE%VALUE1)
  !## adjust legend
  CASE (ID_CDLNL,ID_CDLL,ID_TDLNL,ID_TDLL,ID_TDUV,ID_CDUV)
   CALL LEG_CREATE_INIT(MESSAGE%VALUE1)
   CALL PROFILE_REPLOT2D(IEXIT)
  CASE (ID_ADJUSTLEGEND)
   IF(LEG_MAIN(0))THEN
    CALL IDFPLOTFAST(1)
    CALL PROFILE_REPLOT2D(IEXIT)
   ENDIF
  CASE (ID_COPY)
   DO I=1,SIZE(IWINPROFILE)
    IF(MESSAGE%WIN.EQ.IWINPROFILE(I))CALL WCLIPBOARDPUTBITMAP(PRF_IBITMAP(I))
   ENDDO
  CASE (ID_DELNODE)
   CALL SOLID_PROFILEDELNODE((/ICRD_SOLID/),(/IELEV_SOLID/))
   CALL PROFILE_PLOT()
  CASE (ID_LINECOLOR)
   CALL SOLID_PROFILELINECOLOR(IELEV_SOLID)
   CALL PROFILE_PLOT()
  CASE (ID_LTHICKNESS1,ID_LTHICKNESS2,ID_LTHICKNESS3)
   CALL SOLID_PROFILELINETHICKNESS(MESSAGE%VALUE1,IELEV_SOLID)
   CALL PROFILE_PLOT()
  CASE (ID_ACTIVELINE)
   IF(IELEV_SOLID.NE.0)SPF(ISPF)%PROF(IELEV_SOLID)%IACTIVE=1
   CALL PROFILE_PLOT()
  CASE (ID_DEACTIVELINE)
   IF(IELEV_SOLID.NE.0)SPF(ISPF)%PROF(IELEV_SOLID)%IACTIVE=0
   CALL PROFILE_PLOT()
  CASE (ID_BITMAP)
   CALL WINDOWSELECT(0)
   CALL PROFILE_BACKGROUND_OPENBITMAP()
   IF(PROFILE_OPENFILES())THEN
    CALL PROFILE_PLOT()
   ELSE
    !## terminate cross-section tool
    IEXIT=1
   ENDIF
  CASE (ID_HIDEBITMAP,ID_FIXBITMAP)
   CALL WINDOWSELECT(0)
   IHIDE=WMENUGETSTATE(ID_HIDEBITMAP,2)
   IFIX =WMENUGETSTATE(ID_FIXBITMAP,2)
   IF(MESSAGE%VALUE1.EQ.ID_HIDEBITMAP)THEN
    IHIDE=ABS(IHIDE-1); CALL WMENUSETSTATE(ID_HIDEBITMAP,2,IHIDE)
    IF(IHIDE.EQ.0)CALL WMENUSETSTRING(ID_HIDEBITMAP,'Hide Background Image')
    IF(IHIDE.EQ.1)CALL WMENUSETSTRING(ID_HIDEBITMAP,'Show Background Image')
   ENDIF
   IF(MESSAGE%VALUE1.EQ.ID_FIXBITMAP)THEN
    IFIX =ABS(IFIX-1) ; CALL WMENUSETSTATE(ID_FIXBITMAP,2,IFIX)
    IF(IFIX.EQ.0)CALL WMENUSETSTRING(ID_FIXBITMAP,'Lock Background Image')
    IF(IFIX.EQ.1)CALL WMENUSETSTRING(ID_FIXBITMAP,'Unlock Background Image')
   ENDIF
   PBITMAP%IACT=1
   IF(IFIX.EQ.1) PBITMAP%IACT = 2
   IF(IHIDE.EQ.1)PBITMAP%IACT=-1*PBITMAP%IACT
   CALL PROFILE_PLOT()
  CASE (ID_FLIPBITMAP_HORIZONTAL,ID_FLIPBITMAP_VERTICAL)
   CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to flip the current image ?'//CHAR(13)// &
      'Flipped image will be saved on disk too','Question')
   IF(WINFODIALOG(4).EQ.1)THEN
    CALL UTL_MESSAGEHANDLE(0)
    IF(MESSAGE%VALUE1.EQ.ID_FLIPBITMAP_HORIZONTAL)CALL WBITMAPMIRROR(PBITMAP%IBITMAP,IDIR=0)
    IF(MESSAGE%VALUE1.EQ.ID_FLIPBITMAP_VERTICAL)  CALL WBITMAPMIRROR(PBITMAP%IBITMAP,IDIR=1) 
    !## save flipped image
    CALL WBITMAPSAVE(PBITMAP%IBITMAP,PBITMAP%FNAME)
    CALL UTL_MESSAGEHANDLE(1)
    CALL PROFILE_PLOT()
   ENDIF
  CASE (ID_REMOVEBITMAP)
   IF(PBITMAP%IACT.NE.0.AND.PBITMAP%IBITMAP.GT.0)THEN
    CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to remove the attached bitmap'//CHAR(13)// &
     TRIM(PBITMAP%FNAME),'Question')
    IF(WINFODIALOG(4).EQ.1)THEN
     CALL WINDOWSELECT(0)
     CALL WMENUSETSTATE(ID_HIDEBITMAP,1,0)
     CALL WMENUSETSTATE(ID_FIXBITMAP,1,0)
     CALL WMENUSETSTATE(ID_HIDEBITMAP,2,0)
     CALL WMENUSETSTATE(ID_FIXBITMAP,2,0)
     CALL WMENUSETSTATE(ID_REMOVEBITMAP,1,0)
     CALL WMENUSETSTATE(ID_FLIPBITMAP_HORIZONTAL,1,0)
     CALL WMENUSETSTATE(ID_FLIPBITMAP_VERTICAL,1,0)
     CALL WBITMAPDESTROY(PBITMAP%IBITMAP); PBITMAP%IACT=0; CALL PROFILE_PLOT()
    ENDIF
   ENDIF
  CASE (ID_FLOATLEGEND)
   CALL PROFILE_LEGEND()

 END SELECT

 END SUBROUTINE PROFILE_MENUSELECT

 !###====================================================================
 SUBROUTINE PROFILE_REPLOT2D(IEXIT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 INTEGER :: I
 
 IEXIT=0
 
 !## reset selection
 MP%ISEL=LISEL
 CALL MANAGER_UTL_UPDATE()
 CALL IDFPLOTFAST(0)
 !## turn off
 CALL PROFILE_TURNOFF()
 CALL PROFILE_CLEAR()
 !## reopen files
 IF(.NOT.PROFILE_OPENFILES())RETURN

 !## zoomprevious and zoomnext settings
 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 I=0; IF(ZM%IZOOM.GT.1)I=1
 CALL WDIALOGFIELDSTATE(ID_ZOOMPREVIOUS,I)
 I=0; IF(ZM%IZOOM.LT.ZM%NZOOM)I=1
 CALL WDIALOGFIELDSTATE(ID_ZOOMNEXT,I)
 
 END SUBROUTINE PROFILE_REPLOT2D

  !###====================================================================
 SUBROUTINE PROFILE_EXPOSE()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IWINID
 
 IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN
  CALL PROFILE_CLEAR()
  XPOSPROF=0.0D0
  CALL PROFILE_CLEAR()
  RETURN
 ENDIF
 
 !## refresh all
 DO IWINID=1,SIZE(IWINPROFILE)
  IF(MESSAGE%WIN.NE.IWINPROFILE(IWINID))CYCLE
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
  CALL WBITMAPPUT(PRF_IBITMAP(IWINID),0,1)
  RETURN
 ENDDO
 
 END SUBROUTINE PROFILE_EXPOSE

 !###====================================================================
 SUBROUTINE PROFILE_RESIZE()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IH,IW,IWINID

 IF(MESSAGE%WIN.EQ.0)THEN
  CALL WINDOWSELECT(MPW%IWIN)
  CALL WINDOWSIZEPOS(ISTATE=WINHIDDEN)
 ENDIF
 
 IF(MESSAGE%WIN.EQ.ID_DSERIESTAB1)THEN
  CALL PROFILE_CLEAR()
  XPOSPROF=0.0D0
  CALL PROFILE_CLEAR()
  RETURN 
 ENDIF
 
 !## refresh all
 DO IWINID=1,SIZE(IWINPROFILE)
  IF(MESSAGE%WIN.NE.IWINPROFILE(IWINID))CYCLE

  !## plot window resized, resize bitmap!
  CALL WINDOWSELECT(IWINPROFILE(IWINID))
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))

  IW=WINFODRAWABLE(DRAWABLEWIDTH)
  IH=WINFODRAWABLE(DRAWABLEHEIGHT)
  IF(PRF_IBITMAP(IWINID).NE.0)CALL WBITMAPDESTROY(PRF_IBITMAP(IWINID))
  CALL WBITMAPCREATE(PRF_IBITMAP(IWINID),IW,IH)
  CALL PROFILE_PLOT()

  RETURN
 ENDDO

 END SUBROUTINE PROFILE_RESIZE

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

 !## set drawable, extent and linetype/drawingtype (xor-mode)
 CALL PROFILE_EXTENT_2DBITMAP()
 DO I=2,NXY
  CALL IGRLINEWIDTH(LINEWIDTHPLOT)
  CALL IGRCOLOURN(LINECOLORPLOT)
  CALL DBL_IGRJOIN(XY(1,I-1),XY(2,I-1),XY(1,I),XY(2,I),IOFFSET=1)
  CALL IGRLINEWIDTH(1)
  CALL PROFILE_PLOTVIEWBOX(XY(1,I-1),XY(2,I-1),XY(1,I),XY(2,I))
 END DO
 CALL IGRLINEWIDTH(1)
 CALL PROFILE_PLOTLOCATION(LINEWIDTHPLOT)
 
 CALL PROFILE_PUTBITMAP(MPW%IBITMAP) 
 CALL IGRPLOTMODE(MODECOPY)

 END SUBROUTINE PROFILE_CLEAR
 
  !###======================================================================
 SUBROUTINE PROFILE_PLOTVIEWBOX(X1,Y1,X2,Y2)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: X1,X2,Y1,Y2
 REAL(KIND=DP_KIND),DIMENSION(4,2) :: XYPOL

 IF(ABS(MXNIFF).EQ.0.AND.ABS(NIPF).EQ.0)RETURN
 IF(XSIGHT.LE.0.0D0)RETURN

 CALL UTL_PROFILE_COMPVIEWBOX(X1,X2,Y1,Y2,XYPOL,XSIGHT)
 CALL IGRLINEWIDTH(1)
 CALL IGRFILLPATTERN(SOLID)
 CALL IGRCOLOURN(ICLRVIEWAR)
 CALL DBL_IGRPOLYGONSIMPLE(XYPOL(:,1),XYPOL(:,2),4,IOFFSET=1)
 CALL IGRFILLPATTERN(OUTLINE)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRLINEWIDTH(1)

 END SUBROUTINE PROFILE_PLOTVIEWBOX

 !###======================================================================
 SUBROUTINE PROFILE_FIELDTOOLBAR(ID,J)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,J
 INTEGER :: I,IW

 I=J
 IF(DEMO%IDEMO.EQ.1)THEN
  NXY=DEMO%NXY
 ENDIF 
 IF(NXY.LE.0)I=0

 !## adjust all buttons on graphical windows
 DO IW=1,SIZE(IWINPROFILE)

  CALL WINDOWSELECT(IWINPROFILE(IW))
  CALL WMENUSETSTATE(ID_ZOOMIN,1,I)
  CALL WMENUSETSTATE(ID_ZOOMOUT,1,I)
  CALL WMENUSETSTATE(ID_ZOOMWINDOW,1,I)
  CALL WMENUSETSTATE(ID_ZOOMFULL,1,I)
  CALL WMENUSETSTATE(ID_SAVEAS,1,I)
  CALL WMENUSETSTATE(ID_MOVE,1,I)
  CALL WMENUSETSTATE(ID_COPY,1,I)
  CALL WMENUSETSTATE(ID_PRINT,1,I)
  CALL WMENUSETSTATE(ID_SELECT,1,I)
!  CALL WMENUSETSTATE(ID_BITMAP,1,I)
 
  IF(ID.EQ.0.AND.ABS(I-1).EQ.0)THEN 
  ELSE
   CALL WMENUSETSTATE(ID,1,1)
   CALL WMENUSETSTATE(ID,2,ABS(I-1))
  ENDIF
  
 ENDDO
  
 END SUBROUTINE PROFILE_FIELDTOOLBAR

 !###======================================================================
 SUBROUTINE PROFILE_BACKGROUND_OPENBITMAP()
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: RSIZE=1000
 INTEGER,ALLOCATABLE,DIMENSION(:) :: INFO
 INTEGER :: I,IW,IH,SH,SW
 REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2,RW
  
 PBITMAP%FNAME=''
 IF(.NOT.UTL_WSELECTFILE('All Known Files (*.bmp;*.png;*.jpg)|*.bmp;*.png;*.jpg|BitMap (*.bmp)|*.bmp| &
                   Portable Network Graphic image (*.png)|*.png|JPEG Image (*.jpg)|*.jpg|',&
                  LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,PBITMAP%FNAME,&
                  'Load Background BitMap (*.bmp;*.png;*.jpg)'))RETURN

 DO I=1,2
  
  IF(ALLOCATED(INFO))DEALLOCATE(INFO); ALLOCATE(INFO(6))

  !## reads from unit 40 ???
  CALL IGRFILEINFO(PBITMAP%FNAME,INFO,6)

  PBITMAP%ITYPE=INFO(1)
  PBITMAP%NCOL =INFO(2) !## Image width in pixels.
  PBITMAP%NROW =INFO(3) !## Image height in pixels.
  PBITMAP%NCLR =INFO(4) !## Number of colours.
  PBITMAP%COMPR=INFO(5) !## Is file compressed ? 0 = no , 1 = yes.
  PBITMAP%CDEPT=INFO(6) !## Colour depth in bits-per-pixel (1-32)
  IF(ALLOCATED(INFO))DEALLOCATE(INFO)

  IF(I.EQ.2)EXIT
  
  !## try to resample - and save
  IF(PBITMAP%NCOL.GT.RSIZE.OR.PBITMAP%NROW.GT.RSIZE)THEN
   CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Do you want to resize the image and save it as:'//CHAR(13)//  &
    PBITMAP%FNAME(1:INDEX(PBITMAP%FNAME,'.',.TRUE.)-1)//'_resized.png','Question')
   IF(WINFODIALOG(4).EQ.1)THEN
    RW=REAL(PBITMAP%NCOL)/REAL(PBITMAP%NROW)
    IF(PBITMAP%NCOL.GT.PBITMAP%NROW)THEN
     SW=RSIZE; SH=SW/RW
    ELSE
     SH=RSIZE; SW=SH*RW
    ENDIF

    CALL WBITMAPCREATE(PBITMAP%IBITMAP,SW,SH)
    CALL WBITMAPSTRETCHMODE(STRETCHHALFTONE)
    CALL WBITMAPLOAD(PBITMAP%IBITMAP,PBITMAP%FNAME,1)

    PBITMAP%FNAME=PBITMAP%FNAME(1:INDEX(PBITMAP%FNAME,'.',.TRUE.)-1)//'_resized.png'
    CALL WBITMAPSAVE(PBITMAP%IBITMAP,PBITMAP%FNAME)  
    CALL WBITMAPDESTROY(PBITMAP%IBITMAP)
    
   ENDIF
  ENDIF
 
 ENDDO
 
 IW=WINFODRAWABLE(DRAWABLEWIDTH)
 IH=WINFODRAWABLE(DRAWABLEHEIGHT)

 !## initialize parameters x1,x2 y1=top y2=bottom
 PBITMAP%IX1=IW/4.0;PBITMAP%IX2=IW*(3.0/4.0);PBITMAP%IY1=IH/4.0;PBITMAP%IY2=IH*(3.0/4.0)
 X1=PBITMAP%IX1
 X2=PBITMAP%IX2
 Y1=PBITMAP%IY1
 Y2=PBITMAP%IY2
 CALL UTL_IDFCRDCOR(X1,X2,Y1,Y2,REAL(PBITMAP%NCOL,8),REAL(PBITMAP%NROW,8))
 PBITMAP%IX1=X1
 PBITMAP%IX2=X2
 PBITMAP%IY1=Y1
 PBITMAP%IY2=Y2
 
 CALL PROFILE_BACKGROUND_BITMAP_READ()
 
 CALL WMENUSETSTATE(ID_HIDEBITMAP,1,1)
 CALL WMENUSETSTATE(ID_FIXBITMAP,1,1)
 CALL WMENUSETSTATE(ID_REMOVEBITMAP,1,1)
 CALL WMENUSETSTATE(ID_FLIPBITMAP_HORIZONTAL,1,1)
 CALL WMENUSETSTATE(ID_FLIPBITMAP_VERTICAL,1,1)

 END SUBROUTINE PROFILE_BACKGROUND_OPENBITMAP

 !###======================================================================
 SUBROUTINE PROFILE_BACKGROUND_BITMAP_MOUSEMOVE(IPX,IPY,CRDITYPE,ICRD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPX,IPY
 INTEGER,INTENT(OUT) :: CRDITYPE,ICRD
 REAL(KIND=DP_KIND) :: DX,XC,YC
 REAL(KIND=DP_KIND),DIMENSION(2) :: XCRD,YCRD

 CRDITYPE=0
 ICRD=0
 
 IF(PBITMAP%IACT.NE.1)RETURN 
 
 XC=REAL(IPX,8); YC=REAL(IPY,8)
 XCRD(1)=REAL(PBITMAP%IX1,8); YCRD(1)=REAL(PBITMAP%IY1,8)
 XCRD(2)=REAL(PBITMAP%IX2,8); YCRD(2)=REAL(PBITMAP%IY2,8)

 DX=10.0D0 !## pixels 

 !## line piece
! ICRD=0
 IF(DBL_IGRDISTANCELINE(XCRD(2),YCRD(2),XCRD(1),YCRD(2),XC,YC,0).LE.DX)ICRD=1 !## bottom
 IF(DBL_IGRDISTANCELINE(XCRD(2),YCRD(1),XCRD(2),YCRD(2),XC,YC,0).LE.DX)ICRD=2 !## right
 IF(DBL_IGRDISTANCELINE(XCRD(1),YCRD(1),XCRD(2),YCRD(1),XC,YC,0).LE.DX)ICRD=3 !## top
 IF(DBL_IGRDISTANCELINE(XCRD(1),YCRD(2),XCRD(1),YCRD(1),XC,YC,0).LE.DX)ICRD=4 !## left
 
 IF(UTL_DIST(XCRD(2),YCRD(1),XC,YC).LE.DX)ICRD=6 !## urc
 IF(UTL_DIST(XCRD(2),YCRD(2),XC,YC).LE.DX)ICRD=7 !## lrc
 IF(UTL_DIST(XCRD(1),YCRD(2),XC,YC).LE.DX)ICRD=8 !## llc
 IF(UTL_DIST(XCRD(1),YCRD(1),XC,YC).LE.DX)ICRD=9 !## ulc 
 
 SELECT CASE(ICRD)
  CASE (1,3)
   CALL WCURSORSHAPE(ID_CURSORMOVEUPDOWN)
  CASE (2,4)
   CALL WCURSORSHAPE(ID_CURSORMOVELEFTRIGHT)
  CASE (7,9)
   CALL WCURSORSHAPE(ID_CURSORMOVENWSE)
  CASE (6,8)
   CALL WCURSORSHAPE(ID_CURSORMOVENESW)
 END SELECT
 CRDITYPE=ICRD; IF(CRDITYPE.NE.0)RETURN

 IF(XC.GT.XCRD(1).AND.XC.LT.XCRD(2).AND. &
    YC.GT.YCRD(1).AND.YC.LT.YCRD(2))THEN
  CALL WCURSORSHAPE(ID_CURSORMOVE)
  CRDITYPE=5; RETURN
 ENDIF

 !ICRD=0; CRDITYPE=0; 
 CALL WCURSORSHAPE(CURARROW)

 END SUBROUTINE PROFILE_BACKGROUND_BITMAP_MOUSEMOVE
 
 !###======================================================================
 SUBROUTINE PROFILE_BACKGROUND_BITMAP_ADJUST(IPX,IPY,CRDITYPE) 
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPX,IPY
 INTEGER,INTENT(IN) :: CRDITYPE 
 INTEGER :: IDX,IDY
 
 IDX=IPX-LMBXPIX
 IDY=IPY-LMBYPIX

 SELECT CASE (CRDITYPE)
  CASE (1) !## bottom  
   PBITMAP%IY2=PBITMAP%IY2+IDY
  CASE (2) !## right
   PBITMAP%IX2=PBITMAP%IX2+IDX
  CASE (3) !## top
   PBITMAP%IY1=PBITMAP%IY1+IDY
  CASE (4) !## left
   PBITMAP%IX1=PBITMAP%IX1+IDX
  CASE (5) !## move
   PBITMAP%IX1=PBITMAP%IX1+IDX
   PBITMAP%IX2=PBITMAP%IX2+IDX
   PBITMAP%IY1=PBITMAP%IY1+IDY
   PBITMAP%IY2=PBITMAP%IY2+IDY
  CASE (6) !## urc
   PBITMAP%IX2=PBITMAP%IX2+IDX
   PBITMAP%IY1=PBITMAP%IY1+IDY
  CASE (7) !## lrc
   PBITMAP%IX2=PBITMAP%IX2+IDX
   PBITMAP%IY2=PBITMAP%IY2+IDY
  CASE (8) !## llc
   PBITMAP%IX1=PBITMAP%IX1+IDX
   PBITMAP%IY2=PBITMAP%IY2+IDY
  CASE (9) !## ulc
   PBITMAP%IX1=PBITMAP%IX1+IDX
   PBITMAP%IY1=PBITMAP%IY1+IDY
 END SELECT
 
 LMBXPIX=LMBXPIX+IDX; LMBYPIX=LMBYPIX+IDY 

 END SUBROUTINE PROFILE_BACKGROUND_BITMAP_ADJUST
 
 !###======================================================================
 SUBROUTINE PROFILE_PIPET(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: IEXIT,JD,IDC,I,N,IWINID,ICLRIROW,NMOVE,ICOL,IROW
 REAL(KIND=DP_KIND) :: X1,Y1,MOUSEX,MOUSEY,IDFVAL,XC,YC
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: ZIDF
 INTEGER,DIMENSION(:),ALLOCATABLE :: ILIST,NND,IPOS

 !## window are synchronized, does not matter what menu-item to take
 CALL WINDOWSELECT(IWINPROFILE(1))

 CALL WDIALOGLOAD(ID_DIDFINFO,ID_DIDFINFO)
 CALL WDIALOGPUTSTRING(IDF_GROUP1,'')

 ALLOCATE(ILIST(3),IPOS(MXNIDF))
 ILIST(1)=1; ILIST(2)=2; ILIST(3)=3
 CALL WGRIDCOLUMNS(IDF_GRID1,3,ILIST)
 IF(ID.EQ.ID_SELECT)THEN !## plot all result in id_select mode
  !## get number of activated idf files
  N=0
  IPOS=0
  DO I=1,MXNIDF
   !## compute only those that are activated
   CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
   IF(IPRF(1).EQ.1)THEN
    N=N+1
    IPOS(N)=I
   ENDIF
  ENDDO
  CALL WGRIDROWS(IDF_GRID1,N) 
  I=(N-2)*(268-80)/16
  CALL WDIALOGSIZE(IHEIGHT=107+I)
  DO I=1,N
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,1,I,PROFIDF(IPOS(I))%ALIAS)
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,I,TRIM(IDFTRANSFORM(PROFIDF(IPOS(I))%UNITS+1)))
!   CALL WGRIDCOLOURCELL(IDF_GRID1,1,I,-1,PROFIDF(IPOS(I))%SCOLOR)
  ENDDO
 ENDIF
 DEALLOCATE(ILIST)
 CALL WDIALOGSHOW(0,0,0,2)

 JD=ID
 CALL PROFILE_FIELDTOOLBAR(JD,0)

 SELECT CASE (JD)
  !## determine layer
  CASE (ID_SELECT)
   IDC=ID_CURSORIDFVALUE
 END SELECT
 CALL WCURSORSHAPE(IDC)

 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRLINEWIDTH(1)
 CALL IGRLINETYPE(DASHED)

 IF(ALLOCATED(ZIDF))DEALLOCATE(ZIDF); ALLOCATE(ZIDF(N))
 IF(ALLOCATED(NND))DEALLOCATE(NND); ALLOCATE(NND(NSCREEN))          !## igraph=zero is not always there ...
 IF(ALLOCATED(IPIPET))DEALLOCATE(IPIPET); ALLOCATE(IPIPET(NSCREEN)) !## igraph=zero is not always there ...
 NPIPET=NSCREEN

 NMOVE=1
 ICLRIROW=0
 X1=0.0D0; Y1=0.0D0
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)

  MOUSEX=DBLE(MESSAGE%GX)
  MOUSEY=DBLE(MESSAGE%GY)
  
  DO IWINID=1,SIZE(IWINPROFILE); IF(MESSAGE%WIN.EQ.IWINPROFILE(IWINID))EXIT; ENDDO
  !## mouse inside proper window
  IF(IWINID.LE.SIZE(IWINPROFILE))THEN
   IF(WINFOMOUSE(MOUSECURSOR).NE.IDC)CALL WCURSORSHAPE(IDC)
  
   SELECT CASE (ITYPE)

    !## mouse move
    CASE(MOUSEMOVE)
     
     IF(NMOVE.EQ.1)THEN
      !## update all windows
      DO I=1,SIZE(IWINPROFILE)
       !## activatie current window   
       CALL PROFILE_EXTENT_GRAPH(I)   
       CALL WINDOWOUTSTATUSBAR(1,'Distance: '//TRIM(RTOS(MOUSEX,'G',7))//' m, Map Value: '//TRIM(RTOS(MOUSEY,'G',7))) 
       !## draw cross of current position
       CALL PROFILE_PIPET_CROSS(I,X1,Y1)
       CALL PROFILE_PIPET_CROSS(I,MOUSEX,MOUSEY)
      ENDDO
      !## find appropriate idf"
      CALL PROFILE_PIPET_SEARCH(MOUSEX,MOUSEY,ZIDF,NND,IPOS,N,JD,ICLRIROW)
      CALL PROFILE_EXTENT_GRAPH(IWINID)   

      X1=DBLE(MESSAGE%GX)
      Y1=DBLE(MESSAGE%GY)
     ENDIF

    !## mouse released
    CASE(MOUSEBUTUP)

    !## mouse pressed
    CASE(MOUSEBUTDOWN)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (RIGHTBUTTON)
       IEXIT=MESSAGE%VALUE1
       EXIT
      CASE (LEFTBUTTON)
       NMOVE=ABS(NMOVE-1)
     END SELECT
     
    CASE(EXPOSE)
     CALL PROFILE_EXPOSE()
     X1=0.0D0; Y1=0.0D0
    CASE(RESIZE)
     CALL PROFILE_RESIZE()
     X1=0.0D0; Y1=0.0D0

   END SELECT
  ELSE
   IF(WINFOMOUSE(MOUSECURSOR).NE.CURHOURGLASS)CALL WCURSORSHAPE(CURHOURGLASS)

   SELECT CASE (ITYPE)
    !## pressed close button
    CASE (PUSHBUTTON)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (IDCANCEL)
       IEXIT=3
       EXIT
      CASE (IDHELP)
       CALL UTL_GETHELP('5.4','TMO.SolTool')         
     END SELECT
    CASE (FIELDCHANGED)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (IDF_INTEGER2,IDF_MENU1)
       !## transform profile coordinates into xy coordinates
       IF(PROFILE_GETLOCATION(XC,YC,MOUSEX))THEN; ENDIF
       DO I=1,N 
        CALL IDFIROWICOL(PROFIDF(IPOS(I))%IDF,IROW,ICOL,XC,YC)
        !## get idf values
        IF(ICOL.GE.1.AND.ICOL.LE.PROFIDF(IPOS(I))%IDF%NCOL.AND. &
           IROW.GE.1.AND.IROW.LE.PROFIDF(IPOS(I))%IDF%NROW)THEN
         IDFVAL=IDFGETVAL(PROFIDF(IPOS(I))%IDF,IROW,ICOL)
         CALL IDFGETVALUE_SETPLACES(I,IDFVAL,PROFIDF(IPOS(I))%IDF%NODATA)
        ELSE
         CALL WGRIDPUTCELLSTRING(IDF_GRID1,2,I,'')
        ENDIF
       ENDDO
     END SELECT

   END SELECT
  ENDIF
 ENDDO

 CALL PROFILE_FIELDTOOLBAR(JD,1)
 CALL WCURSORSHAPE(CURARROW)
 CALL IGRPLOTMODE(MODECOPY)
 CALL IGRLINETYPE(SOLIDLINE)

 CALL WDIALOGSELECT(ID_DIDFINFO)
 CALL WDIALOGUNLOAD()

 IF(ALLOCATED(ZIDF))DEALLOCATE(ZIDF)
 IF(ALLOCATED(IPOS))DEALLOCATE(IPOS)
 IF(ALLOCATED(NND))DEALLOCATE(NND)

 !## terminated iext=3 (right-mouse-button)
 IF(IEXIT.EQ.3.OR.(JD.EQ.ID_SELECT.AND.IEXIT.EQ.1))THEN
  IF(ALLOCATED(IPIPET))DEALLOCATE(IPIPET)
  NPIPET=0
 ENDIF

 CALL PROFILE_RESIZE()

 END SUBROUTINE PROFILE_PIPET

 !###====================================================================
 SUBROUTINE PROFILE_PIPET_CROSS(IWINID,X,Y)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWINID
 REAL(KIND=DP_KIND),INTENT(IN) :: X,Y

 IF(X.EQ.0.0D0)RETURN

 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRLINEWIDTH(1)
 CALL IGRLINETYPE(DASHED)

 !## vertical
 CALL DBL_IGRJOIN(X,GRAPHUNITS(2,IWINID),X,GRAPHUNITS(4,IWINID))
 !## horizontal
 CALL DBL_IGRJOIN(GRAPHUNITS(1,IWINID),Y,GRAPHUNITS(3,IWINID),Y)
 
 END SUBROUTINE PROFILE_PIPET_CROSS

 !###======================================================================
 SUBROUTINE PROFILE_PIPET_SEARCH(GX,GY,ZIDF,NND,IPOS,N,JD,ICLRIROW)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: N,JD
 INTEGER,INTENT(INOUT) :: ICLRIROW
 REAL(KIND=DP_KIND),INTENT(IN) :: GX,GY !## graph coordinates
 INTEGER,DIMENSION(N),INTENT(IN) :: IPOS
 INTEGER,DIMENSION(NSCREEN),INTENT(OUT) :: NND
 REAL(KIND=DP_KIND),DIMENSION(N),INTENT(OUT) :: ZIDF
 INTEGER :: I,J,ICOL,IROW,IZ,ISCREEN
 REAL(KIND=DP_KIND) :: XC,YC,DZ,MINZ,ST

 !## transform profile coordinates into xy coordinates
 IF(PROFILE_GETLOCATION(XC,YC,GX))THEN; ENDIF

 CALL WDIALOGSELECT(ID_DIDFINFO)
 CALL WDIALOGPUTSTRING(IDF_GROUP1,'Current Loc. X='//TRIM(ITOS(INT(XC)))// &
                                  ' m; Y='//TRIM(ITOS(INT(YC)))//' m; Z='//TRIM(RTOS(GY,'F',2)))

 !## get number of 
 NND=0
 DO I=1,N 
  CALL IDFIROWICOL(PROFIDF(IPOS(I))%IDF,IROW,ICOL,XC,YC)
  !## get idf values
  IF(ICOL.GE.1.AND.ICOL.LE.PROFIDF(IPOS(I))%IDF%NCOL.AND. &
     IROW.GE.1.AND.IROW.LE.PROFIDF(IPOS(I))%IDF%NROW)THEN
   ZIDF(I)=IDFGETVAL(PROFIDF(IPOS(I))%IDF,IROW,ICOL,PROFIDF(IPOS(I))%UNITS)
   ISCREEN=PROFIDF(IPOS(I))%ISCREEN
   NND(ISCREEN)=NND(ISCREEN)+1
  ELSE
   ZIDF(I)=PROFIDF(IPOS(I))%IDF%NODATA
  ENDIF
 ENDDO

 DO I=1,N
  CALL IDFIROWICOL(PROFIDF(IPOS(I))%IDF,IROW,ICOL,XC,YC)
  CALL IDFGETVALUE_SETPLACES(I,ZIDF(I),PROFIDF(IPOS(I))%IDF%NODATA)
  IF(IROW.GT.PROFIDF(IPOS(I))%IDF%NROW.OR.IROW.LE.0.OR.ICOL.GT.PROFIDF(IPOS(I))%IDF%NCOL.OR.ICOL.LE.0)THEN
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,I,'Outside Domain')
   CALL WGRIDCLEARCELL(IDF_GRID1,2,I)
  ELSE
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,I,'C'//TRIM(ITOS(ICOL))//';R'//TRIM(ITOS(IROW)))
  ENDIF
 ENDDO
 
 DO ISCREEN=NSCREEN,1,-1
  IF(NND(ISCREEN).GT.0)THEN
   MINZ=(GRAPHUNITS(4,ISCREEN)-GRAPHUNITS(2,ISCREEN))*2.0D0
   IZ  = 0
   ST  = 10.0D10  !## make sure top/bottoms are declining with mxnidf
   DO J=1,N
    
    IF(PROFIDF(J)%ISCREEN.EQ.ISCREEN.AND. &
       ZIDF(J).NE.PROFIDF(J)%IDF%NODATA)THEN
     !## top/bottom is not declining with n
     IF(ZIDF(J).GT.ST)EXIT
     !## update current vertical position
     ST=ZIDF(J)
     DZ=GY-ZIDF(J)
     IF(ABS(DZ).LE.ABS(MINZ))THEN
      MINZ=DZ
      IZ  =J
     ENDIF
    ENDIF

   END DO
   
   IF(JD.EQ.ID_SELECT)THEN
   ELSE
    CALL PROFILE_PIPET_SEARCH_CLEAR(JD,ICLRIROW)
   ENDIF
  ELSE
   CALL PROFILE_PIPET_SEARCH_CLEAR(JD,ICLRIROW)
  ENDIF
 ENDDO

 END SUBROUTINE PROFILE_PIPET_SEARCH

 !###======================================================================
 SUBROUTINE PROFILE_PIPET_SEARCH_CLEAR(JD,ICLRIROW)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: JD
 INTEGER,INTENT(INOUT) :: ICLRIROW
 
 IF(JD.EQ.ID_SELECT)THEN
  IF(ICLRIROW.NE.0)CALL WGRIDCOLOURCELL(IDF_GRID1,1,ICLRIROW,-1,-1)
  ICLRIROW=0
 ENDIF
 
 END SUBROUTINE PROFILE_PIPET_SEARCH_CLEAR
 
 !###======================================================================
 SUBROUTINE PROFILE_PROFWALK(ID,IDIR,STEP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IDIR
 REAL(KIND=DP_KIND),INTENT(INOUT) :: STEP
 !INTEGER :: IDIR
 REAL(KIND=DP_KIND) :: PMN,PMX

 CALL PROFILE_CLEAR()

 !## include current zoomlevel
 IF(IDIR.EQ.1)THEN
  PMN=MPW%XMIN
  PMX=MPW%XMAX
 ELSEIF(IDIR.EQ.2)THEN
  PMN=MPW%YMIN
  PMX=MPW%YMAX
 ENDIF

 IF(ID.EQ.ID_TOTALLEFT)THEN
  IF(IDIR.EQ.1)STEP=MINVAL(XY(1,1:NXY))-PMN
  IF(IDIR.EQ.2)STEP=MINVAL(XY(2,1:NXY))-PMN
 ELSEIF(ID.EQ.ID_TOTALRIGHT)THEN
  IF(IDIR.EQ.1)STEP=PMX-MAXVAL(XY(1,1:NXY))
  IF(IDIR.EQ.2)STEP=PMX-MAXVAL(XY(2,1:NXY))
 ENDIF

 SELECT CASE (ID)

  CASE (ID_LEFT,ID_FASTLEFT,ID_TOTALLEFT)
   IF(IDIR.EQ.1.AND.MINVAL(XY(1,1:NXY))-STEP.GE.PMN)XY(1,:)=XY(1,:)-STEP
   IF(IDIR.EQ.2.AND.MINVAL(XY(2,1:NXY))-STEP.GE.PMN)XY(2,:)=XY(2,:)-STEP
  CASE (ID_RIGHT,ID_FASTRIGHT,ID_TOTALRIGHT)
   IF(IDIR.EQ.1.AND.MAXVAL(XY(1,1:NXY))+STEP.LE.PMX)XY(1,:)=XY(1,:)+STEP
   IF(IDIR.EQ.2.AND.MAXVAL(XY(2,1:NXY))+STEP.LE.PMX)XY(2,:)=XY(2,:)+STEP

 END SELECT

 CALL PROFILE_COMPUTEPLOT()
 CALL PROFILE_IDFMINMAX()
 CALL PROFILE_PLOT()
 XPOSPROF=0.0D0
 CALL PROFILE_CLEAR()
 CALL WDIALOGSELECT(ID_DSERIESMOVIE)

 END SUBROUTINE PROFILE_PROFWALK

 !###======================================================================
 SUBROUTINE PROFILE_PLOT(LPS)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,OPTIONAL :: LPS
 REAL(KIND=DP_KIND) :: XINT,YINT,DX,DY,Y,XSCALE
 INTEGER :: ILEGEND,IWINID,ISCALE

 !## ngraphs/screens depends on selection ...
 CALL PROFILE_PLOT_NSCREEN()

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,AXES%IFIXX)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,AXES%IFIXY)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK4,ILEGEND)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK9,ISCALE)
 CALL WDIALOGGETDOUBLE(IDF_REAL10,XSCALE)
 IF(XSCALE.LE.0.0D0)THEN; XSCALE=1.0D0; CALL WDIALOGPUTDOUBLE(IDF_REAL10,XSCALE); ENDIF
 
 XINT=1.0D0
 IF(AXES%IFIXX.EQ.1)THEN
  CALL WDIALOGGETDOUBLE(IDF_REAL7,XMIN)
  CALL WDIALOGGETDOUBLE(IDF_REAL8,XMAX)
  CALL WDIALOGGETDOUBLE(IDF_REAL6,XINT)
 ENDIF
 YINT=1.0D0
 IF(AXES%IFIXY.EQ.1)THEN
  CALL WDIALOGGETDOUBLE(IDF_REAL3,YMIN)
  CALL WDIALOGGETDOUBLE(IDF_REAL4,YMAX)
  CALL WDIALOGGETDOUBLE(IDF_REAL5,YINT)
 ENDIF
 
 CALL IGRCOLOURN(WRGB(255,255,255))

 !## plot axis and correct xmin,ymin,xmax,ymax for axes
 IF(XMAX.LE.XMIN)XMAX=XMIN+1.0D0
 IF(YMAX.LE.YMIN)THEN
  YMAX=YMIN+5000.0D0
  YMIN=YMIN-5000.0D0
 ENDIF

 AXES%XMIN =XMIN
 AXES%XMAX =XMAX
 AXES%YMIN =YMIN
 AXES%YMAX =YMAX

 IF(ISCALE.EQ.1)THEN
  !## do something with scales - adjust y
  DX=       AXES%XMAX-AXES%XMIN
  Y =0.5D0*(AXES%YMAX+AXES%YMIN)
  DY=DX/XSCALE
  AXES%YMAX=Y+DY
  AXES%YMIN=Y-DY
 ENDIF
 
 AXES%XINT =XINT
 AXES%YINT =YINT
 AXES%ICLRRASTER=ICLRRASTER
 AXES%XFACTOR=1.0D0 
 AXES%YFACTOR=1.0D0
 !## 1.0D0/factor is ratio of screen to be used for margins
 AXES%DXAXESL=40.0D0  !## left
 AXES%DYAXESB=20.0D0 !/REAL(NGRAPH)  !## bottom
 AXES%DYAXEST=75.0D0  !## top
 AXES%DXAXESR=150.0D0 !## right
 AXES%TFONT=FFHELVETICA   !## text-font
 AXES%IAXES=(/1,0/)   !## left/bottom axes only
 AXES%XTITLE='Profile Distance (meters)'
 AXES%YTITLE=''
 AXES%LDATE=.FALSE.

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 IF(AXES%IFIXX.EQ.0)THEN
  CALL WDIALOGPUTDOUBLE(IDF_REAL7,XMIN)
  CALL WDIALOGPUTDOUBLE(IDF_REAL8,XMAX)
  CALL WDIALOGPUTDOUBLE(IDF_REAL6,AXES%XINT)
 ENDIF
 IF(AXES%IFIXY.EQ.0)THEN
  CALL WDIALOGPUTDOUBLE(IDF_REAL3,YMIN)
  CALL WDIALOGPUTDOUBLE(IDF_REAL4,YMAX)
  CALL WDIALOGPUTDOUBLE(IDF_REAL5,AXES%YINT)
 ENDIF

 DO IWINID=1,SIZE(IWINPROFILE)

  IF(PRESENT(LPS))THEN
   !## select proper window for postscript
   IF(LPS)     CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
   IF(.NOT.LPS)CALL IGRSELECT(DRAWBITMAP,PRF_IBITMAP(IWINID))
  ELSE
   !## select proper bitmap
   CALL IGRSELECT(DRAWBITMAP,PRF_IBITMAP(IWINID))
  ENDIF
  !## change plotmode
  CALL IGRPLOTMODE(MODECOPY)

  CALL DBL_IGRAREA(GRAPHAREA(1,IWINID),GRAPHAREA(2,IWINID),GRAPHAREA(3,IWINID),GRAPHAREA(4,IWINID))
  AXES%ICLRBACKGROUND=WRGB(123,152,168)

  !## plot/define axes
  CALL GRAPH_PLOTAXES(AXES,IWINID) 
  
  !## put bitmap of background bitmap
  IF(PBITMAP%IACT.GT.0)THEN
   CALL WBITMAPPUT(PBITMAP%IBITMAP,1,1,PBITMAP%IX1,PBITMAP%IY1,PBITMAP%IX2,PBITMAP%IY2)
  ENDIF
  
  !## draw profile obtained by IDF's
  IF(MXNIDF.GT.0)CALL PROFILE_BITMAPIDF(IWINID)
  !## draw imod flowline-file by IFF's
  IF(MXNIFF.GT.0)CALL PROFILE_BITMAPIFF()
  !## draw imod point-file by IPF's
  IF(NIPF.GT.0)CALL PROFILE_BITMAPIPF(IWINID)
  !## plot knickpoints
  CALL PROFILE_PLOT_KNICKPOINTS()
  !## plot legend
  IF(ILEGEND.EQ.1)CALL PROFILE_PLOT_LEGEND(IWINID)
  !## plot coordinates of profile
  CALL PROFILE_PLOTCOORDINATES()
  !## plot 2d plot of selected layer
  IF(PRESENT(LPS))THEN
   CALL PROFILE_PLOT_2DIDF(LPS)
  ELSE
   CALL PROFILE_PLOT_2DIDF(.TRUE.)
  ENDIF

  !## plot cross-sections (if isolid.eq.1)
  !## solid-modeling not activated
  IF(ISOLID.NE.0)THEN
   IF(ALLOCATED(SPF).AND.ISPF.GT.0)THEN
    CALL SOLID_PROFILEDRAW(1,SIZE(SPF(ISPF)%PROF),0,0,IWINID) !## 0 means all
   ENDIF
   !## plot intersections by others
   CALL SOLID_PROFILEDRAW_INTERSECTIONS(IWINID)
  ENDIF

 ENDDO  !##SIZE(IWINPROFILE)=NSCREEN

 !## plot survey, RELATIVE to entire bitmap
 IF(PRESENT(LPS))THEN
  CALL PROFILE_PLOTSURVEY(LPS)
 ELSE
  CALL PROFILE_PLOTSURVEY(.FALSE.)
 ENDIF
 
 IF(ISOLID.NE.0)THEN
  !## plot extend of masks
  CALL SOLID_PROFILEDRAW_MASK()  
  !## plot extend of polygon(s)
  CALL SOLID_PROFILEDRAW_POLYGON()  
 ENDIF

 IF(PRESENT(LPS))THEN
  IF(LPS)RETURN
 ENDIF
 
 !## draw all bitmaps
 DO IWINID=1,SIZE(IWINPROFILE)
  !## putbitmap on entire screen or ratio
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  CALL WBITMAPPUT(PRF_IBITMAP(IWINID),0,1)   
 ENDDO
 
 END SUBROUTINE PROFILE_PLOT

 !###======================================================================
 SUBROUTINE PROFILE_PLOT_2DIDF(LPS)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LPS
 INTEGER :: I,J,IPLOT,II
 REAL(KIND=DP_KIND) :: XMIN_ORG,YMIN_ORG,XMAX_ORG,YMAX_ORG,XA1,YA1,XA2,YA2,RD,DX,DY

 !## split window?
 
 !## plot profile with ipf's
    !## draw line of the profile
   CALL IGRCOLOURN(WRGB(0,0,0))
   IF(.NOT.LPS)THEN
    DO J=2,NXY
     CALL IGRLINEWIDTH(LINEWIDTHPLOT)
     CALL IGRCOLOURN(LINECOLORPLOT)
     CALL DBL_IGRJOIN(XY(1,J-1),XY(2,J-1),XY(1,J),XY(2,J))
     CALL PROFILE_PLOTVIEWBOX(XY(1,J-1),XY(2,J-1),XY(1,J),XY(2,J))
    END DO
   ENDIF
 
 !## plot selected idf's
 IF(NPIPET.EQ.0)RETURN 
 !## do not refresh if profile is moving
 IF(LMOVEPROF)RETURN

 CALL UTL_MESSAGEHANDLE(0)

 CALL WINDOWSELECT(0)

 DO II=1,SIZE(PRF_IBITMAP)
 
  CALL IGRSELECT(DRAWBITMAP,PRF_IBITMAP(II))
  CALL IGRPLOTMODE(MODECOPY)

  RD=REAL(WINFODRAWABLE(DRAWABLEWIDTH))/REAL(WINFODRAWABLE(DRAWABLEHEIGHT))

  DO I=1,SIZE(IPIPET)
   IPLOT=IPIPET(I)

   XA1=GRAPHAREA(3,1)
   YA1=REAL(I-1)*1.0D0/REAL(SIZE(IPIPET))
   XA2=1.0D0
   YA2=REAL(I)*1.0D0/REAL(SIZE(IPIPET))
   CALL DBL_IGRAREA(XA1,YA1,XA2,YA2)
   CALL IGRAREACLEAR()

   !## copy of original mpw%-coordinates
   XMIN_ORG=MPW%XMIN
   YMIN_ORG=MPW%YMIN
   XMAX_ORG=MPW%XMAX
   YMAX_ORG=MPW%YMAX

   MPW%XMIN=MINVAL(XY(1,1:NXY))
   MPW%XMAX=MAXVAL(XY(1,1:NXY))
   MPW%YMIN=MINVAL(XY(2,1:NXY))
   MPW%YMAX=MAXVAL(XY(2,1:NXY))
   DX=(MPW%XMAX-MPW%XMIN)/25.0
   DY=(MPW%YMAX-MPW%YMIN)/25.0
   MPW%XMIN=MPW%XMIN-(MAX(DX,DY))
   MPW%XMAX=MPW%XMAX+(MAX(DX,DY))
   MPW%YMIN=MPW%YMIN-(MAX(DX,DY))
   MPW%YMAX=MPW%YMAX+(MAX(DX,DY))

   CALL UTL_IDFCRDCOR(MPW%XMIN,MPW%XMAX,MPW%YMIN,MPW%YMAX,RD*(XA2-XA1),YA2-YA1)
   CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)

   IF(IDFDRAW(PROFIDF(IPLOT)%IDF,PROFIDF(IPLOT)%LEG,PROFIDF(IPLOT)%UNITS,(/0,0,0,0/), &
       MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,1,.TRUE.))THEN
    CALL DBL_IGRAREA(XA1,YA1,XA2,YA2)
    CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)
    CALL IDFPLOT_FEATURES()
   ENDIF

   !## draw line of the profile...
   CALL IGRCOLOURN(WRGB(0,0,0))
   IF(.NOT.LPS)THEN
    DO J=2,NXY
     CALL IGRLINEWIDTH(LINEWIDTHPLOT)
     CALL IGRCOLOURN(LINECOLORPLOT)
     CALL DBL_IGRJOIN(XY(1,J-1),XY(2,J-1),XY(1,J),XY(2,J))
     CALL PROFILE_PLOTVIEWBOX(XY(1,J-1),XY(2,J-1),XY(1,J),XY(2,J))
    END DO
   ENDIF
   CALL IGRLINEWIDTH(1)

   MPW%XMIN=XMIN_ORG
   MPW%YMIN=YMIN_ORG
   MPW%XMAX=XMAX_ORG
   MPW%YMAX=YMAX_ORG
  ENDDO
 END DO

 CALL UTL_MESSAGEHANDLE(1)

 END SUBROUTINE PROFILE_PLOT_2DIDF

 !###======================================================================
 SUBROUTINE PROFILE_PLOT_NSCREEN()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XTMP
 INTEGER :: I,J

 IF(MXNIDF+NIPF+MXNIFF.EQ.0)THEN; NSCREEN=1; RETURN; ENDIF
 
 ALLOCATE(XTMP(MXNIDF+ABS(NIPF)+ABS(MXNIFF)))

 XTMP=-1.0D0; J=0
 DO I=1,MXNIDF
  J=J+1
  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
  !## activated
  IF(IPRF(1).EQ.1)THEN
   XTMP(I)=REAL(PROFIDF(I)%ISCREEN)
  ENDIF
 ENDDO
 DO I=1,ABS(NIPF);   J=J+1; XTMP(J)=REAL(MP(MPLOT(I))%ISCREEN); ENDDO
 DO I=1,ABS(MXNIFF); J=J+1; XTMP(J)=REAL(MP(KPLOT(I))%ISCREEN); ENDDO

 CALL UTL_GETUNIQUE(XTMP,SIZE(XTMP),NSCREEN,NODATA=-1.0D0) !-1.0D0)
 
 !## recompute igraphs
 DO I=1,MXNIDF; DO J=1,NSCREEN
  IF(PROFIDF(I)%ISCREEN.EQ.INT(XTMP(J)).AND.PROFIDF(I)%ISCREEN.NE.0)THEN; PROFIDF(I)%ISCREEN=J; EXIT; ENDIF
 ENDDO; ENDDO
 DO I=1,ABS(NIPF); DO J=1,NSCREEN
  IF(MP(MPLOT(I))%ISCREEN.EQ.INT(XTMP(J)).AND.MP(MPLOT(I))%ISCREEN.NE.0)THEN; MP(MPLOT(I))%ISCREEN=J; EXIT; ENDIF
 ENDDO; ENDDO
 DO I=1,ABS(MXNIFF); DO J=1,NSCREEN
  IF(MP(KPLOT(I))%ISCREEN.EQ.INT(XTMP(J)).AND.MP(KPLOT(I))%ISCREEN.NE.0)THEN; MP(KPLOT(I))%ISCREEN=J; EXIT; ENDIF
 ENDDO; ENDDO

 DEALLOCATE(XTMP)

 END SUBROUTINE PROFILE_PLOT_NSCREEN

 !###======================================================================
 SUBROUTINE PROFILE_PLOT_LEGEND(IWINID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWINID
 INTEGER :: I,J,IWD,IWS,ILEG
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2,XT,YT,CHH,DY,Y,OFFX,BOXX,DX,SX_RATIO,Z1,Z2
 
 !## drawable settings !## screen setting   !## ratio's
 IWD=WINFODRAWABLE(DRAWABLEWIDTH); IWS=WINFOSCREEN(SCREENWIDTH); SX_RATIO=REAL(IWS)/REAL(IWD)

 !## get current graph-dimensions
 X1 =INFOGRAPHICS(GRAPHICSUNITMINX)
 X2 =INFOGRAPHICS(GRAPHICSUNITMAXX)
 Y1 =INFOGRAPHICS(GRAPHICSUNITMINY)
 Y2 =INFOGRAPHICS(GRAPHICSUNITMAXY)

 CALL DBL_WGRTEXTFONT(IFAMILY=AXES%TFONT,TWIDTH=AXES%CHW,THEIGHT=AXES%CHH,ISTYLE=0)
 !## get current textsizes
 CHH=AXES%CHH
 DY =(Y2-Y1)*CHH 
 !## define x-size
 DX=X2-X1
 OFFX=(DX/250.0D0)*SX_RATIO
 BOXX=OFFX*4.0

 CALL DBL_WGRTEXTORIENTATION(ALIGNLEFT,ANGLE=0.0D0)
 CALL IGRFILLPATTERN(SOLID)

 Y =YMAX+0.5*DY
 DO I=1,MXNIDF

  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
  !## activated and plot legend switch on
  IF(IPRF(1).EQ.1.AND.IPRF(7).EQ.1.AND. &
    (PROFIDF(I)%ISCREEN.EQ.IWINID.OR.PROFIDF(I)%ISCREEN.EQ.0))THEN
    
   Z1=MINVAL(SERIE(I)%Y(1:SERIE(I)%N)); Z2=MAXVAL(SERIE(I)%Y(1:SERIE(I)%N))   
   IF(SERIE(I)%N.GT.0.AND. &
     (Z1.NE.PROFIDF(I)%IDF%NODATA.OR.Z2.NE.PROFIDF(I)%IDF%NODATA))THEN

    Y=Y-DY

    X1=XMIN+OFFX;            Y1=Y-DY+0.1*DY
    X2=XMIN+OFFX+BOXX;       Y2=Y-0.1*DY
    XT=XMIN+(2.0*OFFX)+BOXX; YT=Y-0.5*DY
    IF(IPRF(2).EQ.1)THEN
     CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,PROFIDF(I)%SCOLOR,1,0,1) !## OUTLINE
     CALL IGRCOLOURN(WRGB(0,0,0)); CALL DBL_WGRTEXTSTRING(XT,YT,TRIM(PROFIDF(I)%ALIAS))
    ELSEIF(IPRF(3).EQ.1)THEN
     CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,PROFIDF(I)%SCOLOR,1,0,2) !## DOTS
     CALL IGRCOLOURN(WRGB(0,0,0)); CALL DBL_WGRTEXTSTRING(XT,YT,TRIM(PROFIDF(I)%ALIAS))
    ELSEIF(IPRF(4).EQ.1)THEN
     CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,PROFIDF(I)%SCOLOR,1,0,0) !## SOLID
     CALL IGRCOLOURN(WRGB(0,0,0)); CALL DBL_WGRTEXTSTRING(XT,YT,TRIM(PROFIDF(I)%ALIAS))
    ELSEIF(IPRF(5).EQ.1)THEN
     CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,PROFIDF(I)%SCOLOR,1,0,3,LEG=PROFIDF(I)%LEG,XT=XT) !## FILLEDIN
     Y=(Y1-(DY*0.1))+DY
    ELSEIF(PROFIDF(I)%IDF%ITB.EQ.1)THEN
     CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,PROFIDF(I)%SCOLOR,1,0,3,LEG=PROFIDF(I)%LEG,XT=XT) !## FILLEDIN
     Y=(Y1-(DY*0.1))+DY
    ENDIF
    
   ENDIF
  ENDIF

 ENDDO

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB5)
 DO I=1,NIPF

  IF(MP(MPLOT(I))%ISCREEN.EQ.IWINID.OR.MP(MPLOT(I))%ISCREEN.EQ.0)THEN
 
   CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,6,I,J)
   IF(J.EQ.0)CYCLE
   
   ILEG=MP(MPLOT(I))%ILEGDLF
   
   DO J=1,NLITHO(ILEG)

    Y=Y-DY

    X1=XMIN+OFFX;              Y1=Y-DY+0.1D0*DY
    X2=XMIN+OFFX+BOXX;         Y2=Y-0.1D0*DY
    XT=XMIN+(2.0D0*OFFX)+BOXX; YT=Y-0.5D0*DY

    CALL UTL_DRAWLEGENDBOX(X1,Y1,X2,Y2,BH(ILEG,J)%LITHOCLR,1,0,0) !## SOLID
    CALL IGRCOLOURN(WRGB(0,0,0)); CALL DBL_WGRTEXTSTRING(XT,YT,TRIM(BH(ILEG,J)%LITHOTXT))  

   ENDDO

  ENDIF
 ENDDO
 
 END SUBROUTINE PROFILE_PLOT_LEGEND

 !###======================================================================
 SUBROUTINE PROFILE_PLOT_KNICKPOINTS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 REAL(KIND=DP_KIND) :: DX

 IF(NXY.EQ.0)RETURN

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB2)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,J)

 !## plot 'knick'-points
 CALL IGRLINETYPE(SOLIDLINE); CALL IGRLINEWIDTH(1)
 CALL IGRCOLOURN(ICLRKNIKCP); CALL IGRLINETYPE(DASHED)

 DX=0.0D0
 DO I=1,NXY 
  
  IF(I.EQ.1)THEN
   DX=0.0D0
  ELSE
   DX=DX+SQRT((XY(1,I)-XY(1,I-1))**2.0D0+(XY(2,I)-XY(2,I-1))**2.0D0)
  ENDIF
  
  IF(J.EQ.1.AND.TRIM(XYLABEL(I)).EQ.'')CYCLE
  CALL DBL_IGRJOIN(DX,YMIN,DX,YMAX)
 
 ENDDO
 CALL IGRLINETYPE(SOLIDLINE)

 END SUBROUTINE PROFILE_PLOT_KNICKPOINTS

 !###======================================================================
 SUBROUTINE PROFILE_BITMAPIDF(IWINID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWINID
 INTEGER :: IIDF,I,J,ICLR
 LOGICAL :: LEX
 REAL(KIND=DP_KIND) :: RADX,Y,Z,Z1,Z2,X1,X2,X3,X4,Y1,Y2,Y3,Y4,XX1,XX2,YY1,YY2

 IF(MXNIDF.LE.0)RETURN

 CALL IGRLINETYPE(SOLIDLINE)
 CALL IGRFILLPATTERN(SOLID)
 CALL IGRLINEWIDTH(LINETHICKNESS)
 
 RADX=(XMAX-XMIN)/500.0D0
 
 DO IIDF=1,MXNIDF

  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(IIDF)%PRFTYPE)
  IF(IPRF(1).EQ.0.OR. &
    (IWINID.NE.PROFIDF(IIDF)%ISCREEN.AND.PROFIDF(IIDF)%ISCREEN.NE.0))CYCLE
  
  !## normal cross-section
  IF(PROFIDF(IIDF)%IDF%ITB.EQ.0)THEN

   !## overrule (temporary) profile-settings for colouring
   IPRF(5)=MAX(0,IPRF(5),IPRF(6))
   !## correct whenever coloring is done for the first or last one
   IF(IIDF.EQ.1.OR.IIDF.EQ.MXNIDF)THEN
    IPRF(5)=0; IPRF(6)=0
   ENDIF

   !## colouring
   IF(IPRF(5).EQ.1)THEN
    
    !## lines
    IF(IBLOCKFILLS.EQ.0)THEN

     DO I=2,SERIE(IIDF)%N 

      IF(SERIE(IIDF-1)%Y(I-1).NE.PROFIDF(IIDF-1)%IDF%NODATA.AND. &
         SERIE(IIDF-1)%Y(I)  .NE.PROFIDF(IIDF-1)%IDF%NODATA.AND. &
         SERIE(IIDF+1)%Y(I-1).NE.PROFIDF(IIDF+1)%IDF%NODATA.AND. &
         SERIE(IIDF+1)%Y(I)  .NE.PROFIDF(IIDF+1)%IDF%NODATA.AND. &
        (SERIE(IIDF  )%Y(I-1).NE.PROFIDF(IIDF)%IDF%NODATA.OR. &
         SERIE(IIDF  )%Y(I)  .NE.PROFIDF(IIDF)%IDF%NODATA))THEN

       X1=SERIE(IIDF-1)%X(I-1)
       X2=SERIE(IIDF-1)%X(I  )
       X3=SERIE(IIDF+1)%X(I  )
       X4=SERIE(IIDF+1)%X(I-1)

       Y1=SERIE(IIDF-1)%Y(I-1)
       Y2=SERIE(IIDF-1)%Y(I  )
       Y3=SERIE(IIDF+1)%Y(I  )
       Y4=SERIE(IIDF+1)%Y(I-1)

       Z1=SERIE(IIDF)%Y(I-1)
       Z2=SERIE(IIDF)%Y(I  )

       IF(Z1.NE.PROFIDF(IIDF)%IDF%NODATA.AND.Z2.NE.PROFIDF(IIDF)%IDF%NODATA)THEN
        !## split
        IF(Z1.NE.Z2)THEN
         YY1=0.5*(Y1+Y2)
         YY2=0.5*(Y3+Y4)
         XX1=0.5*(X1+X2)
         XX2=0.5*(X3+X4)
         !## devide by thickness if iprf(6).eq.1
         Z=Z1
         Y=PROFILE_BITMAPIDF_CLR_Y(Z1,Z,Z2,IPRF(6))
         !## get colour of serie()%y()
         ICLR=UTL_IDFGETCLASS(PROFIDF(IIDF)%LEG,Y); CALL IGRCOLOURN(ICLR)
         CALL DBL_IGRPOLYGONCOMPLEX((/X1,XX2,XX2,X4/),(/Y1,YY1,YY2,Y4/),4)
         Z =Z2
         X1=XX1
         X4=XX1
         Y1=YY1
         Y4=YY2
        ELSE
         Z =Z1
        ENDIF               
       ELSEIF(Z1.EQ.PROFIDF(IIDF)%IDF%NODATA)THEN
        X1=X1+(X2-X1)/2.0
        X4=X4+(X4-X3)/2.0
        Z =Z2
       ELSE
        X2=X2-(X2-X1)/2.0
        X3=X3-(X3-X4)/2.0
        Z =Z1
       ENDIF

       !## devide by thickness if iprf(6).eq.1
       Y=PROFILE_BITMAPIDF_CLR_Y(Z1,Z,Z2,IPRF(6))
       !## get colour of serie()%y()
       ICLR=UTL_IDFGETCLASS(PROFIDF(IIDF)%LEG,Y); CALL IGRCOLOURN(ICLR)
       CALL DBL_IGRPOLYGONCOMPLEX((/X1,X2,X3,X4/),(/Y1,Y2,Y3,Y4/),4)
!        CALL DBL_IGRPOLYGONCOMPLEX((/SERIE(IIDF-1)%X(I-1),SERIE(IIDF-1)%X(I),SERIE(IIDF+1)%X(I),SERIE(IIDF+1)%X(I-1)/), &
!                               (/SERIE(IIDF-1)%Y(I-1),SERIE(IIDF-1)%Y(I),SERIE(IIDF+1)%Y(I),SERIE(IIDF+1)%Y(I-1)/),4)

      ENDIF
     ENDDO
    
    !## blockfills
    ELSE

     DO I=1,SERIE(IIDF)%N     
      IF(SERIE(IIDF-1)%Y(I).NE.PROFIDF(IIDF-1)%IDF%NODATA.AND. &
         SERIE(IIDF+1)%Y(I).NE.PROFIDF(IIDF+1)%IDF%NODATA.AND. &
         SERIE(IIDF  )%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN

       Y=PROFILE_BITMAPIDF_CLR_Y(SERIE(IIDF-1)%Y(I),SERIE(IIDF)%Y(I),SERIE(IIDF+1)%Y(I),IPRF(6))
       !## get colour of serie()%y()
       ICLR=UTL_IDFGETCLASS(PROFIDF(IIDF)%LEG,Y); CALL IGRCOLOURN(ICLR)
       
       !## skip equal dy
       IF(SERIE(IIDF-1)%Y(I).NE.SERIE(IIDF+1)%Y(I))THEN
            
        !## start rectangle
        X1=SERIE(IIDF-1)%X(I)
        IF(I.GT.1)THEN
         IF(SERIE(IIDF-1)%Y(I-1).NE.PROFIDF(IIDF-1)%IDF%NODATA)THEN
          X1=(SERIE(IIDF-1)%X(I-1)+SERIE(IIDF-1)%X(I))/2.0
         ENDIF
        ENDIF
        !## end rectangle
        X2=SERIE(IIDF-1)%X(I)
        IF(I.LT.SERIE(IIDF)%N)THEN   
         IF(SERIE(IIDF-1)%Y(I+1).NE.PROFIDF(IIDF-1)%IDF%NODATA)THEN
          X2=(SERIE(IIDF-1)%X(I)+SERIE(IIDF-1)%X(I+1))/2.0
         ENDIF
        ENDIF     

        IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,SERIE(IIDF-1)%Y(I),X2,SERIE(IIDF+1)%Y(I))
       
       ENDIF
       
      ELSE
       J=0
      ENDIF
     ENDDO
    
    ENDIF
   ENDIF 
  
  !## filled cross-section
  ELSEIF(PROFIDF(IIDF)%IDF%ITB.EQ.1)THEN

   !## skip equal top/bot
   IF(PROFIDF(IIDF)%IDF%TOP.NE.PROFIDF(IIDF)%IDF%BOT)THEN

    !## obsolute
    DO I=1,SERIE(IIDF)%N 
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      ICLR=UTL_IDFGETCLASS(PROFIDF(IIDF)%LEG,SERIE(IIDF)%Y(I))
      !## skip white-colour
      IF(ICLR.EQ.WRGB(255,255,255))CYCLE
      CALL IGRCOLOURN(ICLR)
      IF(I.EQ.1)THEN
       X1= SERIE(IIDF)%X(I)
       X2=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I+1))/2.0
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,PROFIDF(IIDF)%IDF%BOT,X2,PROFIDF(IIDF)%IDF%TOP)   
      ELSEIF(I.EQ.SERIE(IIDF)%N)THEN 
       X1=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0
       X2= SERIE(IIDF)%X(I)
       IF(SERIE(IIDF)%X(I).EQ.SERIE(IIDF)%X(I-1))SERIE(IIDF)%X(I-1)=SERIE(IIDF)%X(I-1)-1
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,PROFIDF(IIDF)%IDF%BOT,X2,PROFIDF(IIDF)%IDF%TOP)   
      ELSE
       X1=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0
       X2=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I+1))/2.0
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,PROFIDF(IIDF)%IDF%BOT,X2,PROFIDF(IIDF)%IDF%TOP)
      ENDIF
     ENDIF
    ENDDO
   
   ENDIF
   
  ENDIF
 
 ENDDO

 DO IIDF=1,MXNIDF

  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(IIDF)%PRFTYPE)
  IF(IPRF(1).EQ.0.OR. &
    (IWINID.NE.PROFIDF(IIDF)%ISCREEN.AND.PROFIDF(IIDF)%ISCREEN.NE.0))CYCLE

  !## normal cross-section
  IF(PROFIDF(IIDF)%IDF%ITB.NE.0)CYCLE

  CALL IGRCOLOURN(PROFIDF(IIDF)%SCOLOR)

  !## lines
  IF(IPRF(2).EQ.1)THEN
   !## lines from centre
   IF(IBLOCKLINES.EQ.0)THEN
    LEX=.TRUE.
    DO I=1,SERIE(IIDF)%N
     IF(SERIE(IIDF)%Y(I).EQ.PROFIDF(IIDF)%IDF%NODATA)LEX=.TRUE.
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      IF(LEX)THEN
       CALL DBL_IGRMOVETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I)); LEX=.FALSE.
      ELSE
       CALL DBL_IGRLINETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I))
      ENDIF
     ENDIF
    ENDDO
   !## blocklines
   ELSE
    LEX=.TRUE.; J=0
    DO I=1,SERIE(IIDF)%N 
     IF(SERIE(IIDF)%Y(I).EQ.PROFIDF(IIDF)%IDF%NODATA)LEX=.TRUE.
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      J=J+1
      IF(LEX)THEN
       CALL DBL_IGRMOVETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I)); LEX=.FALSE.
      ELSE
       CALL DBL_IGRLINETO((SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0,SERIE(IIDF)%Y(I-1))
       CALL DBL_IGRLINETO((SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0,SERIE(IIDF)%Y(I))
      ENDIF
     ELSE
      IF(J.GT.1)CALL DBL_IGRLINETO(SERIE(IIDF)%X(I-1),SERIE(IIDF)%Y(I-1)); J=0
     ENDIF
    ENDDO
   ENDIF

  ENDIF
  
  !## dots
  IF(IPRF(3).EQ.1)THEN
   DO I=1,SERIE(IIDF)%N
    IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)CALL DBL_IGRCIRCLE(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I),RADX)
   ENDDO
  ENDIF

  !## fills
  IF(IPRF(4).EQ.1)THEN

   IF(IBLOCKFILLS.EQ.0)THEN
    J=0
    DO I=1,SERIE(IIDF)%N 
     IF(SERIE(IIDF)%Y(I).EQ.PROFIDF(IIDF)%IDF%NODATA)J=0
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      J=J+1
      IF(J.GE.2)THEN
       CALL DBL_IGRPOLYGONCOMPLEX((/SERIE(IIDF)%X(I-1),SERIE(IIDF)%X(I),SERIE(IIDF)%X(I),SERIE(IIDF)%X(I-1)/), &
                              (/SERIE(IIDF)%Y(I-1),SERIE(IIDF)%Y(I),YMIN            ,YMIN/),4)
      ENDIF
     ENDIF
    ENDDO
   
   ELSE
    CALL UTL_DEBUGLEVEL(0)
    DO I=1,SERIE(IIDF)%N 
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      IF(I.EQ.1)THEN
       X1= SERIE(IIDF)%X(I)
       X2=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I+1))/2.0
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,YMIN,X2,SERIE(IIDF)%Y(I))   
      ELSEIF(I.EQ.SERIE(IIDF)%N)THEN 
       X1=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0
       X2= SERIE(IIDF)%X(I)
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,YMIN,X2,SERIE(IIDF)%Y(I))   
      ELSE
       X1=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0
       X2=(SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I+1))/2.0
       IF(X1.NE.X2)CALL DBL_IGRRECTANGLE(X1,YMIN,X2,SERIE(IIDF)%Y(I))
      ENDIF
     ENDIF
    ENDDO
    CALL UTL_DEBUGLEVEL(1)
   ENDIF
  ENDIF
  
  !## plot black lines on top of profile
  IF(ILINEBLACK.EQ.1)THEN
   CALL IGRCOLOURN(WRGB(0,0,0))
  ELSE
   CALL IGRCOLOURN(PROFIDF(IIDF)%SCOLOR)
  ENDIF

  !## lines
  IF(IPRF(2).EQ.1.OR.ILINEBLACK.EQ.1.AND. &
     IPRF(5).NE.1)THEN   !## cannot be used for idf files applied as colouring
   !## lines from centre
   IF(IBLOCKLINES.EQ.0)THEN
    LEX=.TRUE.
    DO I=1,SERIE(IIDF)%N
     IF(SERIE(IIDF)%Y(I).EQ.PROFIDF(IIDF)%IDF%NODATA)LEX=.TRUE.
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      IF(LEX)THEN
       CALL DBL_IGRMOVETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I)); LEX=.FALSE.
      ELSE
       CALL DBL_IGRLINETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I))
      ENDIF
     ENDIF
    ENDDO
   !## blocklines
   ELSE
    LEX=.TRUE.; J=0
    DO I=1,SERIE(IIDF)%N 
     IF(SERIE(IIDF)%Y(I).EQ.PROFIDF(IIDF)%IDF%NODATA)LEX=.TRUE.
     IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
      J=J+1
      IF(LEX)THEN
       CALL DBL_IGRMOVETO(SERIE(IIDF)%X(I),SERIE(IIDF)%Y(I)); LEX=.FALSE.
      ELSE
       CALL DBL_IGRLINETO((SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0,SERIE(IIDF)%Y(I-1))
       CALL DBL_IGRLINETO((SERIE(IIDF)%X(I)+SERIE(IIDF)%X(I-1))/2.0,SERIE(IIDF)%Y(I))
      ENDIF
     ELSE
      IF(J.GT.1)CALL DBL_IGRLINETO(SERIE(IIDF)%X(I-1),SERIE(IIDF)%Y(I-1)); J=0
     ENDIF
    ENDDO
   ENDIF
  ENDIF
  
 ENDDO

 CALL IGRLINEWIDTH(1)
 
 END SUBROUTINE PROFILE_BITMAPIDF

 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION PROFILE_BITMAPIDF_CLR_Y(Z1,X,Z2,IP)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: Z1,Z2,X
 INTEGER,INTENT(IN) :: IP
 REAL(KIND=DP_KIND) :: D
 
 PROFILE_BITMAPIDF_CLR_Y=X
 IF(IP.EQ.1)THEN
  D=Z1-Z2
  IF(D.LE.0.0D0)THEN; PROFILE_BITMAPIDF_CLR_Y=0.0D0; ELSE; PROFILE_BITMAPIDF_CLR_Y=X/D; ENDIF
 ENDIF    
 
 END FUNCTION PROFILE_BITMAPIDF_CLR_Y

 !###======================================================================
 SUBROUTINE PROFILE_BITMAPIFF()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 REAL(KIND=DP_KIND) :: ZMIN,ZMAX,DX,DXY
 REAL(KIND=DP_KIND) :: XMN,YMN,XMX,YMX
 REAL(KIND=DP_KIND),DIMENSION(4,2) :: XYPOL

 IF(MXNIFF.LE.0)RETURN

 CALL IGRLINETYPE(SOLIDLINE)
 CALL IGRFILLPATTERN(SOLID)
 CALL IGRCOLOURN(WRGB(0,0,0))

 ZMIN=YMIN
 ZMAX=YMAX

 !## lines
 DO I=1,MXNIFF
  IF(KU(I).GT.0)THEN
   IF(MP(KPLOT(I))%PRFTYPE.GT.0)THEN
    DX=0.0D0
    DO J=1,NXY-1

     CALL UTL_PROFILE_GETVIEWBOX(XY(1,J),XY(2,J),XY(1,J+1),XY(2,J+1),XSIGHT,XYPOL,XMN,YMN,XMX,YMX)

     !## compute offset
     IF(J.GT.1)THEN
      DXY=(XY(1,J-1)-XY(1,J))**2.0D0+(XY(2,J-1)-XY(2,J))**2.0D0
      IF(DXY.GT.0.0D0)DX=DX+SQRT(DXY)
     ENDIF
     !## determine for each line-segment what to draw!
     REWIND(KU(I))
     CALL IFFPLOT(KU(I),XMN,XMX,YMN,YMX,KPLOT(I),XY(:,J:J+1),DX)
    END DO
   ENDIF
  ENDIF
 ENDDO

 END SUBROUTINE PROFILE_BITMAPIFF

 !###======================================================================
 SUBROUTINE PROFILE_BITMAPIPF(IWINID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWINID
 INTEGER :: I,J,NB,IB,ITX,IIPF
 REAL(KIND=DP_KIND) :: DX,DXY,X1,X2,XMN,YMN,XMX,YMX,DXX
 REAL(KIND=DP_KIND),DIMENSION(:,:),ALLOCATABLE :: IDIPF
 REAL(KIND=DP_KIND),PARAMETER :: MDX=2.0 
 REAL(KIND=DP_KIND),DIMENSION(4,2) :: XYPOL
 
 CALL IGRLINETYPE(SOLIDLINE); CALL IGRFILLPATTERN(SOLID); CALL IGRCOLOURN(WRGB(0,0,0))

 DO IIPF=1,NIPF
  !## if plot associated files activated ... turn them on ALL!
  IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.1.AND.MP(MPLOT(IIPF))%UNITS.EQ.1)IPF(IIPF)%IP=INT(4,1)
 ENDDO

 DO IIPF=1,NIPF; IPF(IIPF)%IPOS=INT(0,1); ENDDO

 DX=0.0D0
 DO I=1,NXY-1

  CALL UTL_PROFILE_GETVIEWBOX(XY(1,I),XY(2,I),XY(1,I+1),XY(2,I+1),XSIGHT,XYPOL,XMN,YMN,XMX,YMX)

  !## compute offset computed from the beginning of the line
  IF(I.GT.1)THEN
   DXY=(XY(1,I-1)-XY(1,I))**2.0D0+(XY(2,I-1)-XY(2,I))**2.0D0
   IF(DXY.GT.0.0D0)DX=DX+SQRT(DXY)
  ENDIF

  !## determine for each line-segment what to draw!
  DO IIPF=1,NIPF
   IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.1.AND. &
     (MP(MPLOT(IIPF))%ISCREEN.EQ.IWINID.OR.MP(MPLOT(IIPF))%ISCREEN.EQ.0))THEN
    CALL IPFPLOT(IIPF,XMN,YMN,XMX,YMX,MPLOT(IIPF),XY(:,I:I+1),DX,.TRUE.)
   ENDIF
  ENDDO

 END DO

 !## actualy plot associated files after determining the appropriate associated files
 DO IIPF=1,NIPF
  IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.1.AND. &
    (MP(MPLOT(IIPF))%ISCREEN.EQ.IWINID.OR.MP(MPLOT(IIPF))%ISCREEN.EQ.0))THEN

   DX=(GRAPHUNITS(3,1)-GRAPHUNITS(1,1))/150.0D0
   !## determine x-values to be sorted
   IF(NXY.GT.1)THEN

    ALLOCATE(IDIPF(IPF(IIPF)%NROW,3)); DO I=1,IPF(IIPF)%NROW; IDIPF(I,1)=REAL(I); IDIPF(I,2)=0.0D0; IDIPF(I,3)=0.0D0; ENDDO

    !## get x-values for cross-section
    DO I=1,IPF(IIPF)%NROW; IF(IPF(IIPF)%IPOS(I).EQ.INT(1,1))IDIPF(I,2)=IPF(IIPF)%XYPOS(1,I); ENDDO

    !## from small distances towards big distances
    CALL QKSORT(IPF(IIPF)%NROW,IDIPF(:,2),V2=IDIPF(:,1))

    !## find first borehole on cross-section
    DO I=1,IPF(IIPF)%NROW; IF(IDIPF(I,2).GT.0.0D0)EXIT; ENDDO; J=I !+1

    !## make sure that location with zero distance will be distributed
    ITX=J; NB=0; DO I=J+1,IPF(IIPF)%NROW
     IF(IDIPF(I,2).EQ.IDIPF(I-1,2))THEN
      NB=NB+1
     ELSE
      IF(NB.GT.0)THEN
       X1=IDIPF(ITX-1,2); X2=IDIPF(I,2)
       DXX=MIN(X2-IDIPF(ITX,2),IDIPF(ITX,2)-X1)
       DXX=MIN(2.0*DX,DXX)
       X1=IDIPF(ITX,2)-0.5*DXX
       DXX=DXX/REAL(NB+1)
       X1=X1+0.5*DXX
       DO IB=0,NB
        IDIPF(ITX+IB,2)=X1+REAL(IB)*DXX
       ENDDO
      ENDIF
      ITX=I; NB=0
     ENDIF
    ENDDO
    
    !## initiate cell-width
    IDIPF(:,3)=DX
    
    !## start to include cell width, too close to the other, reduce size
    DO I=J,IPF(IIPF)%NROW
     DXX=DX
     IF(I.GT.J)             DXX=MIN(DXX,2.0*(IDIPF(I,2)-(IDIPF(I-1,2)+0.5*IDIPF(I-1,3))))
     IF(I.LT.IPF(IIPF)%NROW)DXX=MIN(DXX,IDIPF(I+1,2)-IDIPF(I,2))
     IDIPF(I,3)=MIN(DX,DXX) 
    ENDDO
        
    !## update x-position and width
    DO I=J,IPF(IIPF)%NROW !-1 
     IPF(IIPF)%XYPOS(1,INT(IDIPF(I,1)))=IDIPF(I,2)
     IPF(IIPF)%XYPOS(4,INT(IDIPF(I,1)))=IDIPF(I,3) 
    ENDDO
    DEALLOCATE(IDIPF)
   ENDIF

   !## correct for similar x-coordinates, they overlap and should be shifted
   CALL IPFPLOT(IIPF,0.0D0,0.0D0,0.0D0,0.0D0,MPLOT(IIPF),(/1.0D0,1.0D0,1.0D0,1.0D0/),0.0D0,.FALSE.)
  ENDIF
  IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.1.AND.MP(MPLOT(IIPF))%UNITS.EQ.1)IPF(IIPF)%IP=INT(0,1)
 ENDDO

 END SUBROUTINE PROFILE_BITMAPIPF

 !###======================================================================
 SUBROUTINE PROFILE_ZOOM(IDZ)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),PARAMETER :: FZIN =0.75
 REAL(KIND=DP_KIND),PARAMETER :: FZOUT=1.5
 INTEGER,INTENT(IN) :: IDZ
 INTEGER :: JDOWN,IDCURSOR,I,IWINID
 REAL(KIND=DP_KIND) :: FZ,XC1,YC1,XC2,YC2,XC3,YC3,DX,DY
 REAL(KIND=DP_KIND) :: BMPX1,BMPX2,BMPY1,BMPY2
 LOGICAL :: LEX

 CALL PROFILE_FIELDTOOLBAR(IDZ,0)

 IF(PBITMAP%IACT.NE.0)THEN
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX1,PBITMAP%IY1,BMPX1,BMPY1,IORIGIN=1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX2,PBITMAP%IY2,BMPX2,BMPY2,IORIGIN=1)
 ENDIF
 
 IF(IDZ.EQ.ID_ZOOMFULL)THEN
  CALL PROFILE_IDFMINMAX()
 ELSEIF(IDZ.EQ.ID_ZOOMIN)THEN
  FZ=FZIN
 ELSEIF(IDZ.EQ.ID_ZOOMOUT)THEN
  FZ=FZOUT
 ELSEIF(IDZ.EQ.ID_ZOOMWINDOW)THEN
  IDCURSOR=ID_CURSORZOOMRECTANGLE
 ELSEIF(IDZ.EQ.ID_MOVE)THEN
  IDCURSOR=ID_CURSORHAND
  DO IWINID=1,SIZE(IWINPROFILE)
   CALL WINDOWSELECT(IWINPROFILE(IWINID))
   CALL WINDOWOUTSTATUSBAR(2,'Click your right-mouse button to leave this move-mode')
  ENDDO
 ENDIF

 XC2  =(XMAX+XMIN)/2.0
 YC2  =(YMAX+YMIN)/2.0
 DX   = XMAX-XMIN
 DY   = YMAX-YMIN
 JDOWN=0
 IF(IDZ.EQ.ID_ZOOMIN.OR.IDZ.EQ.ID_ZOOMOUT)THEN
 
  XMAX=XC2+0.5*DX*FZ; XMIN=XC2-0.5*DX*FZ
  YMIN=YC2-0.5*DY*FZ; YMAX=YC2+0.5*DY*FZ
   
 ELSEIF(IDZ.EQ.ID_ZOOMWINDOW.OR.IDZ.EQ.ID_MOVE)THEN

  !## unfix axes
  CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,0)
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,0)

  IF(IDZ.EQ.ID_ZOOMWINDOW)THEN
   CALL IGRPLOTMODE(MODEXOR)
   CALL IGRCOLOURN(WRGB(255,255,255))
   CALL IGRFILLPATTERN(OUTLINE)
   CALL IGRLINETYPE(DASHED)
  ELSE
   NPIPET=0
  ENDIF
  CALL WCURSORSHAPE(IDCURSOR)

  LEX=.FALSE.
  XC1= 0.0D0
  YC1= 0.0D0

  !## determine number of graphs visible
  CALL PROFILE_PLOT_NSCREEN()

  DO

   CALL WMESSAGE(ITYPE,MESSAGE)

   SELECT CASE(ITYPE)

    CASE(MOUSEMOVE)

     DO IWINID=1,SIZE(IWINPROFILE); IF(MESSAGE%WIN.EQ.IWINPROFILE(IWINID))EXIT; ENDDO
     IF(IWINID.LE.SIZE(IWINPROFILE))THEN
      !## make sure proper mouse-cursor is active
      IF(WINFOMOUSE(MOUSECURSOR).NE.IDCURSOR)CALL WCURSORSHAPE(IDCURSOR)
      CALL PROFILE_EXTENT_GRAPH(IWINID)
      CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(RTOS(REAL(MESSAGE%GX,8),'F',2))//' m, Y:'//TRIM(RTOS(REAL(MESSAGE%GY,8),'F',2)))

      XC2=DBLE(MESSAGE%GX)
      YC2=DBLE(MESSAGE%GY)

      IF(IDZ.EQ.ID_MOVE)THEN
       IF(JDOWN.EQ.1)THEN
        DX  =XC1-XC2
        DY  =YC1-YC2
        XMAX=XMAX+DX
        XMIN=XMIN+DX
        YMAX=YMAX+DY
        YMIN=YMIN+DY
        CALL PROFILE_PLOT()
        IF(PBITMAP%IACT.NE.0)THEN
         CALL DBL_IGRUNITSTOPIXELS(BMPX1,BMPY1,PBITMAP%IX1,PBITMAP%IY1,IORIGIN=1)
         CALL DBL_IGRUNITSTOPIXELS(BMPX2,BMPY2,PBITMAP%IX2,PBITMAP%IY2,IORIGIN=1)
         CALL PROFILE_PLOT()
        ENDIF
       ENDIF
      
      ELSEIF(IDZ.EQ.ID_ZOOMWINDOW)THEN

       IF(JDOWN.EQ.1)THEN
        IF(LEX)THEN
         DO I=1,SIZE(IWINPROFILE)
          CALL PROFILE_EXTENT_GRAPH(I)
          CALL DBL_IGRRECTANGLE(XC1,YC1,XC3,YC3)
         ENDDO
        ENDIF
        LEX=.FALSE.
        IF(XC1.NE.XC2.AND.YC1.NE.YC2)LEX=.TRUE.
        IF(LEX)THEN
         DO I=1,SIZE(IWINPROFILE)
          CALL PROFILE_EXTENT_GRAPH(I)
          CALL DBL_IGRRECTANGLE(XC1,YC1,XC2,YC2)
         ENDDO
        ENDIF
        CALL PROFILE_EXTENT_GRAPH(IWINID)       
       ENDIF
      ENDIF

      XC3=XC2
      YC3=YC2
     
     ELSE
      CALL WCURSORSHAPE(CURHOURGLASS)     
     ENDIF
     
    CASE (MOUSEBUTUP)

     IF(IDZ.EQ.ID_MOVE)THEN
      SELECT CASE (MESSAGE%VALUE1)
       CASE (1)
        CALL WCURSORSHAPE(ID_CURSORHAND)
        JDOWN=0
        IF(MXNIFF.GT.0)KU=ABS(KU)
        NIPF=ABS(NIPF)
        CALL PROFILE_PLOT()
      END SELECT
     ENDIF

    CASE (MOUSEBUTDOWN)

     IF(IDZ.EQ.ID_MOVE)THEN
      SELECT CASE (MESSAGE%VALUE1)
       CASE (1)
        IF(JDOWN.EQ.0)THEN
         XC1=XC2
         YC1=YC2
         JDOWN=1
         IDCURSOR=ID_CURSORHANDGREP
         CALL WCURSORSHAPE(IDCURSOR)
         IF(IMOVEIFF.EQ.0)THEN
          IF(MXNIFF.GT.0)KU=-1*ABS(KU)
         ENDIF
         IF(IMOVEIPF.EQ.0)THEN
          NIPF=-1*ABS(NIPF)
         ENDIF
        ENDIF
       CASE (3)
        EXIT
      END SELECT
     ELSEIF(IDZ.EQ.ID_ZOOMWINDOW)THEN
      SELECT CASE (MESSAGE%VALUE1)
       CASE (1)
        IF(JDOWN.EQ.0)THEN
         XC1=XC2
         YC1=YC2
         JDOWN=1
        ELSE
         XMAX=MAX(XC1,DBLE(MESSAGE%GX))
         XMIN=MIN(XC1,DBLE(MESSAGE%GX))
         YMAX=MAX(YC1,DBLE(MESSAGE%GY))
         YMIN=MIN(YC1,DBLE(MESSAGE%GY))
         EXIT
        ENDIF
       CASE (3)
        IF(JDOWN.EQ.1.AND.LEX)THEN
         DO IWINID=1,SIZE(IWINPROFILE)
          CALL PROFILE_EXTENT_GRAPH(IWINID)
          CALL DBL_IGRRECTANGLE(XC1,YC1,XC3,YC3)
         ENDDO
        ENDIF
        JDOWN=-1  !broken zoom/move
        EXIT
      END SELECT
     ENDIF

   END SELECT
  ENDDO

  CALL WCURSORSHAPE(CURARROW)

  IF(IDZ.EQ.ID_ZOOMWINDOW)THEN
   CALL IGRPLOTMODE(MODECOPY)
   CALL IGRLINETYPE(SOLIDLINE)
  ELSEIF(IDZ.EQ.ID_MOVE)THEN
   IF(MXNIFF.GT.0)KU=ABS(KU)
   NIPF=ABS(NIPF)
   IF(ALLOCATED(IPIPET))NPIPET=SIZE(IPIPET)
  ENDIF

 ENDIF

 !## zoom level adjusted ... jdown=-1 aborted
 IF(JDOWN.NE.-1)CALL PROFILE_PLOT()

 !## replot to make sure adjusted coordinate affect bitmap
 IF(PBITMAP%IACT.NE.0)THEN
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSTOPIXELS(BMPX1,BMPY1,PBITMAP%IX1,PBITMAP%IY1,IORIGIN=1)
  CALL DBL_IGRUNITSTOPIXELS(BMPX2,BMPY2,PBITMAP%IX2,PBITMAP%IY2,IORIGIN=1)
  CALL PROFILE_PLOT()
 ENDIF

 CALL PROFILE_FIELDTOOLBAR(IDZ,1)

 DO IWINID=1,SIZE(IWINPROFILE)
  CALL WINDOWSELECT(IWINPROFILE(IWINID)); CALL WINDOWOUTSTATUSBAR(2,'')
 ENDDO
  
 END SUBROUTINE PROFILE_ZOOM

 !###======================================================================
 SUBROUTINE PROFILE_PROPMAIN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IEXIT,IFIXX,IFIXY,I,IRESETZOOM
 REAL(KIND=DP_KIND) :: BMPX1,BMPX2,BMPY1,BMPY2

 CALL PROFILE_CLEAR()

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IFIXX)
 CALL WDIALOGFIELDSTATE(IDF_LABEL4,IFIXX)
 CALL WDIALOGFIELDSTATE(IDF_LABEL6,IFIXX)
 CALL WDIALOGFIELDSTATE(IDF_REAL6,IFIXX)
 CALL WDIALOGFIELDSTATE(IDF_REAL7,IFIXX)
 CALL WDIALOGFIELDSTATE(IDF_REAL8,IFIXX)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IFIXY)
 CALL WDIALOGFIELDSTATE(IDF_LABEL5,IFIXY)
 CALL WDIALOGFIELDSTATE(IDF_LABEL7,IFIXY)
 CALL WDIALOGFIELDSTATE(IDF_REAL3,IFIXY)
 CALL WDIALOGFIELDSTATE(IDF_REAL4,IFIXY)
 CALL WDIALOGFIELDSTATE(IDF_REAL5,IFIXY)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK9,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL10,I)
 CALL WDIALOGFIELDSTATE(IDF_MENU1,I)

 CALL PROFILE_COORDINATES(0)
 
 CALL UTL_HIDESHOWDIALOG(ID_DSERIES,0)

 CALL WDIALOGSELECT(ID_DSERIESPROP)
 CALL WDIALOGSHOW(-1,-1,0,3)
 IRESETZOOM=0
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)

  SELECT CASE (ITYPE)

   CASE (FIELDCHANGED)
    CALL PROFILE_PROP_FIELDCHANGED(IRESETZOOM)

   CASE(PUSHBUTTON)
    CALL PROFILE_PROP_PUSHBUTTON(IEXIT,IRESETZOOM)
    IF(IEXIT.EQ.1)EXIT

   CASE(EXPOSE)
    CALL PROFILE_EXPOSE()

  END SELECT
 ENDDO

 !## copy info to mp() variable
 CALL PROFILE_COPYINFO()
 
 !## see whether colouring is active
 ICCOL=0; DO I=1,MXNIDF
  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
  !## colouring
  IF(IPRF(5).EQ.1)THEN; ICCOL=1; EXIT; ENDIF
 ENDDO

 CALL WDIALOGSELECT(ID_DSERIESPROP)
 CALL WDIALOGHIDE()

 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL WDIALOGFIELDSTATE(ID_SNAPPEN,0)
 CALL WDIALOGFIELDSTATE(ID_INFO,0)
 IF(NIPF.GT.0)THEN 
  CALL WDIALOGFIELDSTATE(ID_INFO,1)
  CALL WDIALOGFIELDSTATE(ID_SNAPPEN,1)
 ENDIF

 CALL UTL_HIDESHOWDIALOG(ID_DSERIES,2)

 IF(PBITMAP%IACT.NE.0)THEN
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX1,PBITMAP%IY1,BMPX1,BMPY1,IORIGIN=1)
  CALL DBL_IGRUNITSFROMPIXELS(PBITMAP%IX2,PBITMAP%IY2,BMPX2,BMPY2,IORIGIN=1)
 ENDIF

 CALL PROFILE_COMPUTEPLOT()
 
 !## recompute min/max only in case of axes fixation
 IF(IRESETZOOM.EQ.1)CALL PROFILE_IDFMINMAX()
 
 CALL PROFILE_CLEAR()
 !## het number of screens
 CALL PROFILE_PLOT_NSCREEN()
 !## recreate windows --- if necessary (number of windows different than before)
 IF(NSCREEN.NE.SIZE(IWINPROFILE))CALL PROFILE_CREATEWINDOWS()
 !## redraw cross-section
 CALL PROFILE_PLOT()  
 
 !## replot to make sure adjusted coordinate affect bitmap
 IF(PBITMAP%IACT.NE.0)THEN
  CALL PROFILE_EXTENT_GRAPH(1)
  CALL DBL_IGRUNITSTOPIXELS(BMPX1,BMPY1,PBITMAP%IX1,PBITMAP%IY1,IORIGIN=1)
  CALL DBL_IGRUNITSTOPIXELS(BMPX2,BMPY2,PBITMAP%IX2,PBITMAP%IY2,IORIGIN=1)
  CALL PROFILE_PLOT()
 ENDIF
 
 !## adjust menu-fields
 CALL PROFILE_FIELDTOOLBAR(0,1)

 END SUBROUTINE PROFILE_PROPMAIN

 !###======================================================================
 SUBROUTINE PROFILE_PROPINIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K
 INTEGER :: IIPF,ILEG

 !## idf's
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB1)
 CALL WDIALOGCLEARFIELD(IDF_GRID1)
 !## insert one extra
 IF(MXNIDF.GT.0)CALL WGRIDROWS(IDF_GRID1,MXNIDF+1)
 CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,1,1) !## active
 CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,1,1)
 CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,1,'Adjust All')
 CALL WGRIDPUTCELLSTRING(IDF_GRID1,11,1,'All')
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,LINETHICKNESS) !## linethickness of idf files
 
 IF(DEMO%IDEMO.EQ.1)THEN
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,DEMO%IBLOCKLINES) !## blocklines
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,DEMO%IBLOCKFILLS) !## blockfilles
 ENDIF
 
 !## adjust igraph/iscreen to be sure they are sequentially: 1,2,3, etc.
 CALL PROFILE_PLOT_NSCREEN()
 
 DO I=1,MXNIDF

  !## iscreen number
  CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,I+1,PROFIDF(I)%ISCREEN)
  CALL WGRIDPUTCELLSTRING( IDF_GRID1,3,I+1,PROFIDF(I)%ALIAS)
  CALL WGRIDPUTCELLINTEGER(IDF_GRID1,4,I+1,PROFIDF(I)%SCOLOR)
  CALL WGRIDCOLOURCELL(    IDF_GRID1,4,I+1,PROFIDF(I)%SCOLOR,PROFIDF(I)%SCOLOR)

  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)
  IF(IPRF(1).EQ.0)THEN; CALL UTL_FILLARRAY(IPRF,6,PROFIDF(I)%PRFTYPE); IPRF(7)=1; ENDIF
  
  !## caused by moving the files inside
  IF(I.EQ.1)     IPRF(5)=0
  IF(I.EQ.MXNIDF)IPRF(5)=0
  !## rewrite array since it will be used later on too!
  CALL UTL_READARRAY(IPRF,7,PROFIDF(I)%PRFTYPE)

  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1 ,I+1,IPRF(1))  !## active
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,5 ,I+1,IPRF(2))  !## lines
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,6 ,I+1,IPRF(3))  !## points
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,7 ,I+1,IPRF(4))  !## filles
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,8 ,I+1,IPRF(5))  !## colouring
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,9 ,I+1,IPRF(6))  !## 1/thicknesses
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,10,I+1,IPRF(7))  !## legend
  
  J=INDEXNOCASE(PROFIDF(I)%IDF%FNAME,'\',.TRUE.)+1
  CALL WGRIDPUTCELLSTRING(IDF_GRID1,11,I+1,PROFIDF(I)%IDF%FNAME(J:))

 END DO

 !## fill stated on dialog
 DO I=1,MXNIDF; CALL PROFILE_PROP_STATES(I); END DO
 
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB1)
 MXSAMPLING=300; CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MXSAMPLING)
 
 !## fill value settings left and right borecolumn
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK10,MP(1)%GPERC1)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER1,MP(1)%ICPERC(1))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK11,MP(1)%GPERC2)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER2,MP(1)%ICPERC(2))
 
 !## iff's
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB4)
 CALL WDIALOGCLEARFIELD(IDF_GRID1)
 IF(MXNIFF.GT.0)CALL WGRIDROWS(IDF_GRID1,MXNIFF)
 DO I=1,MXNIFF
  !## inactive
  IF(MP(KPLOT(I))%PRFTYPE.EQ.0)THEN
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,I,0)
  ELSE
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,I,1)
  ENDIF
  CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,I,MP(KPLOT(I))%ISCREEN)
  !## colouring
  IF(MP(KPLOT(I))%ILEG.EQ.0)THEN
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,3,I,0)
  ELSE
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,3,I,1)
  ENDIF
  !## arrows
  IF(MP(KPLOT(I))%IARROW.LT.1.OR.MP(KPLOT(I))%IARROW.GT.2)THEN
   CALL WGRIDPUTCELLOPTION(IDF_GRID1,4,I,1)
  ELSE
   CALL WGRIDPUTCELLOPTION(IDF_GRID1,4,I,MP(KPLOT(I))%IARROW)
  ENDIF
  J=INDEXNOCASE(MP(KPLOT(I))%IDFNAME,'\',.TRUE.)+1
  CALL WGRIDPUTCELLSTRING(IDF_GRID1,5,I,MP(KPLOT(I))%IDFNAME(J:))
 END DO

 !## ipf's
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB5)
 CALL WDIALOGCLEARFIELD(IDF_GRID1)
 IF(NIPF.GT.0)THEN
  CALL WGRIDROWS(IDF_GRID1,NIPF)
  DO IIPF=1,NIPF
   !## inactive
   IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.0)THEN
    CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,IIPF,0)
   ELSE
    CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,IIPF,1)
   ENDIF
   CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,IIPF,MP(MPLOT(IIPF))%ISCREEN)
   !## overrule ... make default active!
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,4,IIPF,MP(MPLOT(IIPF))%UNITS)
   J=INDEXNOCASE(MP(MPLOT(IIPF))%IDFNAME,'\',.TRUE.)+1
   !## ipf-name
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,5,IIPF,MP(MPLOT(IIPF))%IDFNAME(J:))
   I=IPF(IIPF)%ZCOL
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,IIPF,TRIM(IPF(IIPF)%ATTRIB(I)))
   CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,6,IIPF,1)  
   IPF(IIPF)%PCOL=MIN(IPF(IIPF)%NCOL,MAX(1,IPF(IIPF)%ACOL))
   MP(MPLOT(IIPF))%PCOL=IPF(IIPF)%PCOL
  END DO
  CALL WDIALOGPUTMENU(IDF_MENU1,MP(MPLOT)%IDFNAME(J:),NIPF,1)
  CALL WDIALOGPUTMENU(IDF_MENU2,IPF(1)%ATTRIB,IPF(1)%NCOL,1)

  CALL WDIALOGSELECT(ID_DSERIESPROPTAB6)
  CALL WDIALOGPUTMENU(IDF_MENU1,MP(MPLOT)%IDFNAME(J:),NIPF,1)

  !## fill legend IPF
  ILEG=IPF(1)%ILEGDLF; CALL IPFGETVALUE_PLOTCOLOURS(ID_DSERIESPROPTAB6,ILEG)
  CALL WDIALOGPUTOPTION(IDF_MENU2,ILEG)

 ENDIF

 !## sight depth
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 J=0
 K=0
 DO I=1,MXNIFF
  J=MAX(J,MP(KPLOT(I))%IDFI)
  K=MAX(K,MP(KPLOT(I))%FADEOUT)
 END DO
 DO IIPF=1,NIPF
  J=MAX(J,MP(MPLOT(IIPF))%IDFI)
  K=MAX(K,MP(MPLOT(IIPF))%FADEOUT)
 END DO
 XSIGHT=REAL(J)
 IFADE =K
 CALL WDIALOGPUTDOUBLE(IDF_REAL2,XSIGHT)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,IFADE)

 IF(NIPF.EQ.0)THEN
  CALL WDIALOGFIELDSTATE(IDF_CHECK6,0)
  CALL WDIALOGFIELDSTATE(IDF_CHECK8,0)
  CALL WDIALOGFIELDSTATE(IDF_REAL9,0)
  CALL WDIALOGFIELDSTATE(IDF_CHECK10,0)
  CALL WDIALOGFIELDSTATE(IDF_CHECK11,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER1,0)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER2,0)
 ELSE
  CALL WDIALOGFIELDSTATE(IDF_CHECK6,1)
  CALL WDIALOGFIELDSTATE(IDF_CHECK8,1)
  CALL WDIALOGFIELDSTATE(IDF_REAL9,1)
  CALL WDIALOGFIELDSTATE(IDF_CHECK10,1)
  CALL WDIALOGFIELDSTATE(IDF_CHECK11,1)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER1,1)
  CALL WDIALOGFIELDSTATE(IDF_INTEGER2,1)  
 ENDIF
 IF(MXNIFF.EQ.0)THEN
  CALL WDIALOGFIELDSTATE(IDF_CHECK7,0)
 ELSE
  CALL WDIALOGFIELDSTATE(IDF_CHECK7,1)
 ENDIF

 END SUBROUTINE PROFILE_PROPINIT

 !###======================================================================
 SUBROUTINE PROFILE_PROP_FIELDCHANGED(IRESETZOOM)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(INOUT) :: IRESETZOOM
 INTEGER :: I,J,K,IROW,ICOL,IRGB,IFIX,ICONFIG,ICLR,ILEG,IIPF,IOS
 REAL(KIND=DP_KIND) :: X
 LOGICAL :: LEX
 CHARACTER(LEN=20) :: TXT
 
 CALL WDIALOGSELECT(MESSAGE%WIN)

 SELECT CASE (MESSAGE%WIN)
  !## idf
  CASE (ID_DSERIESPROPTAB1)
   SELECT CASE (MESSAGE%VALUE2)

    CASE (IDF_GRID1)
     CALL WGRIDPOS(MESSAGE%Y,ICOL,IROW)
     IF(ICOL.EQ.4.AND.MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
      CALL WGRIDGETCELLINTEGER(IDF_GRID1,ICOL,IROW,IRGB)
      IF(IRGB.LE.0)IRGB=0; CALL WSELECTCOLOUR(IRGB)
      IF(WINFODIALOG(4).EQ.1)THEN
       CALL WGRIDPUTCELLINTEGER(IDF_GRID1,ICOL,IROW,IRGB)
       CALL WGRIDCOLOURCELL(IDF_GRID1,ICOL,IROW,IRGB,IRGB)
       !## force another cell after colourselection
       CALL WGRIDSETCELL(IDF_GRID1,ICOL-1,IROW)
      ENDIF
     ELSEIF(ICOL.EQ.8.AND.MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
      CALL PROFILE_PROP_STATES(IROW)
     ENDIF
     
     IF(IROW.EQ.1)THEN
      SELECT CASE(ICOL)
       CASE (2) !## igraph number/screen number
        CALL WGRIDGETCELLINTEGER(IDF_GRID1,ICOL,1,J)
        DO I=1,MXNIDF; CALL WGRIDPUTCELLINTEGER(IDF_GRID1,ICOL,I+1,J); ENDDO
       CASE (3) !## alias
       CASE (4) !## colour
        CALL WGRIDGETCELLINTEGER(IDF_GRID1,4,1,J)
        DO I=1,MXNIDF; CALL WGRIDPUTCELLINTEGER(IDF_GRID1,4,I+1,J); ENDDO
        DO I=1,MXNIDF; CALL WGRIDCOLOURCELL(IDF_GRID1,4,I+1,J,J)  ; ENDDO
       CASE (1,5,6,7,8,9,10) !## active,lines,points,filled,colouring,1/thickness/legend
        CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,ICOL,1,J)
        DO I=1,MXNIDF; CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,ICOL,I+1,J); ENDDO
      END SELECT
     ENDIF
     
    CASE (IDF_MENU4)
     CALL WDIALOGGETMENU(IDF_MENU4,ICONFIG)
     CALL WDIALOGPUTSTRING(IDF_STRING1,PROFILE_CONFIGTXT(ICONFIG))
     SELECT CASE (ICONFIG)
      !## interfaces
      CASE(1)
       J=0; DO I=1,MXNIDF
        J=J+1; IF(J.GT.MAXCOLOUR)J=1; ICLR=ICOLOR(J)
        CALL WGRIDPUTCELLINTEGER( IDF_GRID1,4,I+1,ICLR) !## colour
        CALL WGRIDCOLOURCELL(     IDF_GRID1,4,I+1,ICLR,ICLR)
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,I+1,1)    !## iact
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,5,I+1,1)    !## lines
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,6,I+1,0)    !## points
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,7,I+1,0)    !## filled in
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,8,I+1,0)    !## clr
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,9,I+1,0)    !## 1/t
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,10,I+1,1)   !## legend
       ENDDO

      !## quasi 3d model (aquitard[2]/aquifer[3]/all[4])
      CASE(2,3,4)
       J=0
       DO I=1,MXNIDF
      
        LEX=.FALSE.
        IF(ICONFIG.EQ.2)THEN
         IF(MOD(I,2).EQ.0)LEX=.TRUE.
         ICLR=WRGB(255,255,175)
        ELSEIF(ICONFIG.EQ.3)THEN
         IF(MOD(I,2).NE.0)LEX=.TRUE.
         ICLR=WRGB(200,200,200)
        ELSEIF(ICONFIG.EQ.4)THEN
         LEX=.TRUE.
        ENDIF
        IF(LEX)THEN; J=J+1; IF(J.GT.MAXCOLOUR)J=1; ICLR=ICOLOR(J); ENDIF
        IF(I.EQ.MXNIDF)ICLR=WRGB(195,195,195)
        CALL WGRIDPUTCELLINTEGER( IDF_GRID1,4 ,I+1,ICLR) !## colour
        CALL WGRIDCOLOURCELL(     IDF_GRID1,4 ,I+1,ICLR,ICLR)
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1 ,I+1,1)    !## iact
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,5 ,I+1,0)    !## lines
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,6 ,I+1,0)    !## points
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,7 ,I+1,1)    !## filled in
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,8 ,I+1,0)    !## clr
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,9 ,I+1,0)    !## 1/t
        IF(LEX)THEN
         CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,10,I+1,1)    !## legend
        ELSE
         CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,10,I+1,0)    !## legend
        ENDIF
       ENDDO

      !## quasi 3d model coloured (aquitard[5]/aquifer[6]/all[7])
      CASE(5,6,7)
       DO I=1,MXNIDF
        K=0
        ICLR=WRGB(130,130,130)

        LEX=.FALSE.
        IF(ICONFIG.EQ.5)THEN
         IF(I.EQ.1.OR.I.EQ.MXNIDF)K=1
         IF(MOD(I,3).EQ.0)LEX=.TRUE.
         ICLR=WRGB(255,255,255)
        ELSEIF(ICONFIG.EQ.6)THEN
         IF(MOD(I+1,3).EQ.0)LEX=.TRUE.
         ICLR=WRGB(255,255,255)
        ELSEIF(ICONFIG.EQ.7)THEN
         IF(MOD(I,2).EQ.0)LEX=.TRUE.
         ICLR=WRGB(255,255,255)
        ENDIF

        CALL WGRIDPUTCELLINTEGER( IDF_GRID1,4,I+1,ICLR) !## colour
        CALL WGRIDCOLOURCELL(     IDF_GRID1,4,I+1,ICLR,ICLR)
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,I+1,1)    !## iact
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,6,I+1,0)    !## points
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,7,I+1,0)    !## filled in
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,9,I+1,0)    !## 1/t
      
        J=0; IF(LEX)J=1
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,5,I+1,K)    !## lines
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,8,I+1,J)    !## clr
        CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,10,I+1,J)   !## legend
       ENDDO
     END SELECT
   END SELECT
   
  !## coordinates
  CASE (ID_DSERIESPROPTAB2)

  !## miscellaneous
  CASE (ID_DSERIESPROPTAB3)
   SELECT CASE (MESSAGE%VALUE2)
    CASE (IDF_CHECK1)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_LABEL4,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_LABEL6,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL6,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL7,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL8,IFIX)
     IRESETZOOM=1
    CASE (IDF_CHECK2)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_LABEL5,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_LABEL7,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL3,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL4,IFIX)
     CALL WDIALOGFIELDSTATE(IDF_REAL5,IFIX)
     IRESETZOOM=1
    CASE (IDF_MENU1)
     CALL WDIALOGGETMENU(IDF_MENU1,I,TXT)
     READ(TXT(3:),*,IOSTAT=IOS) X
     IF(IOS.EQ.0)CALL WDIALOGPUTDOUBLE(IDF_REAL10,X    ,'(F15.3)') 
     IF(IOS.NE.0)CALL WDIALOGPUTDOUBLE(IDF_REAL10,100.0D0,'(F15.3)') 
    CASE (IDF_CHECK9)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK9,I)
     CALL WDIALOGFIELDSTATE(IDF_REAL10,I)
     CALL WDIALOGFIELDSTATE(IDF_MENU1,I)
    CASE (IDF_CHECK8)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK8,I)
     CALL WDIALOGFIELDSTATE(IDF_REAL9,I)
    CASE (IDF_CHECK5)
!     CALL WDIALOGGETCHECKBOX(IDF_CHECK5,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO1,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO2,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO3,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO4,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO5,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO6,I)
!     CALL WDIALOGFIELDSTATE(IDF_RADIO7,I)
    CASE (IDF_CHECK10)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK10,GRAPHPERCENTAGES1)
     CALL WDIALOGFIELDSTATE(IDF_INTEGER1,GRAPHPERCENTAGES1)
    CASE (IDF_CHECK11)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK11,GRAPHPERCENTAGES2)
     CALL WDIALOGFIELDSTATE(IDF_INTEGER2,GRAPHPERCENTAGES2)
   END SELECT
   
  !## iff
  CASE (ID_DSERIESPROPTAB4)

  !## ipf
  CASE (ID_DSERIESPROPTAB5)
   SELECT CASE (MESSAGE%VALUE2) !## moved to field
    CASE (IDF_MENU2)
     CALL WDIALOGGETMENU(IDF_MENU1,J)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
     CALL WDIALOGFIELDSTATE(IDF_MENU2,I)
     IF(I.EQ.1)THEN
      CALL WDIALOGGETMENU(IDF_MENU2,IPF(J)%PCOL)
     ELSE
      IPF(J)%PCOL=0
     ENDIF
    CASE (IDF_CHECK1)
     CALL WDIALOGGETMENU(IDF_MENU1,J)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
     CALL WDIALOGFIELDSTATE(IDF_MENU2,I)
     IF(I.EQ.1)THEN
      CALL WDIALOGGETMENU(IDF_MENU2,IPF(J)%PCOL)
     ELSE
      IPF(J)%PCOL=0
     ENDIF

   END SELECT
   
  !## colours
  CASE (ID_DSERIESPROPTAB6)
   SELECT CASE (MESSAGE%VALUE1) !## move from
    CASE (IDF_MENU1,IDF_MENU2,IDF_GRID1)
     IF(MESSAGE%VALUE1.NE.MESSAGE%VALUE2)THEN
      CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
      CALL IPFGETVALUE_GETCOLOURS(ID_DSERIESPROPTAB6,ILEG)
     ENDIF
   END SELECT
   SELECT CASE (MESSAGE%VALUE2) !## move to field
    CASE (IDF_MENU1)
     IF(MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
      CALL WDIALOGGETMENU(IDF_MENU1,IIPF)
      ILEG=IPF(IIPF)%ILEGDLF
      CALL WDIALOGPUTOPTION(IDF_MENU2,ILEG)
      CALL IPFGETVALUE_PLOTCOLOURS(ID_DSERIESPROPTAB6,ILEG)
     ENDIF
    CASE (IDF_MENU2)
     IF(MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
      CALL WDIALOGGETMENU(IDF_MENU1,IIPF)
      CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
      IPF(IIPF)%ILEGDLF=ILEG
      CALL IPFGETVALUE_PLOTCOLOURS(ID_DSERIESPROPTAB6,ILEG)
     ENDIF
    CASE (IDF_GRID1)
     CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
     CALL WGRIDPOS(MESSAGE%Y,ICOL,IROW)
     IF(ICOL.EQ.2)THEN
      IRGB=BH(ILEG,IROW)%LITHOCLR
      CALL WSELECTCOLOUR(IRGB)
      IF(WINFODIALOG(4).EQ.1)THEN
       CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,IROW,IRGB)
       CALL IPFGETVALUE_GETCOLOURS(ID_DSERIESPROPTAB6,ILEG)
       CALL IPFGETVALUE_PLOTCOLOURS(ID_DSERIESPROPTAB6,ILEG)
       !## force another cell after colourselection
       CALL WGRIDSETCELL(IDF_GRID1,1,IROW)
      ENDIF
     ENDIF
  
   END SELECT
 
 END SELECT

 END SUBROUTINE PROFILE_PROP_FIELDCHANGED

!###======================================================================
 FUNCTION PROFILE_CONFIGTXT(ICONFIG)
!###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICONFIG
 CHARACTER(LEN=256) :: PROFILE_CONFIGTXT

 PROFILE_CONFIGTXT='Configuration:'

 !## configuration
 SELECT CASE (ICONFIG)
  !## Interfaces
  CASE (1)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Line representation for all entries.'
  !## Quasi 3D Model (single aquitard colours, aquifer yellow)
  CASE (2)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Surface Level represented as a line;'//NEWLINE// &
                 'Filled in appearances for interfaces 2-3,4-5,...;'//NEWLINE// &
                 'Filled in appearance for the Hydrological base.'
  !## Quasi 3D Model (single aquifer colours, aquitard brown)
  CASE (3)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Filled in appearances for interfaces 1-2,3-4,5-6,... .'
  !## 3D Model (all single coloured)
  CASE (4)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Filled in appearances for interfaces 1-2,2-3,3-4,... .'
  !## Coloured Quasi 3D Model (aquitard by file)
  CASE (5)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Surface Level represented as a line;'//NEWLINE// &
                 'Filled in appearances for interfaces 2-4,5-7,8-10,...; coloured for given parameters in 3,6,9,...;'//NEWLINE// &
                 'Filled in representation for the hydrological base.'
  !## Coloured Quasi 3D Model (aquifer by file)
  CASE (6)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Surface Level represented as a line;'//NEWLINE// &
                 'Filled in appearances for interfaces 1-3,4-6,7-9,...; coloured for given parameters in 2,5,8,...;'//NEWLINE// &
                 'Filled in representation for the hydrological base.'
  !## Coloured 3D Model (all coloured by file)
  CASE (7)
   PROFILE_CONFIGTXT=TRIM(PROFILE_CONFIGTXT)//NEWLINE//'Filled in appearances for all adjacent interfaces 1-3,5-7,9-11,...; coloured for given parameters in 2,4,6,8,10,... .'
 END SELECT

 END FUNCTION PROFILE_CONFIGTXT
 
 !###======================================================================
 SUBROUTINE PROFILE_PROP_STATES(IROW)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IROW
 INTEGER :: IP1,IP2,I,J,ICOL

 RETURN
 
 IF(IROW.LE.1.OR.IROW.GE.MXNIDF)RETURN

 IP1=0
 IP2=0
 IF(IROW.GT.2)       CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8,IROW-2,IP1)
 IF(IROW.LT.MXNIDF-1)CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8,IROW+2,IP2)
 CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8,IROW-1,I)
 CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8,IROW+1,J)
 IF(PROFIDF(IROW-1)%ISCREEN.NE.PROFIDF(IROW)%ISCREEN)I=1
 IF(PROFIDF(IROW+1)%ISCREEN.NE.PROFIDF(IROW)%ISCREEN)J=1

 !## neighbour activated already or from different graph
 IF(I.EQ.1.OR.J.EQ.1)THEN
  CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,8,IROW,0)
 ELSE
  CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8,IROW,I)
  I=I+1
  DO J=IROW-1,IROW+1
   IF((J.EQ.IROW-1.AND.IP1.EQ.0).OR.(J.EQ.IROW+1.AND.IP2.EQ.0).OR.J.EQ.IROW)THEN
    DO ICOL=1,8
     IF(ICOL.EQ.2.AND.ISOLID.EQ.1)THEN
     ELSE
      IF(J.EQ.IROW)THEN
       IF(ICOL.NE.4)CALL WGRIDSTATECELL(IDF_GRID1,ICOL,J,I)
      ELSE
       IF(ICOL.LE.3.OR.ICOL.EQ.8)CALL WGRIDSTATECELL(IDF_GRID1,ICOL,J,I)
      ENDIF
     ENDIF
    ENDDO
    CALL WGRIDPUTCELLCHECKBOX(IDF_GRID1,1,J,1)
   ENDIF
  ENDDO
  IF(I.EQ.2)THEN
   CALL WGRIDSTATECELL(IDF_GRID1,8,IROW,1)
  ENDIF
  CALL WGRIDSTATECELL(IDF_GRID1,8,1,2)
  CALL WGRIDSTATECELL(IDF_GRID1,8,MXNIDF,2)
 ENDIF

 END SUBROUTINE PROFILE_PROP_STATES

 !###======================================================================
 SUBROUTINE PROFILE_PROP_PUSHBUTTON(IEXIT,IRESETZOOM)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: IEXIT
 INTEGER,INTENT(INOUT) :: IRESETZOOM
 INTEGER :: IU,I,J,IACT,IFIXX,IFIXY,IPN,IFL,ILN,ICL,IIPF,I1T,ILG,ILEG,STRLEN
 REAL(KIND=DP_KIND) :: XINT,YINT
 CHARACTER(LEN=256) :: FNAME
 CHARACTER(LEN=52) :: CLABEL
 REAL(KIND=DP_KIND) :: XC,YC,X

 IEXIT=0

 CALL WDIALOGSELECT(MESSAGE%WIN)

 SELECT CASE (MESSAGE%WIN)
  !## colours
  CASE (ID_DSERIESPROPTAB6)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_OPEN,ID_SAVEAS)
     CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
     CALL IPFGETVALUE_OPENSAVECOLOURS('',MESSAGE%VALUE1,ID_DSERIESPROPTAB6,ILEG)
   END SELECT

  CASE (ID_DSERIESPROPTAB1)
   SELECT CASE (MESSAGE%VALUE1)     
   END SELECT
   
  CASE (ID_DSERIESPROPTAB2)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (IDF_BUTTON3)
     CALL WDIALOGLOAD(ID_DGIVEREAL,ID_DGIVEREAL)
     CALL WDIALOGPUTSTRING(IDF_LABEL1,'Enter minimal distance (meter) for which points will be removed')
     CALL WDIALOGPUTDOUBLE(IDF_REAL1,1.0D0)
     CALL WDIALOGSHOW(-1,-1,0,3)
     DO
      CALL WMESSAGE(ITYPE,MESSAGE)
      SELECT CASE (ITYPE)
       CASE (PUSHBUTTON)
        SELECT CASE (MESSAGE%VALUE1) 
         CASE (IDCANCEL,IDOK); EXIT
        END SELECT
      END SELECT
     ENDDO
     CALL WDIALOGGETDOUBLE(IDF_REAL1,X) 
     CALL WDIALOGUNLOAD()
     IF(MESSAGE%VALUE1.EQ.IDOK)THEN
      CALL PROFILE_COORDINATES(1)
      J=1
      DO I=2,NXY
       IF(UTL_DIST(XY(1,I),XY(2,I),XY(1,J),XY(2,J)).GT.X)THEN
        J=J+1; XY(1,J)=XY(1,I); XY(2,J)=XY(2,I); XYLABEL(J)=XYLABEL(I)
       ENDIF
      ENDDO
      NXY=J; CALL PROFILE_COORDINATES(0)
!      CALL PROFILE_LEGENDUPDATE()
     
     ENDIF
     
    CASE (ID_FLIP)
     !## get values first
     CALL PROFILE_COORDINATES(1)
     XPOSPROF=0.0D0
     J=NXY; DO I=1,NXY/2
      XC=XY(1,I); YC=XY(2,I); CLABEL=XYLABEL(I)
      XY(1,I)=XY(1,J); XY(2,I)=XY(2,J); XYLABEL(I)=XYLABEL(J)
      XY(1,J)=XC; XY(2,J)=YC; XYLABEL(J)=CLABEL
      J=J-1
     ENDDO
     CALL PROFILE_COORDINATES(0)
     CALL PROFILE_LEGENDUPDATE()
     IRESETZOOM=1
     
    CASE (ID_OPEN,ID_SAVE)
     IU=UTL_GETUNIT()

     IF(MESSAGE%VALUE1.EQ.ID_SAVE)THEN

      CALL PROFILE_COORDINATES(1)

      CALL POLYGON1INIT()
      SHP%NPOL=NXY; SHP%POL(1)%ITYPE=ID_POINT
      J=0; DO I=1,SHP%NPOL; J=MAX(J,LEN_TRIM(XYLABEL(I))); ENDDO; SHP%LWIDTH(1)=J
      DO I=1,SHP%NPOL; CALL POLYGON1ALLOCATEXY(I,1); ENDDO
      IF(SHP%LWIDTH(1).EQ.0)DEALLOCATE(SHP%COLNAMES)
      
      DO I=1,SHP%NPOL
       SHP%POL(I)%N=1
       DO J=1,SHP%POL(I)%N
        SHP%POL(I)%X(J)=XY(1,I)
        SHP%POL(I)%Y(J)=XY(2,I)
        IF(SHP%LWIDTH(1).GT.0)THEN
         ALLOCATE(SHP%POL(I)%LBL(1)); STRLEN=SHP%LWIDTH(1)
         ALLOCATE(SHP%POL(I)%LBL(1)%STRING(STRLEN))
        ENDIF
       ENDDO
       DO J=1,SHP%LWIDTH(1); SHP%POL(I)%LBL(1)%STRING(J:J)=XYLABEL(I)(J:J); ENDDO
      ENDDO
           
      FNAME=''; CALL POLYGON1SAVELOADSHAPE(ID_SAVESHAPE,FNAME,'GEN')
      CALL POLYGON1CLOSE()
     
     ELSEIF(MESSAGE%VALUE1.EQ.ID_OPEN)THEN

      FNAME=''; CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,FNAME,'GEN')

      XPOSPROF=0.0D0
      NXY=0
      DO I=1,SHP%NPOL
       DO J=1,SHP%POL(I)%N
        NXY=NXY+1
        CALL PROFILE_WTIADDPOINT_MEMORY(NXY)
        XY(1,NXY)=SHP%POL(I)%X(J); XY(2,NXY)=SHP%POL(I)%Y(J)
       ENDDO
       IF(ASSOCIATED(SHP%LWIDTH))WRITE(XYLABEL(I),*) SHP%POL(I)%LBL(1)%STRING
      END DO

      CALL POLYGON1CLOSE()
      CALL PROFILE_COORDINATES(0)
      CALL PROFILE_LEGENDUPDATE()
      IRESETZOOM=1
     
     ENDIF
     
   END SELECT

  !## ipf dialog
  CASE (ID_DSERIESPROPTAB5)
   SELECT CASE (MESSAGE%VALUE1)
    CASE(ID_ADJUST)
    CALL WDIALOGGETMENU(IDF_MENU1,IIPF)
    CALL IMOD3D_LABELS(IIPF,MPLOT(IIPF))
    IPF(IIPF)%ASSCOL1=MP(MPLOT(IIPF))%ASSCOL1
    IPF(IIPF)%ASSCOL2=MP(MPLOT(IIPF))%ASSCOL2
   END SELECT

  CASE (ID_DSERIESPROP)
   SELECT CASE (MESSAGE%VALUE1)
    CASE(IDCANCEL)
     IEXIT=1
    CASE(IDOK)
     XPOSPROF=0.0D0

     CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
     CALL WDIALOGGETDOUBLE(IDF_REAL2,XSIGHT)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK3,IFADE)  !## fadeout

     !## get updates for IDF
     CALL WDIALOGSELECT(ID_DSERIESPROPTAB1)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IBLOCKLINES)    !## blocklines
     CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IBLOCKFILLS)    !## blockfilles         
     CALL WDIALOGGETCHECKBOX(IDF_CHECK3,ISKIPSHORTS)    !## skip shorts
     CALL WDIALOGGETINTEGER(IDF_INTEGER2,LINETHICKNESS) !## linethickness of idf files  
     CALL WDIALOGGETCHECKBOX(IDF_CHECK4,ILINEBLACK)     !## plot lines in black on top of profile  

     DO I=1,MXNIDF
      CALL WGRIDGETCELLINTEGER(IDF_GRID1,2,I+1,PROFIDF(I)%ISCREEN)
      CALL WGRIDGETCELLINTEGER(IDF_GRID1,4,I+1,PROFIDF(I)%SCOLOR)
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,1 ,I+1,IACT)
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,5 ,I+1,ILN)   !## lines
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,6 ,I+1,IPN)   !## points
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,7 ,I+1,IFL)   !## filled in
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,8 ,I+1,ICL)   !## clr
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,9 ,I+1,I1T)   !## 1/t
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,10,I+1,ILG)   !## legend
      !## cannot be used for last idf
      IF(I.EQ.MXNIDF)THEN; ICL=0; I1T=0; ENDIF
      CALL UTL_READARRAY((/IACT,ILN,IPN,IFL,ICL,I1T,ILG/),7,PROFIDF(I)%PRFTYPE)
      CALL WGRIDGETCELLSTRING(IDF_GRID1,3,I+1,PROFIDF(I)%ALIAS)
     ENDDO

     !## clean igraphs
     CALL PROFILE_PLOT_NSCREEN()

     CALL WDIALOGSELECT(ID_DSERIESPROPTAB1)
     CALL WDIALOGGETINTEGER(IDF_INTEGER1,MXSAMPLING)

     !## get updates for IFF
     CALL WDIALOGSELECT(ID_DSERIESPROPTAB4)
     IF(MXNIFF.GT.0)THEN
      DO I=1,MXNIFF
       CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,1,I,MP(KPLOT(I))%PRFTYPE)
       CALL WGRIDPUTCELLINTEGER(IDF_GRID1,2,I,MP(KPLOT(I))%ISCREEN)
       CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,3,I,MP(KPLOT(I))%ILEG)
       CALL WGRIDGETCELLMENU(IDF_GRID1,4,I,MP(KPLOT(I))%IARROW)
       MP(KPLOT(I))%IDFI=INT(XSIGHT)
       MP(KPLOT(I))%FADEOUT=IFADE     !## fadeout
      ENDDO
     ENDIF
     
     !## get updates for IPF
     CALL WDIALOGSELECT(ID_DSERIESPROPTAB5)
     DO IIPF=1,NIPF
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,1,IIPF,MP(MPLOT(IIPF))%PRFTYPE) !## yes/no
      CALL WGRIDGETCELLINTEGER(IDF_GRID1,2,IIPF,MP(MPLOT(IIPF))%ISCREEN)  !## screen number
      CALL WGRIDGETCELLCHECKBOX(IDF_GRID1,4,IIPF,MP(MPLOT(IIPF))%UNITS)   !## yes/no
      MP(MPLOT(IIPF))%IDFI   =INT(XSIGHT)                                 !## sight depth
      MP(MPLOT(IIPF))%FADEOUT=IFADE                                       !## fadeout
     ENDDO

     CALL WDIALOGSELECT(ID_DSERIESPROPTAB6)
     CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
     CALL IPFGETVALUE_GETCOLOURS(ID_DSERIESPROPTAB6,ILEG)

     !## get updates coordinates
     CALL PROFILE_COORDINATES(1)

     CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK6,IMOVEIPF)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK8,I)
     DWIDTHCOL=0.0D0; IF(I.EQ.1)CALL WDIALOGGETDOUBLE(IDF_REAL9,DWIDTHCOL)
     
     CALL WDIALOGGETCHECKBOX(IDF_CHECK10,GRAPHPERCENTAGES1)
     ICOL1=2; IF(GRAPHPERCENTAGES1.EQ.1)CALL WDIALOGGETINTEGER(IDF_INTEGER1,ICOL1)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK11,GRAPHPERCENTAGES2)
     ICOL2=3; IF(GRAPHPERCENTAGES2.EQ.1)CALL WDIALOGGETINTEGER(IDF_INTEGER2,ICOL2)
     
     IEXIT=1
     IF(ICOL1.LE.0)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'The LEFT column number you gave is smaller/equal to 0:'//CHAR(13)//'that cannot be correct. Make me larger please!','Error')
      IEXIT=0
     ELSEIF(ICOL2.LE.0)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'The RIGHT column number you gave is smaller/equal to 0:'//CHAR(13)//'that cannot be correct. Make me larger please!','Error')
      IEXIT=0
     ELSEIF(ICOL1.GT.34)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Oops, the LEFT column number you gave does not exist (>34).'//CHAR(13)//'Make me smaller please!','Error') 
      IEXIT=0
     ELSEIF(ICOL2.GT.34)THEN
      CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Oops, the RIGHT column number you gave does not exist (>34).'//CHAR(13)//'Make me smaller please!','Error')              
      IEXIT=0
     ENDIF
     
     DO IIPF=1,NIPF
      MP(MPLOT(IIPF))%GPERC1=GRAPHPERCENTAGES1
      MP(MPLOT(IIPF))%GPERC2=GRAPHPERCENTAGES2
      MP(MPLOT(IIPF))%ICPERC(1)=ICOL1
      MP(MPLOT(IIPF))%ICPERC(2)=ICOL2
     ENDDO

     CALL WDIALOGGETCHECKBOX(IDF_CHECK7,IMOVEIFF)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IFIXX)
     CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IFIXY)
     IF(IFIXX.EQ.1)THEN
      CALL WDIALOGGETDOUBLE(IDF_REAL7,XMIN)
      CALL WDIALOGGETDOUBLE(IDF_REAL8,XMAX)
      CALL WDIALOGGETDOUBLE(IDF_REAL6,XINT)
      IF(XMAX.LE.XMIN.OR.XINT.LE.0.0D0)THEN
       CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'X-axes not filled in correcly','Error')
       IEXIT=0
      ENDIF
     ENDIF
     IF(IFIXY.EQ.1)THEN
      CALL WDIALOGGETDOUBLE(IDF_REAL3,YMIN)
      CALL WDIALOGGETDOUBLE(IDF_REAL4,YMAX)
      CALL WDIALOGGETDOUBLE(IDF_REAL5,YINT)
      IF(YMAX.LE.YMIN.OR.YINT.LE.0.0D0)THEN
       CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Y-axes not filled in correcly','Error')
       IEXIT=0
      ENDIF
     ENDIF

    CASE(IDHELP)
     CALL UTL_GETHELP('5.1.1','TMO.CT.Prop')

   END SELECT

 END SELECT

 END SUBROUTINE PROFILE_PROP_PUSHBUTTON

 !###======================================================================
 SUBROUTINE PROFILE_SNAPCOORDINATES(MOUSEX,MOUSEY)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(INOUT) :: MOUSEX,MOUSEY
 INTEGER :: IIPF,IROW,I,J
 REAL(KIND=DP_KIND) :: X,Y,D,TD

 IF(NIPF.EQ.0)RETURN
 IF(ISNAP.EQ.0)RETURN

 TD=10.0D10; I=0; J=0
 
 DO IIPF=1,ABS(NIPF)

  !## snap to these points
  IF(MP(MPLOT(IIPF))%PRFTYPE.EQ.1)THEN

   DO IROW=1,IPF(IIPF)%NROW
    X=IPF(IIPF)%XYZ(1,IROW)
    Y=IPF(IIPF)%XYZ(2,IROW)
    IF(X.GE.MPW%XMIN.AND.X.LE.MPW%XMAX.AND.Y.GE.MPW%YMIN.AND.Y.LE.MPW%YMAX)THEN
     D=UTL_DIST(X,Y,MOUSEX,MOUSEY) !(X-MOUSEX)**2.0D0+(Y-MOUSEY)**2.0D0
!     IF(D.NE.0.0D0)D=SQRT(D)

     IF(D.LT.TD)THEN
      TD=D
      I =IIPF
      J =IROW
     ENDIF

    ENDIF
   END DO
  ENDIF
 END DO
 
 IF(I.NE.0)THEN
  MOUSEX=IPF(I)%XYZ(1,J)
  MOUSEY=IPF(I)%XYZ(2,J)
 ENDIF
 
 END SUBROUTINE PROFILE_SNAPCOORDINATES

 !###======================================================================
 SUBROUTINE PROFILE_COORDINATES(CODE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: CODE
 INTEGER :: I

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB2)
 IF(CODE.EQ.0)THEN
  IF(NXY.GT.0)THEN
   CALL WGRIDROWS(IDF_GRID1,NXY)
   DO I=1,NXY
    CALL WGRIDPUTCELLDOUBLE  (IDF_GRID1,1,I,XY(1,I),'(F15.3)')
    CALL WGRIDPUTCELLDOUBLE  (IDF_GRID1,2,I,XY(2,I),'(F15.3)') 
    CALL WGRIDPUTCELLSTRING(IDF_GRID1,3,I,TRIM(XYLABEL(I))) 
    CALL WGRIDLABELROW(IDF_GRID1,I,TRIM(ITOS(I)))
   END DO
  ELSE
   CALL WDIALOGCLEARFIELD(IDF_GRID1)
  ENDIF

 ELSEIF(CODE.EQ.1)THEN

  DO I=1,NXY 
   CALL WGRIDGETCELLDOUBLE  (IDF_GRID1,1,I,XY(1,I))
   CALL WGRIDGETCELLDOUBLE  (IDF_GRID1,2,I,XY(2,I))
   CALL WGRIDGETCELLSTRING(IDF_GRID1,3,I,XYLABEL(I))
  END DO

 ENDIF

 END SUBROUTINE PROFILE_COORDINATES

 !###======================================================================
 SUBROUTINE PROFILE_IDFMINMAX()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,IIDF,IFIXX,IFIXY
 REAL(KIND=DP_KIND) :: X1,Y1

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IFIXX)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IFIXY)
 IF(IFIXX.EQ.1.AND.IFIXY.EQ.1)RETURN

 IF(IFIXX.EQ.0)THEN
  XMIN=0.0D0
  XMAX=XMIN
 ENDIF
 IF(IFIXY.EQ.0)THEN
  YMIN= 10.0D10
  YMAX=-10.0D10
 ENDIF
 
 DO IIDF=1,MXNIDF

  CALL UTL_FILLARRAY(IPRF,7,PROFIDF(IIDF)%PRFTYPE)

  !## overrule (temporary) profile-settings for colouring
  IPRF(5)=MAX(0,IPRF(5),IPRF(6))
  !## correct whenever coloring is done for the first or last one
  IF(IIDF.EQ.1.OR.IIDF.EQ.MXNIDF)THEN
   IPRF(5)=0; IPRF(6)=0
  ENDIF

  !## activated and not filled as colouring option
  IF(IPRF(1).EQ.1.AND.IPRF(5).EQ.0)THEN
   !## normal plotting of cross-section
   IF(PROFIDF(IIDF)%IDF%ITB.EQ.0)THEN
    IF(IFIXY.EQ.0)THEN
     DO I=1,SERIE(IIDF)%N
      IF(SERIE(IIDF)%Y(I).NE.PROFIDF(IIDF)%IDF%NODATA)THEN
       YMIN=MIN(YMIN,SERIE(IIDF)%Y(I))
       YMAX=MAX(YMAX,SERIE(IIDF)%Y(I))
      ENDIF
     ENDDO
    ENDIF
    IF(IFIXX.EQ.0)THEN
     IF(SERIE(IIDF)%N.GT.0)THEN
      XMAX=MAX(XMAX,SERIE(IIDF)%X(SERIE(IIDF)%N))
     ENDIF
    ENDIF
   ELSEIF(PROFIDF(IIDF)%IDF%ITB.EQ.1)THEN
    IF(IFIXY.EQ.0)THEN
     YMIN=MIN(YMIN,PROFIDF(IIDF)%IDF%BOT)
     YMAX=MAX(YMAX,PROFIDF(IIDF)%IDF%TOP)
    ENDIF
   ENDIF
  ENDIF
 ENDDO

 !## determine max-x in case no idf's were sampled
 IF(IFIXX.EQ.0.AND.XMAX.EQ.0.0D0)THEN
  DO I=1,NXY-1
   X1  =XY(1,I+1)-XY(1,I)
   Y1  =XY(2,I+1)-XY(2,I)
   XMAX=XMAX+SQRT(X1**2.0D0+Y1**2.0D0)
  END DO
 ENDIF

 IF(IFIXY.EQ.0)THEN
  CALL PROFILE_IFFMINMAX()
  CALL PROFILE_IPFMINMAX()
 ENDIF
 CALL SOLID_PROFILEMINMAX(IFIXX,IFIXY)

 END SUBROUTINE PROFILE_IDFMINMAX

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

 !## profile from IDF's is determined
 IF(YMIN.LT.YMAX)RETURN

 YMIN=-50.0D0
 YMAX= 50.0D0

 END SUBROUTINE PROFILE_IPFMINMAX

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

 !## profile from IDF's is determined
 IF(YMIN.LT.YMAX)RETURN

 YMIN=-50.0D0
 YMAX= 50.0D0

 END SUBROUTINE PROFILE_IFFMINMAX

 !###======================================================================
 SUBROUTINE PROFILE_LEGEND()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ILEG

 ILEG=WMENUGETSTATE(ID_FLOATLEGEND,2)
 !## checked previously, uncheck it now
 IF(ILEG.EQ.1)THEN
  CALL WDIALOGSELECT(ID_DSERIESLEGEND); CALL WDIALOGHIDE() !UNLOAD()
  CALL WMENUSETSTATE(ID_FLOATLEGEND,2,0)
  RETURN
 ENDIF
 
 !## check it
 CALL WMENUSETSTATE(ID_FLOATLEGEND,2,1)

 CALL PROFILE_LEGENDUPDATE()
 CALL WDIALOGSELECT(ID_DSERIESLEGEND)
 CALL WDIALOGSHOW(-1,-1,0,2)
 CALL WDIALOGSELECT(ID_DSERIESTAB1)

 END SUBROUTINE PROFILE_LEGEND

 !###======================================================================
 SUBROUTINE PROFILE_LEGENDUPDATE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,ILEG

 ILEG=WMENUGETSTATE(ID_FLOATLEGEND,2)
 IF(ILEG.EQ.0)RETURN

 CALL WDIALOGSELECT(ID_DSERIESLEGEND)
 DO I=1,MXNIDF
  CALL WGRIDCOLOURCELL(IDF_GRID1,1,I,PROFIDF(I)%SCOLOR,PROFIDF(I)%SCOLOR)
  CALL WGRIDPUTCELLSTRING(IDF_GRID1,2,I,PROFIDF(I)%ALIAS)
 END DO
 CALL WDIALOGSELECT(ID_DSERIESTAB1)

 END SUBROUTINE PROFILE_LEGENDUPDATE

 !###======================================================================
 SUBROUTINE PROFILE_TRANSFORMXY()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: XMIDDLE,YMIDDLE,DX,DY
 INTEGER :: I

 XMIDDLE=SUM(XY(1,1:NXY))/REAL(NXY)
 YMIDDLE=SUM(XY(2,1:NXY))/REAL(NXY)
 DO I=1,NXY
  DX=XY(1,I)-XMIDDLE
  DY=XY(2,I)-YMIDDLE
  XY(1,I)=XMIDDLE-1.0D0*DY
  XY(2,I)=YMIDDLE+1.0D0*DX
 END DO

 END SUBROUTINE PROFILE_TRANSFORMXY

 !###======================================================================
 SUBROUTINE PROFILE_DEMO()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 
 IF(DEMO%IDEMO.EQ.0)RETURN
  
 DO I=1,DEMO%NXY
  XY(1,I)=DEMO%X(I)
  XY(2,I)=DEMO%Y(I)
  XYLABEL(I)=DEMO%L(I)
 END DO
 NXY=DEMO%NXY
 
 CALL PROFILE_COMPUTEPLOT()
 CALL PROFILE_IDFMINMAX()
 CALL PROFILE_PLOT()
 XPOSPROF=0.0D0
 CALL PROFILE_CLEAR()
 CALL PROFILE_COORDINATES(0)
 
 IF(DEMO%ISAVEBMP.EQ.1)THEN
  CALL PROFILE_SAVE(IMFFNAME(:INDEX(IMFFNAME,'.',.TRUE.)-1)//'.JPG',1)
 ENDIF
 
 END SUBROUTINE PROFILE_DEMO

 !###======================================================================
 SUBROUTINE PROFILE_SAVE(SAVENAME,IDEMO)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: SAVENAME
 INTEGER,INTENT(IN) :: IDEMO
 INTEGER :: IU,IIDF,I,IOS,IDELIM,IP,IB,JP,JB
 REAL(KIND=DP_KIND) :: XC,YC 
 CHARACTER(LEN=256) :: FNAME
 CHARACTER(LEN=3) :: EXT
 
 IF(TRIM(SAVENAME).EQ.'')THEN
  FNAME=TRIM(PREFVAL(1))//'\shapes\*.csv'
  IF(.NOT.UTL_WSELECTFILE('iMOD Comma-Separated File (*.csv)|*.csv|Postscript File (*.ps)|*.ps|Encapsulated Postscript File (*.eps)|*.eps|iMOD Project (*.imf)|*.imf|'// &
            'Windows Bitmap (*.bmp)|*.bmp|ZSoft PC Paintbrush (*.pcx)|*.pcx|Portable Network Graphic image (*.png)|*.png|JPEG Image (*.jpg)|*.jpg|', &
            SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Select File Format'))RETURN
 ELSE
  FNAME=SAVENAME
 ENDIF
 
 EXT=UTL_CAP(FNAME(INDEX(FNAME,'.',.TRUE.)+1:),'U')
 SELECT CASE (TRIM(EXT))
  CASE ('BMP','PNG','PCX','JPG')
   DO I=1,SIZE(IWINPROFILE)
    CALL WBITMAPSAVE(PRF_IBITMAP(I),FNAME)
   ENDDO
  CASE ('CSV')
   IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',FORM='FORMATTED',ACTION='WRITE',IOSTAT=IOS)
   IF(IOS.NE.0)THEN
    CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Cannot write to output file:'//CHAR(13)// &
     TRIM(FNAME),'Info'); RETURN
   ENDIF
   IDELIM=44
   WRITE(IU,'(A)') 'iMOD Cross-Section'; WRITE(IU,*)
   DO IIDF=1,MXNIDF
    CALL UTL_FILLARRAY(IPRF,7,PROFIDF(IIDF)%PRFTYPE)
    IF(IPRF(1).EQ.1)THEN
     WRITE(IU,'(A)') '- '//TRIM(PROFIDF(IIDF)%IDF%FNAME)
     WRITE(IU,'(4(A15,A1))')  '  X-COORD.',CHAR(IDELIM),'  Y-COORD.',CHAR(IDELIM),'  DISTANCE', &
                                           CHAR(IDELIM),'         Z'
     WRITE(IU,'(4(A15,A1))')  '   (meter)',CHAR(IDELIM),'   (meter)',CHAR(IDELIM),'   (meter)', &
                                           CHAR(IDELIM),'     (???)'
     DO I=1,SERIE(IIDF)%N
      IF(PROFILE_GETLOCATION(XC,YC,SERIE(IIDF)%X(I)))THEN
       WRITE(IU,'(3(F15.3,A1),G15.7)') XC,CHAR(IDELIM),YC,CHAR(IDELIM),SERIE(IIDF)%X(I),&
                                          CHAR(IDELIM),SERIE(IIDF)%Y(I)
      ENDIF
     ENDDO
    ENDIF
   ENDDO
   CLOSE(IU)
   IF(IDEMO.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written output to:'//CHAR(13)//TRIM(FNAME),'Info')
  CASE ('PS','EPS')
   
   IP=WINFOGRHARDCOPY(PAPERWIDTH)  !## in points
   JP=WINFOGRHARDCOPY(PAPERHEIGHT) !## in points

   !## select postscript driver
   CALL IGRHARDCOPYSELECT(1,POSTSCRIPT)

   DO I=1,SIZE(IWINPROFILE)
    CALL IGRSELECT(DRAWWIN,IWINPROFILE(I))
    IB=WINFOWINDOW(WINDOWWIDTH)
    JB=WINFOWINDOW(WINDOWHEIGHT)

    CALL IGRHARDCOPYOPTIONS(IMAGEWIDTH,IP)
    JB=IP*REAL(JB)/REAL(IB)
    !## adjust image height
    CALL IGRHARDCOPYOPTIONS(IMAGEHEIGHT,JB)
    CALL IGRHARDCOPYOPTIONS(HORIZPOS,0)
    CALL IGRHARDCOPYOPTIONS(VERTICPOS,0)
    CALL IGRHARDCOPYOPTIONS(ORIENTATION,INTLANDSCAPE)

    IF(SIZE(IWINPROFILE).GT.1)FNAME=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'_'//TRIM(ITOS(I))//'.PS'

    IF(EXT.EQ.'EPS')THEN
     CALL IGRHARDCOPYOPTIONS(EPSFILE,1)
     FNAME=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'.EPS'
    ENDIF
      
    !## replot as vector image
    CALL IGRHARDCOPY(FNAME)
    CALL PROFILE_PLOT(LPS=.TRUE.) !##TRUE
    !## stop hardcopy export
    CALL IGRHARDCOPY('S') 
   
   ENDDO
   
   CALL IGRSELECT(DRAWWIN,IWINPROFILE(1))
   CALL WINDOWSELECT(IWINPROFILE(1))
   
   !## replot as bitmap
   CALL PROFILE_PLOT()
   
   IF(IDEMO.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully written Postscript to:'//CHAR(13)//TRIM(FNAME),'Info')
  
  CASE('IMF')
   IF(DEMO%IDEMO.NE.1)THEN
    DEMO%IDEMO = 1
   ENDIF
   DEMO%NXY = NXY
   IF(ASSOCIATED(DEMO%X))DEALLOCATE(DEMO%X); ALLOCATE(DEMO%X(DEMO%NXY))
   IF(ASSOCIATED(DEMO%Y))DEALLOCATE(DEMO%Y); ALLOCATE(DEMO%Y(DEMO%NXY))
   IF(ASSOCIATED(DEMO%L))DEALLOCATE(DEMO%L); ALLOCATE(DEMO%L(DEMO%NXY))
   DO I=1,DEMO%NXY 
    DEMO%X(I) = XY(1,I)
    DEMO%Y(I) = XY(2,I)
    DEMO%L(I) = XYLABEL(I)
   ENDDO
   DEMO%IBLOCKLINES = IBLOCKLINES
   DEMO%IBLOCKFILLS = IBLOCKFILLS
   CALL MAIN_UTL_SAVE_IMF(FNAME,1)
   IF(IDEMO.EQ.0)CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully saved cross-section as DEMO iMOD project (*.imf) to:'//CHAR(13)//TRIM(FNAME),'Info')
   DEMO%IDEMO=0
   DEMO%ISAVEBMP=0
 END SELECT

 END SUBROUTINE PROFILE_SAVE

 !###======================================================================
 SUBROUTINE PROFILE_PLOTCOORDINATES()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2,DX,DXS,YY1
 INTEGER :: I,J
 CHARACTER(LEN=50) :: STRING
 
 !## no coordinates available
 IF(NXY.EQ.0)RETURN
 
 !## get current graph-dimensions
 X1 =INFOGRAPHICS(GRAPHICSUNITMINX); X2 =INFOGRAPHICS(GRAPHICSUNITMAXX)
 Y1 =INFOGRAPHICS(GRAPHICSUNITMINY); Y2 =INFOGRAPHICS(GRAPHICSUNITMAXY)
 CALL DBL_WGRTEXTFONT(IFAMILY=AXES%TFONT,TWIDTH=AXES%CHW,THEIGHT=AXES%CHH,ISTYLE=0)
 !## plot axes-text
 CALL IGRCOLOURN(WRGB(0,0,0))

 CALL DBL_WGRTEXTORIENTATION(ALIGNLEFT,ANGLE=00.0D0)

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK9,I)
 IF(I.EQ.1)THEN
  CALL WDIALOGGETDOUBLE(IDF_REAL10,DX)
  YY1=Y1+((Y2-Y1)/50.0D0)
  CALL DBL_WGRTEXTSTRING(X1,YY1,' Scale 1:'//TRIM(RTOS(DX,'F',2))) 
 ENDIF
 
 !## plotting selected!
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB2)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,J)
 IF(I.EQ.0)RETURN

 DX=0.0D0
 
 CALL DBL_WGRTEXTORIENTATION(ALIGNLEFT,ANGLE=90.0D0)

 !## colors the label text and label background at given x,y coordinate
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL DBL_WGRTEXTFONT(IFAMILY=AXES%TFONT,TWIDTH=AXES%CHW,THEIGHT=AXES%CHH,ISTYLE=FSOPAQUE)
 CALL IGRCOLOURN(WRGB(0,0,0))
 CALL DBL_WGRTEXTFONT(IFAMILY=AXES%TFONT,TWIDTH=AXES%CHW,THEIGHT=AXES%CHH)

 YY1=Y1+((Y2-Y1)/50.0D0)
 DO I=1,NXY
  
  STRING='['//TRIM(ITOS(INT(XY(1,I))))//'m,'//TRIM(ITOS(INT(XY(2,I))))//'m,'//TRIM(XYLABEL(I))//']'
  DXS=WGRTEXTLENGTH('0'//TRIM(STRING)//'0',0)*AXES%CHW 

  IF(I.GT.1)THEN
   DX=DX+SQRT((XY(1,I)-XY(1,I-1))**2.0D0+(XY(2,I)-XY(2,I-1))**2.0D0)
  ENDIF 
  
  IF(J.EQ.1.AND.TRIM(XYLABEL(I)).EQ.'')CYCLE

  CALL DBL_WGRTEXTSTRING(DX,YY1,' '//TRIM(STRING)//' ') 
    
 ENDDO

 CALL IGRFILLPATTERN(OUTLINE)

 END SUBROUTINE PROFILE_PLOTCOORDINATES

 !###======================================================================
 SUBROUTINE PROFILE_SHOW()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I!,IW,IH,IWP,IHP

 CALL PROFILE_PROPINIT()

 CALL WDIALOGSELECT(ID_DSERIESPROP)
 IF(MXNIDF.LE.0)THEN
  I=0
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB1,I)
 ELSE
  I=1
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB1,I)
  CALL WDIALOGSETTAB(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB1)
 ENDIF
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)

 CALL WDIALOGSELECT(ID_DSERIESPROP)
 IF(MXNIFF.LE.0)THEN
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB4,0)
 ELSE
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB4,1)
  IF(MXNIDF.LE.0)CALL WDIALOGSETTAB(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB4)
 ENDIF

 CALL WDIALOGSELECT(ID_DSERIESPROP)
 IF(NIPF.LE.0)THEN
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB5,0)
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB6,0)
 ELSE
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB5,1)
  CALL WDIALOGTABSTATE(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB6,1)
  IF(MXNIDF.LE.0.AND.MXNIFF.LE.0)CALL WDIALOGSETTAB(ID_DSERIESPROPTAB,ID_DSERIESPROPTAB5)
 ENDIF

 I=1
 IF(NIPF.LE.0.AND.MXNIFF.LE.0)I=0
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGFIELDSTATE(IDF_GROUP4,I)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL2,I)
 !## min. value for all ipf's/iff's
 CALL WDIALOGFIELDSTATE(IDF_CHECK3,I)

 !## turn off tab in case isolid=0
 CALL WDIALOGSELECT(ID_DSERIES)
 IF(ISOLID.EQ.0)CALL WDIALOGTABSTATE(ID_DSERIESTAB,ID_DSERIESTAB2,0)
 
 !## semi-modalless
 CALL WDIALOGSHOW(0,0,0,2)

 END SUBROUTINE PROFILE_SHOW

 !###======================================================================
 SUBROUTINE PROFILE_FIELDSPLAY(ID,I)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,I

 CALL WDIALOGSELECT(ID_DSERIESMOVIE)
 IF(ID_STOP.NE.ID)      CALL WDIALOGFIELDSTATE(ID_STOP,I)
 IF(ID_LEFT.NE.ID)      CALL WDIALOGFIELDSTATE(ID_LEFT,I)
 IF(ID_FASTLEFT.NE.ID)  CALL WDIALOGFIELDSTATE(ID_FASTLEFT,I)
 IF(ID_TOTALLEFT.NE.ID) CALL WDIALOGFIELDSTATE(ID_TOTALLEFT,I)
 IF(ID_RIGHT.NE.ID)     CALL WDIALOGFIELDSTATE(ID_RIGHT,I)
 IF(ID_FASTRIGHT.NE.ID) CALL WDIALOGFIELDSTATE(ID_FASTRIGHT,I)
 IF(ID_TOTALRIGHT.NE.ID)CALL WDIALOGFIELDSTATE(ID_TOTALRIGHT,I)
 IF(IDF_RADIO1.NE.ID)   CALL WDIALOGFIELDSTATE(IDF_RADIO1,I)
 IF(IDF_RADIO2.NE.ID)   CALL WDIALOGFIELDSTATE(IDF_RADIO2,I)
 IF(IDF_REAL1.NE.ID)    CALL WDIALOGFIELDSTATE(IDF_REAL1,I)

 END SUBROUTINE PROFILE_FIELDSPLAY

 !###======================================================================
 SUBROUTINE PROFILE_TURNOFF()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT

 !## zodat eerste getekende alleen als legenda bewerkt kan worden
 LISEL  =MP%ISEL
 MP%ISEL=.FALSE.
 DO IPLOT=1,MXMPLOT
 !## activate first of list
  IF(LISEL(IPLOT))THEN
   MP(IPLOT)%ISEL=.TRUE.
   EXIT
  ENDIF
 ENDDO
 CALL MANAGER_UTL_UPDATE()

 END SUBROUTINE

 !###====================================================================
 LOGICAL FUNCTION PROFILE_ALLOCATE()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I,NR
 REAL(KIND=DP_KIND) :: DX

 PROFILE_ALLOCATE=.FALSE.

 MXNIDF=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5))THEN
   IF(MP(IPLOT)%IPLOT.EQ.5)THEN
    MXNIDF=MXNIDF+READMDF_GETN(MP(IPLOT)%IDFNAME)
   ELSE
    MXNIDF=MXNIDF+1
   ENDIF
  ENDIF
 ENDDO

 MXNIFF=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.3)MXNIFF=MXNIFF+1
 ENDDO
 !## get nipf
 CALL IPFINIT()

 CALL PROFILE_DEALLOCATE()

 ALLOCATE(KPLOT(MAX(1,MXNIFF)),KU(MAX(1,MXNIFF)), &
          MPLOT(MAX(1,NIPF)),LISEL(MXMPLOT))

 !## all idf in new-list storing idf-configuration
 ALLOCATE(PROFIDF(MXNIDF),PROFNIDF(0:MXNIDF))

 !## assign kplot IFF
 I   =0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.3)THEN
   I       =I+1
   KPLOT(I)=IPLOT
  ENDIF
 ENDDO

 !## assign mplot IPF
 I   =0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.2)THEN
   I       =I+1
   MPLOT(I)=IPLOT
  ENDIF
 ENDDO

 ALLOCATE(XY(2,MXCRD),XYLABEL(MXCRD),SERIE(MXNIDF)); XYLABEL=''

 DO I=1,MXNIDF
  NULLIFY(SERIE(I)%X); NULLIFY(SERIE(I)%Y); PROFIDF(I)%LEG%NCLR=0
 END DO

 DO I=1,MXNIDF
  ALLOCATE(SERIE(I)%X(MXSERIE),SERIE(I)%Y(MXSERIE))
 END DO

 !## turn off selections temporary in idf-manager
 CALL PROFILE_TURNOFF()
 !## turn off options on mainrootmenu
 CALL PROFILE_FIELDSMAINMENU(0)
 !## open idf/iff/ipf files
 IF(.NOT.PROFILE_OPENFILES())RETURN
 
 !## show profile-dialog
 CALL PROFILE_SHOW()
 !## show bitmap of idf plotted
 CALL PROFILE_PUTBITMAP(MPW%IBITMAP) !0)

 CALL WDIALOGSELECT(ID_DSERIESMOVIE)
 CALL WDIALOGFIELDSTATE(ID_STOP,0)

 DX=100.0D0
 DO I=1,MXNIDF
  DX=MIN(DX,PROFIDF(I)%IDF%DX)
 ENDDO
 CALL WDIALOGPUTDOUBLE(IDF_REAL1,DX)

 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL WDIALOGFIELDSTATE(ID_MOVIE,0)
 CALL WDIALOGFIELDSTATE(ID_FLIP,0)
 CALL WDIALOGFIELDSTATE(ID_SNAPPEN,0)
 CALL WDIALOGFIELDSTATE(ID_INFO,0)
 IF(NIPF.GT.0)THEN
  CALL WDIALOGFIELDSTATE(ID_SNAPPEN,1)
  CALL WDIALOGFIELDSTATE(ID_INFO,1)
 ENDIF
 IF(MXNIDF.GT.0)CALL WDIALOGFIELDSTATE(ID_LEGEND,1)
 IF(MXNIDF.LE.0)CALL WDIALOGFIELDSTATE(ID_LEGEND,0)

 IF(MXNIDF.GT.0)THEN
  CALL WDIALOGSELECT(ID_DSERIESLEGEND)
  NR=WINFOGRID(IDF_GRID1,GRIDROWSMAX)
  IF(MXNIDF.GT.NR)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'The maximum of IDF files for the ProfileTool is '//TRIM(ITOS(NR))//CHAR(13)// &
     'You have selected '//TRIM(ITOS(MXNIDF)),'Error')
   RETURN
  ENDIF
  CALL WGRIDROWS(IDF_GRID1,MXNIDF)
 ENDIF

 PROFILE_ALLOCATE=.TRUE.

 END FUNCTION PROFILE_ALLOCATE

 !###======================================================================
 LOGICAL FUNCTION PROFILE_OPENFILES()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,N,IIPF,IPLOT,NGRAPH
 
 PROFILE_OPENFILES=.FALSE.
 
 !## fill dialog with information IDF
 !## open idf files (*.idf,*.mdf)
 MXNIDF  =0
 NGRAPH  =0
 PROFNIDF=0
 K=0
 DO IPLOT=1,MXMPLOT 
  IF(MP(IPLOT)%ISEL.AND.(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5))THEN
   !## get idf for mdf file
   IF(MP(IPLOT)%IPLOT.EQ.5)THEN
    NGRAPH=NGRAPH+1
    IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
     DO I=1,N
      MXNIDF=MXNIDF+1
      IF(.NOT.IDFREAD(PROFIDF(MXNIDF)%IDF,MDF(I)%FNAME,0))K=K+1 

      PROFIDF(MXNIDF)%ALIAS  =MDF(I)%ALIAS
      PROFIDF(MXNIDF)%SCOLOR =MDF(I)%SCOLOR
      PROFIDF(MXNIDF)%PRFTYPE=MDF(I)%PRFTYPE
      PROFIDF(MXNIDF)%UNITS  =0

      J=INDEXNOCASE(PROFIDF(I)%IDF%FNAME,'\',.TRUE.)+1
      IF(PROFIDF(MXNIDF)%ALIAS.EQ.'')PROFIDF(MXNIDF)%ALIAS=TRIM(PROFIDF(I)%IDF%FNAME(J:))//' ['//TRIM(MP(IPLOT)%ALIAS)//']'
      IF(PROFIDF(MXNIDF)%SCOLOR.LE.0)PROFIDF(MXNIDF)%SCOLOR=ICOLOR(I)
      IF(PROFIDF(MXNIDF)%PRFTYPE.LE.0)CALL UTL_READARRAY((/1,1,0,0,0,0,1/),7,PROFIDF(MXNIDF)%PRFTYPE)
      PROFIDF(MXNIDF)%ISCREEN=NGRAPH

      CALL LEG_ALLOCATE(PROFIDF(MXNIDF)%LEG)
      PROFIDF(MXNIDF)%LEG  =MDF(I)%LEG

     ENDDO
     !## number of idfs in current mdf
     PROFNIDF(NGRAPH)=I-1
     CALL MDFDEALLOCATE()
     
     !## something went wrong reading mdf file
     IF(K.GT.0)RETURN
     
    ENDIF
   ELSE
    MXNIDF=MXNIDF+1
    IF(.NOT.IDFREAD(PROFIDF(MXNIDF)%IDF,MP(IPLOT)%IDFNAME,0))EXIT
    PROFIDF(MXNIDF)%SCOLOR =MP(IPLOT)%SCOLOR
    PROFIDF(MXNIDF)%PRFTYPE=MP(IPLOT)%PRFTYPE
    PROFIDF(MXNIDF)%ISCREEN=MP(IPLOT)%ISCREEN 
    PROFIDF(MXNIDF)%ALIAS  =MP(IPLOT)%ALIAS
    PROFIDF(MXNIDF)%UNITS  =MP(IPLOT)%UNITS
    PROFNIDF(0)            =PROFNIDF(0)+1
    CALL LEG_ALLOCATE(PROFIDF(MXNIDF)%LEG)
    !## copy legend
    PROFIDF(MXNIDF)%LEG%NCLR  =MP(IPLOT)%LEG%NCLR
    PROFIDF(MXNIDF)%LEG%CGRAD =MP(IPLOT)%LEG%CGRAD
    PROFIDF(MXNIDF)%LEG%CLASS =MP(IPLOT)%LEG%CLASS
    PROFIDF(MXNIDF)%LEG%LEGTXT=MP(IPLOT)%LEG%LEGTXT
    PROFIDF(MXNIDF)%LEG%RGB   =MP(IPLOT)%LEG%RGB
   ENDIF
  ENDIF
 ENDDO

 !## fill dialog with information IFF
 KU=0
 DO I=1,MXNIFF
  KU(I)=IFFGETUNIT(MP(KPLOT(I))%IDFNAME,'OLD')
 ENDDO

 !## initialize ipf's
 CALL IPFINIT()

 DO IIPF=1,NIPF
  IF(.NOT.IPFREAD(MPLOT(IIPF),IIPF))THEN
 !## error occured
  ENDIF
 END DO

 PROFILE_OPENFILES=.TRUE.

 END FUNCTION PROFILE_OPENFILES

END MODULE MOD_PROFILE