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

USE WINTERACTER
USE RESOURCE
USE MOD_DBL
USE IMODVAR, ONLY : DP_KIND,SP_KIND
USE MOD_IDF,ONLY : IDFGETVAL,IDFDEALLOCATEX,IDFGETAREA
USE MOD_UTL
USE MOD_PROFILE_PAR
USE MODPLOT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_GRAPH_PAR, ONLY : AXESOBJ,GRAPHUNITS,GRAPHAREA
USE MOD_INTERSECT, ONLY : INTERSECT_EQUI,INTERSECT_NONEQUI,INTERSECT_DEALLOCATE
USE MOD_INTERSECT_PAR, ONLY : XA,YA,LN,CA,RA
USE MOD_SOLID_PAR, ONLY : ISPF,NSPF,SPF,IMASK
USE MOD_MDF, ONLY : READMDF,WRITEMDF,MDFDEALLOCATE,READMDF_GETN,MDF
USE MOD_IPF_PAR, ONLY : IPF,NIPF,NLITHO,BH,ICOL1,ICOL2,GRAPHPERCENTAGES1,GRAPHPERCENTAGES2
USE MOD_MANAGER_UTL, ONLY : MANAGER_UTL_UPDATE

INTEGER,DIMENSION(7),PRIVATE :: IPRF

CONTAINS

 !###======================================================================
 SUBROUTINE PROFILE_COPYINFO()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,IIPF,I,N

 !## fill dialog with information IDF
 !## open idf files (*.idf,*.mdf)
 MXNIDF=0; IIPF=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
    IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
     DO I=1,N
      MXNIDF=MXNIDF+1
      MDF(I)%LEG       =PROFIDF(MXNIDF)%LEG
      MDF(I)%PRFTYPE   =PROFIDF(MXNIDF)%PRFTYPE
      MDF(I)%SCOLOR    =PROFIDF(MXNIDF)%SCOLOR
      MDF(I)%ALIAS     =PROFIDF(MXNIDF)%ALIAS
     ENDDO
     IF(.NOT.WRITEMDF(MP(IPLOT)%IDFNAME,N))THEN
     ENDIF
     CALL MDFDEALLOCATE()
    ENDIF
   ELSE
    MXNIDF=MXNIDF+1
    MP(IPLOT)%SCOLOR =PROFIDF(MXNIDF)%SCOLOR
    MP(IPLOT)%PRFTYPE=PROFIDF(MXNIDF)%PRFTYPE
    MP(IPLOT)%ALIAS  =PROFIDF(MXNIDF)%ALIAS
    MP(IPLOT)%ISCREEN=PROFIDF(MXNIDF)%ISCREEN
    MP(IPLOT)%UNITS  =PROFIDF(MXNIDF)%UNITS
   ENDIF
  !## ipf
  ELSEIF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.2)THEN
   IIPF=IIPF+1
   MP(IPLOT)%ILEGDLF=IPF(IIPF)%ILEGDLF  
   MP(IPLOT)%ASSCOL1=IPF(IIPF)%ASSCOL1  
   MP(IPLOT)%ASSCOL2=IPF(IIPF)%ASSCOL2  
  ENDIF
 ENDDO

 END SUBROUTINE PROFILE_COPYINFO

 !###======================================================================
 SUBROUTINE PROFILE_COMPUTEPLOT()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2
 INTEGER :: I,IIDF,N,MAXSTEP

 CALL IGRCOLOURN(WRGB(255,255,255))
 !## recompute profile
 SERIE%N=0

 MAXSTEP=0
 DO IIDF=1,MXNIDF
  !## compute only those that are activated
  IF(PROFIDF(IIDF)%PRFTYPE.GT.0)THEN
   N=0; DO I=1,NXY-1
    X1=XY(1,I); X2=XY(1,I+1); Y1=XY(2,I); Y2=XY(2,I+1)
    CALL PROFILE_PROFINTERSECTLINE(X1,X2,Y1,Y2,IIDF,N)
   ENDDO
   CALL PROFILE_PROFSPOTLINE(X1,X2,Y1,Y2,IIDF,N,MAXSTEP)
  ENDIF
 END DO

 CALL PROFILE_PROFSPOTLINE_SYNC()
 
 !## plot sampling distance (if larger than 1)
 IF(ALLOCATED(IWINPROFILE))THEN
  DO I=1,SIZE(IWINPROFILE)
   CALL WINDOWSELECT(IWINPROFILE(I))
   IF(MAXSTEP.GT.1)THEN
    CALL WINDOWOUTSTATUSBAR(2,'Interval '//TRIM(ITOS(MAXSTEP)))
   ELSE
    CALL WINDOWOUTSTATUSBAR(2,'')
   ENDIF
  ENDDO
 ENDIF
 
 END SUBROUTINE PROFILE_COMPUTEPLOT

 !###======================================================================
 SUBROUTINE PROFILE_PROFINTERSECTLINE(X1,X2,Y1,Y2,IIDF,N)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIDF
 INTEGER,INTENT(INOUT) :: N
 REAL(KIND=DP_KIND),INTENT(IN) :: X1,X2,Y1,Y2
 REAL(KIND=DP_KIND) :: DXY,X1ISG,X2ISG,Y1ISG,Y2ISG 

 !## length of vertex along line-spotted
 DXY=SQRT((X2-X1)**2.0D0+(Y2-Y1)**2.0D0); IF(DXY.EQ.0.0D0)RETURN
 
 X1ISG=X1; X2ISG=X2; Y1ISG=Y1; Y2ISG=Y2
 IF(PROFIDF(IIDF)%IDF%IEQ.EQ.0)THEN
  !## intersect line with rectangular-regular-grid
  CALL INTERSECT_EQUI(PROFIDF(IIDF)%IDF%XMIN,PROFIDF(IIDF)%IDF%XMAX,PROFIDF(IIDF)%IDF%YMIN, &
                      PROFIDF(IIDF)%IDF%YMAX,PROFIDF(IIDF)%IDF%DX,PROFIDF(IIDF)%IDF%DY,     &
                      X1ISG,X2ISG,Y1ISG,Y2ISG,N,.FALSE.) !,.TRUE.)
 ELSE
  !## intersect line with rectangular-irregular-grid
  CALL INTERSECT_NONEQUI(PROFIDF(IIDF)%IDF%SX,PROFIDF(IIDF)%IDF%SY,PROFIDF(IIDF)%IDF%NROW, &
                      PROFIDF(IIDF)%IDF%NCOL,X1ISG,X2ISG,Y1ISG,Y2ISG,N,.FALSE.) !,.TRUE.)
 ENDIF

 END SUBROUTINE PROFILE_PROFINTERSECTLINE

 !###======================================================================
 SUBROUTINE PROFILE_PROFSPOTLINE_SYNC()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,N
 REAL(KIND=DP_KIND) :: X1,X2,F,Z
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XT
 
 !## no colouring active
 IF(ICCOL.EQ.0)RETURN
 
 N=SUM(SERIE%N); ALLOCATE(XT(N)); K=0
 DO I=1,SIZE(SERIE)
  DO J=1,SERIE(I)%N
   K=K+1; XT(K)=SERIE(I)%X(J)
  ENDDO
 ENDDO

 CALL UTL_GETUNIQUE(XT,K,N)
 
 !## create arrays with n-length
 DO I=1,SIZE(SERIE); ALLOCATE(SERIE(I)%COPX(N),SERIE(I)%COPY(N)); ENDDO

 !## fill in data
 DO I=1,SIZE(SERIE)

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

  X1=SERIE(I)%X(1); X2=SERIE(I)%X(2)
  J=1; K=2
  DO
 
   IF(X1.LE.XT(J).AND.X2.GE.XT(J+1))THEN
    IF(SERIE(I)%Y(K-1).NE.PROFIDF(I)%IDF%NODATA.AND. &
       SERIE(I)%Y(K)  .NE.PROFIDF(I)%IDF%NODATA)THEN
     !## get value for colouring
     IF(IPRF(5).EQ.1)THEN
      Z=SERIE(I)%Y(K-1)
     !## interpolate top/bot
     ELSE
      F=(XT(J)-X1)/(X2-X1)
      Z=SERIE(I)%Y(K-1)+F*(SERIE(I)%Y(K)-SERIE(I)%Y(K-1))
     ENDIF
    ELSE
     Z=PROFIDF(I)%IDF%NODATA
    ENDIF
    SERIE(I)%COPX(J)=XT(J)
    SERIE(I)%COPY(J)=Z
    J=J+1; IF(J.GT.N)EXIT

   ELSE 

    K=K+1
    !## fill rest with nodata
    IF(K.GT.SERIE(I)%N)THEN
     DO
      SERIE(I)%COPX(J)=XT(J)
      SERIE(I)%COPY(J)=PROFIDF(I)%IDF%NODATA
      J=J+1; IF(J.GT.N)EXIT
     ENDDO
     EXIT
    ELSE
     X1=X2
     X2=SERIE(I)%X(K) 
    ENDIF

   ENDIF
 
  ENDDO

  DEALLOCATE(SERIE(I)%X,SERIE(I)%Y)
  SERIE(I)%N=N
  SERIE(I)%X=>SERIE(I)%COPX
  SERIE(I)%Y=>SERIE(I)%COPY

 ENDDO
 
 END SUBROUTINE PROFILE_PROFSPOTLINE_SYNC

 !###======================================================================
 SUBROUTINE PROFILE_PROFSPOTLINE(X1,X2,Y1,Y2,IIDF,N,MAXSTEP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIDF
 INTEGER,INTENT(INOUT) :: N
 REAL(KIND=DP_KIND),INTENT(IN) :: X1,X2,Y1,Y2
 INTEGER,INTENT(INOUT) :: MAXSTEP
 REAL(KIND=DP_KIND) :: Z,TLEN,CLEN
 INTEGER :: IROW,ICOL,I,J,ILEN,II,ISTEP

 ILEN=0; TLEN=0.0D0

 !## profile completely outside current view -- make sure you use the total length, though!
 IF(N.EQ.0)N=-2
     
 II=SIZE(SERIE(IIDF)%X)
 !## add 4 extra for filled-polygons!
 IF(ABS(N)+4.GT.II)THEN
  ALLOCATE(SERIE(IIDF)%COPX(ABS(N)+4),SERIE(IIDF)%COPY(ABS(N)+4))
  DO I=1,II; SERIE(IIDF)%COPX(I)=SERIE(IIDF)%X(I); ENDDO
  DO I=1,II; SERIE(IIDF)%COPY(I)=SERIE(IIDF)%Y(I); ENDDO
  DEALLOCATE(SERIE(IIDF)%X,SERIE(IIDF)%Y)
  SERIE(IIDF)%X=>SERIE(IIDF)%COPX
  SERIE(IIDF)%Y=>SERIE(IIDF)%COPY
 ENDIF

 IF(N.EQ.-2)THEN
  ILEN=ILEN+1
  SERIE(IIDF)%X(ILEN)=TLEN
  SERIE(IIDF)%Y(ILEN)=PROFIDF(IIDF)%IDF%NODATA
  ILEN=ILEN+1
  SERIE(IIDF)%X(ILEN)=TLEN+SQRT((X1-X2)**2.0D0+(Y1-Y2)**2.0D0)
  SERIE(IIDF)%Y(ILEN)=PROFIDF(IIDF)%IDF%NODATA
 ENDIF


 IF(N.GT.MXSAMPLING)THEN
  ISTEP=(N/MXSAMPLING)+1; MAXSTEP=MAX(MAXSTEP,ISTEP)
  J=0; DO I=1,N,ISTEP
   J=J+1
   CA(J)=CA(I); RA(J)=RA(I); XA(J)=XA(I); YA(J)=YA(I)
   LN(J)=SUM(LN(I:MIN(N,I+ISTEP-1)))
  ENDDO
  N=J
 ENDIF
   
 DO I=0,N+1

  J=MIN(MAX(1,I),N); ICOL=CA(J); IROW=RA(J)

  CLEN=0.0D0; IF(I.GT.0.AND.I.LE.N)CLEN=LN(I)/2.0D0
  IF(I.GT.1)CLEN=CLEN+LN(I-1)/2.0D0
  
  TLEN=TLEN+CLEN
  
  IF(ICOL.GE.1.AND.ICOL.LE.PROFIDF(IIDF)%IDF%NCOL.AND. &
     IROW.GE.1.AND.IROW.LE.PROFIDF(IIDF)%IDF%NROW)THEN
   !## get idf values
   Z=IDFGETVAL(PROFIDF(IIDF)%IDF,IROW,ICOL,PROFIDF(IIDF)%UNITS)
  ELSE
   Z=PROFIDF(IIDF)%IDF%NODATA
  ENDIF

  !## skip short intersection to avoid line jagging
  IF(ISKIPSHORTS.EQ.1.AND.CLEN.LT.(0.75D0*SQRT(IDFGETAREA(PROFIDF(IIDF)%IDF,ICOL,IROW))))CYCLE
  
  ILEN=ILEN+1
  SERIE(IIDF)%X(ILEN)=TLEN
  SERIE(IIDF)%Y(ILEN)=Z

 END DO
   
 SERIE(IIDF)%N=ILEN
 
 END SUBROUTINE PROFILE_PROFSPOTLINE
 
 !###======================================================================
 SUBROUTINE PROFILE_BACKGROUND_BITMAP_READ()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IW,IH,I
 
 IF(PBITMAP%IBITMAP.GT.0)THEN; CALL WBITMAPDESTROY(PBITMAP%IBITMAP); PBITMAP%IBITMAP=0; ENDIF

 IW=0; IH=0
 DO I=1,SIZE(IWINPROFILE)
  IW=MAX(IW,WINFOBITMAP(PRF_IBITMAP(I),BITMAPWIDTH))
  IH=MAX(IH,WINFOBITMAP(PRF_IBITMAP(I),BITMAPHEIGHT))
 ENDDO
 
 CALL WBITMAPCREATE(PBITMAP%IBITMAP,IW,IH)
 PBITMAP%IW=IW; PBITMAP%IH=IH
 CALL WBITMAPSTRETCHMODE(STRETCHHALFTONE)
 CALL WBITMAPLOAD(PBITMAP%IBITMAP,PBITMAP%FNAME,1)
 
 PBITMAP%IACT=1
 
 END SUBROUTINE PROFILE_BACKGROUND_BITMAP_READ

 !###====================================================================
 SUBROUTINE PROFILE_PUTBITMAP(IBITMAP2D)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBITMAP2D
 REAL(KIND=DP_KIND) :: R1,R2,F
 INTEGER :: IW,IH

 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL IGRSELECT(DRAWFIELD,IDF_PICTURE1)

 IW=WINFODIALOGFIELD(IDF_PICTURE1,FIELDWIDTH)
 IH=WINFODIALOGFIELD(IDF_PICTURE1,FIELDHEIGHT)

 R1=REAL(IW)/REAL(IH)
 R2=REAL(MPW%DIX)/REAL(MPW%DIY)

 AREA(1)=0.0D0
 AREA(2)=0.0D0
 AREA(3)=1.0D0
 AREA(4)=1.0D0

 !## bitmap is wider than window - adjust y
 IF(R2.GT.R1)THEN
  F      = REAL(MPW%DIY)/(REAL(MPW%DIX)/REAL(IW))
  F      = F/REAL(IH)
  F      =(1.0D0-F)/2.0D0
  AREA(2)= F       !ymin
  AREA(4)= 1.0D0-F   !ymax
 !## bitmap is smaller than window - adjust x
 ELSE
  F      = REAL(MPW%DIX)/(REAL(MPW%DIY)/REAL(IH))
  F      = F/REAL(IW)
  F      =(1.0D0-F)/2.0D0
  AREA(1)= F       !xmin
  AREA(3)= 1.0D0-F   !xmax
 ENDIF

 !## plot/update survey crosssection
 CALL PROFILE_PLOTSURVEY(.FALSE.)

 CALL WDIALOGSELECT(ID_DSERIESTAB1)
 CALL IGRSELECT(DRAWFIELD,IDF_PICTURE1)
 CALL DBL_IGRAREA(AREA(1),AREA(2),AREA(3),AREA(4))
 CALL WBITMAPPUT(IBITMAP2D,2,1)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

 END SUBROUTINE PROFILE_PUTBITMAP

 !###======================================================================
 SUBROUTINE PROFILE_PLOTSURVEY(LPS)
 !###======================================================================
 IMPLICIT NONE
 LOGICAL ,INTENT(IN) :: LPS
 REAL(KIND=DP_KIND) :: XP1,XP2,YP1,YP2,SX_RATIO,SXYRATIO,BITMAPRATIO
 REAL(KIND=DP_KIND) :: DX,DY,XA1,XA2,YA1,YA2,XU1,XU2,YU1,YU2
 INTEGER :: IWD,IHD,IWS,ISURVEY,IWINID 
 CHARACTER(LEN=256) :: FNAME

 !## store previous settings
 XA1=WINFOGRREAL(GRAPHICSAREAMINX); XA2=WINFOGRREAL(GRAPHICSAREAMAXX)
 YA1=WINFOGRREAL(GRAPHICSAREAMINY); YA2=WINFOGRREAL(GRAPHICSAREAMAXY)
 XU1=WINFOGRREAL(GRAPHICSUNITMINX); XU2=WINFOGRREAL(GRAPHICSUNITMAXX)
 YU1=WINFOGRREAL(GRAPHICSUNITMINY); YU2=WINFOGRREAL(GRAPHICSUNITMAXY)

 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK5,ISURVEY)
 IF(ISURVEY.EQ.0)RETURN
 
 !## nothing drawn yet, 
 IF(.NOT.ALLOCATED(IWINPROFILE))RETURN
 
 CALL IGRSELECT(DRAWBITMAP,MPW%IBITMAP)
 IWD=WINFODRAWABLE(DRAWABLEWIDTH)
 IHD=WINFODRAWABLE(DRAWABLEHEIGHT)
 BITMAPRATIO=REAL(IHD)/REAL(IWD)

 DO IWINID=1,SIZE(IWINPROFILE)
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  !## drawable settings
  IWD=WINFODRAWABLE(DRAWABLEWIDTH)
  IHD=WINFODRAWABLE(DRAWABLEHEIGHT)
  !## screen setting
  IWS=WINFOSCREEN(SCREENWIDTH)
  !## ratio's
  SX_RATIO=REAL(IWS)/REAL(IWD)
  SXYRATIO=REAL(IWD)/REAL(IHD)

  CALL IGRSELECT(DRAWBITMAP,PRF_IBITMAP(IWINID))

  XP1=XSURVEY(1) 
  XP2=XSURVEY(2) 
  YP1=YSURVEY(1) 
  YP2=YSURVEY(2) 

  DX=(XP2-XP1)/50.0D0
  DY=(YP2-YP1)/50.0D0*SXYRATIO
 
  CALL IGRPLOTMODE(MODECOPY)
  CALL DBL_IGRAREA(XP1,YP1,XP2,YP2)

  CALL DBL_IGRUNITS(0.0D0,0.0D0,1.0D0,1.0D0)
  CALL IGRFILLPATTERN(SOLID)
  CALL IGRCOLOURN(WRGB(255,255,255))
  CALL DBL_IGRRECTANGLE(0.0D0,0.0D0,1.0D0,1.0D0)
  CALL IGRFILLPATTERN(OUTLINE)
  CALL IGRCOLOURN(WRGB(0,0,0))
  CALL DBL_IGRRECTANGLE(0.0D0,0.0D0,1.0D0,1.0D0)
  CALL DBL_IGRAREA(XP1+DX,YP1+DY,XP2-DX,YP2-DY)

  CALL WBITMAPPUT(MPW%IBITMAP,2,1)

  IF(LPS)THEN
   FNAME=TRIM(PREFVAL(1))//'\tmp\tmp.bmp'
   CALL WBITMAPSAVE(MPW%IBITMAP,FNAME)
   CALL IGRLOADIMAGE(FNAME)
  ENDIF
  
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  CALL WBITMAPPUT(PRF_IBITMAP(IWINID),0,1)  
 
 ENDDO
 
 CALL DBL_IGRAREA(XA1,YA1,XA2,YA2)
 CALL DBL_IGRUNITS(XU1,YU1,XU2,YU2)
 
 IF(LPS)CALL IOSDELETEFILE(FNAME)
 
 END SUBROUTINE PROFILE_PLOTSURVEY

 !###======================================================================
 SUBROUTINE PROFILE_PLOTSURVEY_MOUSEMOVE(X,Y,CRDITYPE,ICRD)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: X,Y
 INTEGER,INTENT(OUT) :: CRDITYPE,ICRD
 INTEGER :: ISURVEY,IWINID
 REAL(KIND=DP_KIND) :: DX,XC,YC,WD,HD !WC,HC,WA,HA
 REAL(KIND=DP_KIND),DIMENSION(2) :: XCRD,YCRD

 CRDITYPE=0; ICRD=0
 
 CALL WDIALOGSELECT(ID_DSERIESPROPTAB3)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK5,ISURVEY)
 IF(ISURVEY.EQ.0)RETURN
 
 DO IWINID=1,SIZE(IWINPROFILE)
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  WD=REAL(WINFODRAWABLE(DRAWABLEWIDTH),8)
  HD=REAL(WINFODRAWABLE(DRAWABLEHEIGHT),8)
  EXIT
 ENDDO

 XC=X/WD
 YC=(HD-Y)/HD

 XCRD(1)=XSURVEY(1); YCRD(1)=YSURVEY(1)
 XCRD(2)=XSURVEY(2); YCRD(2)=YSURVEY(2)

 DX=0.01D0 !## 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(2),XC,YC).LE.DX)ICRD=6 !## urc
 IF(UTL_DIST(XCRD(2),YCRD(1),XC,YC).LE.DX)ICRD=7 !## lrc
 IF(UTL_DIST(XCRD(1),YCRD(1),XC,YC).LE.DX)ICRD=8 !## llc
 IF(UTL_DIST(XCRD(1),YCRD(2),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

 CALL WCURSORSHAPE(CURARROW)

 END SUBROUTINE PROFILE_PLOTSURVEY_MOUSEMOVE
 
 !###======================================================================
 SUBROUTINE PROFILE_PLOTSURVEY_ADJUST(XC,YC,CRDITYPE) 
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 INTEGER,INTENT(IN) :: CRDITYPE
 INTEGER :: IWINID
 REAL(KIND=DP_KIND) :: DX,DY,WD,HD
 
 DO IWINID=1,SIZE(IWINPROFILE)
  CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
  WD=REAL(WINFODRAWABLE(DRAWABLEWIDTH),8)
  HD=REAL(WINFODRAWABLE(DRAWABLEHEIGHT),8)
  EXIT
 ENDDO

 !## fraction of screen to pixels
 
 DX=XC-LMBXPIX
 DY=LMBYPIX-YC

 DX=DX/WD
 DY=DY/HD

 SELECT CASE (CRDITYPE)
  CASE (1) !## bottom  
   YSURVEY(2)=YSURVEY(2)+DY
  CASE (2) !## right
   XSURVEY(2)=XSURVEY(2)+DX
  CASE (3) !## top
   YSURVEY(1)=YSURVEY(1)+DY
  CASE (4) !## left
   XSURVEY(1)=XSURVEY(1)+DX
  CASE (5) !## move
   XSURVEY(1)=XSURVEY(1)+DX
   XSURVEY(2)=XSURVEY(2)+DX
   YSURVEY(1)=YSURVEY(1)+DY
   YSURVEY(2)=YSURVEY(2)+DY
  CASE (6) !## urc
   XSURVEY(2)=XSURVEY(2)+DX
   YSURVEY(2)=YSURVEY(2)+DY
  CASE (7) !## lrc
   XSURVEY(2)=XSURVEY(2)+DX
   YSURVEY(1)=YSURVEY(1)+DY
  CASE (8) !## llc
   XSURVEY(1)=XSURVEY(1)+DX
   YSURVEY(1)=YSURVEY(1)+DY
  CASE (9) !## ulc
   XSURVEY(1)=XSURVEY(1)+DX
   YSURVEY(2)=YSURVEY(2)+DY
 END SELECT
 
 DX=DX*WD
 DY=DY*HD

 LMBXPIX=LMBXPIX+DX; LMBYPIX=LMBYPIX-DY 

 END SUBROUTINE PROFILE_PLOTSURVEY_ADJUST

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

 !## inside bitmap area=0.0D0,0.0D0,1.0D0,1.0D0
 CALL IGRSELECT(DRAWBITMAP,MPW%IBITMAP)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRLINETYPE(SOLIDLINE)

 END SUBROUTINE PROFILE_EXTENT_2DBITMAP

 !###====================================================================
 SUBROUTINE PROFILE_EXTENT_GRAPH(IWINID)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWINID
 
 CALL WINDOWSELECT(IWINPROFILE(IWINID))
 CALL IGRSELECT(DRAWWIN,IWINPROFILE(IWINID))
 CALL DBL_IGRAREA( GRAPHAREA(1,1) ,GRAPHAREA(2,1) ,GRAPHAREA(3,1) ,GRAPHAREA(4,1))
 CALL DBL_IGRUNITS(GRAPHUNITS(1,1),GRAPHUNITS(2,1),GRAPHUNITS(3,1),GRAPHUNITS(4,1))
 
 END SUBROUTINE PROFILE_EXTENT_GRAPH

 !###====================================================================
 SUBROUTINE PROFILE_PLOTLOCATION(LINEWIDTHPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: LINEWIDTHPLOT
 REAL(KIND=DP_KIND) :: X,Y,RADIUS

 IF(XPOSPROF.EQ.0.0D0)RETURN

 RADIUS=SQRT((MPW%XMAX-MPW%XMIN)**2.0D0+(MPW%YMAX-MPW%YMIN)**2.0D0)/100.0D0
 IF(PROFILE_GETLOCATION(X,Y,XPOSPROF))THEN
  CALL IGRFILLPATTERN(OUTLINE)
  CALL IGRLINEWIDTH(LINEWIDTHPLOT)
  CALL DBL_IGRCIRCLE(X,Y,RADIUS,IOFFSET=1)
  CALL IGRLINEWIDTH(1)
 ENDIF
 
 END SUBROUTINE PROFILE_PLOTLOCATION

 !###====================================================================
 LOGICAL FUNCTION PROFILE_GETLOCATION(X,Y,XP,ISEG)
 !###====================================================================
 !##
 !## based upon the value of xpos, return x,y coordinates
 !##
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: XP
 REAL(KIND=DP_KIND),INTENT(OUT) :: X,Y
 INTEGER,INTENT(OUT),OPTIONAL :: ISEG
 REAL(KIND=DP_KIND) :: D,TD,RATIO
 INTEGER :: I

 PROFILE_GETLOCATION=.FALSE.

 TD=0.0D0
 DO I=2,NXY
  D =SQRT((XY(1,I)-XY(1,I-1))**2.0D0+(XY(2,I)-XY(2,I-1))**2.0D0)
  TD=TD+D
  !## inside current segment
  IF(TD.GE.XP)THEN
   RATIO=(D-(TD-XP))/D
   IF(RATIO.GT.0.0D0)THEN
    X=XY(1,I-1)+RATIO*(XY(1,I)-XY(1,I-1))
    Y=XY(2,I-1)+RATIO*(XY(2,I)-XY(2,I-1))
   ELSE
    X=XY(1,I-1)
    Y=XY(2,I-1)
   ENDIF
   PROFILE_GETLOCATION=.TRUE.
   IF(PRESENT(ISEG))ISEG=I; EXIT
  ENDIF
 END DO

 END FUNCTION PROFILE_GETLOCATION

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

 IF(ALLOCATED(KPLOT))  DEALLOCATE(KPLOT)
 IF(ALLOCATED(MPLOT))  DEALLOCATE(MPLOT)
 IF(ALLOCATED(KU))     DEALLOCATE(KU)
 IF(ASSOCIATED(XY))     DEALLOCATE(XY)
 IF(ASSOCIATED(XYLABEL))DEALLOCATE(XYLABEL)
 IF(ALLOCATED(SERIE))THEN
  DO I=1,MXNIDF
   IF(ASSOCIATED(SERIE(I)%X))DEALLOCATE(SERIE(I)%X)
   IF(ASSOCIATED(SERIE(I)%Y))DEALLOCATE(SERIE(I)%Y)
   NULLIFY(SERIE(I)%X)
   NULLIFY(SERIE(I)%Y)
  END DO
  DEALLOCATE(SERIE)
 ENDIF
 IF(ALLOCATED(LISEL))DEALLOCATE(LISEL)
 CALL INTERSECT_DEALLOCATE()

 IF(ALLOCATED(PROFIDF))THEN
  DO I=1,SIZE(PROFIDF)
   CALL IDFDEALLOCATEX(PROFIDF(I)%IDF)
!   CALL LEG_DEALLOCATE(PROFIDF(I)%LEG)
  ENDDO
  DEALLOCATE(PROFIDF)
 ENDIF
 IF(ALLOCATED(PROFNIDF))DEALLOCATE(PROFNIDF)

 CALL PROFILE_CLOSEWINDOWS()

 END SUBROUTINE PROFILE_DEALLOCATE
 
 !###====================================================================
 SUBROUTINE PROFILE_CLOSEWINDOWS()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I
  
 !## remove existing windows
 IF(ALLOCATED(IWINPROFILE))THEN
  DO I=1,SIZE(IWINPROFILE); CALL WINDOWCLOSECHILD(IWINPROFILE(I)); ENDDO
  DEALLOCATE(IWINPROFILE)
 ENDIF
 IF(ALLOCATED(PRF_IBITMAP))THEN
  DO I=1,SIZE(PRF_IBITMAP)
   IF(PRF_IBITMAP(I).NE.0)CALL WBITMAPDESTROY(PRF_IBITMAP(I))
  ENDDO
  DEALLOCATE(PRF_IBITMAP)
 ENDIF
 
 IF(ALLOCATED(GRAPHUNITS))DEALLOCATE(GRAPHUNITS)
 IF(ALLOCATED(GRAPHAREA))DEALLOCATE(GRAPHAREA)
 
 END SUBROUTINE PROFILE_CLOSEWINDOWS

 !###======================================================================
 SUBROUTINE PROFILE_CLOSE()
 !###======================================================================
 IMPLICIT NONE
 
 CALL PROFILE_COPYINFO()

 !## copy settings for background-bitmap
 IF(ALLOCATED(SPF))THEN
  IF(ISPF.GT.0.AND.ISPF.LE.SIZE(SPF))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
  ENDIF
 ENDIF

 IF(PBITMAP%IACT.NE.0)CALL WBITMAPDESTROY(PBITMAP%IBITMAP); PBITMAP%IACT=0
 
 !## deallocate memory
 CALL PROFILE_DEALLOCATE()
 IF(ALLOCATED(IPIPET))DEALLOCATE(IPIPET)
 NPIPET=0

 !## close all files
 CALL UTL_CLOSEUNITS()

 CALL WDIALOGSELECT(ID_DSERIES); CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_DSERIESMOVIE); CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_DIPFINFO); CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_DSERIESLEGEND); CALL WDIALOGUNLOAD()

 CALL WINDOWSELECT(0); CALL WMENUSETSTATE(ID_PROFILE,2,0)

 CALL PROFILE_FIELDSMAINMENU(1)

! CALL MANAGER_UTL_UPDATE()
 CALL UTL_HIDESHOWDIALOG(ID_DMANAGER,2)

 !## reset to entire window
 CALL WINDOWSELECT(MPW%IWIN)
 CALL WINDOWSIZEPOS(ISTATE=WINMAXIMISED)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)
 
 CALL WINDOWSELECT(0)
 CALL WINDOWOUTSTATUSBAR(2,'')
 CALL WINDOWOUTSTATUSBAR(3,'')
 CALL WINDOWOUTSTATUSBAR(4,'')

 END SUBROUTINE PROFILE_CLOSE

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

 CALL WINDOWSELECT(0)
 IF(WMENUGETSTATE(ID_FILE,1).NE.I)    CALL WMENUSETSTATE(ID_FILE,1,I)
 IF(WMENUGETSTATE(ID_EDIT,1).NE.I)    CALL WMENUSETSTATE(ID_EDIT,1,I)
 IF(WMENUGETSTATE(ID_VIEW,1).NE.I)    CALL WMENUSETSTATE(ID_VIEW,1,I)
 IF(WMENUGETSTATE(ID_MAP,1).NE.I)     CALL WMENUSETSTATE(ID_MAP,1,I)
 IF(WMENUGETSTATE(ID_TOOLBOX,1).NE.I) CALL WMENUSETSTATE(ID_TOOLBOX,1,I)
 IF(WMENUGETSTATE(ID_HELPMAIN,1).NE.I)CALL WMENUSETSTATE(ID_HELPMAIN,1,I)

 IF(WMENUGETSTATE(ID_NEW,1).NE.I)CALL WMENUSETSTATE(ID_NEW,1,I)
 IF(WMENUGETSTATE(ID_OPEN,1).NE.I)CALL WMENUSETSTATE(ID_OPEN,1,I)
 IF(WMENUGETSTATE(ID_SAVE,1).NE.I)CALL WMENUSETSTATE(ID_SAVE,1,I)
 IF(WMENUGETSTATE(ID_SAVEAS,1).NE.I)CALL WMENUSETSTATE(ID_SAVEAS,1,I)
 IF(WMENUGETSTATE(ID_COPY,1).NE.I)CALL WMENUSETSTATE(ID_COPY,1,I)
 IF(WMENUGETSTATE(ID_MANAGER,1).NE.I)CALL WMENUSETSTATE(ID_MANAGER,1,I)
 IF(WMENUGETSTATE(ID_ZOOMINMAP,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMINMAP,1,I)
 IF(WMENUGETSTATE(ID_ZOOMOUTMAP,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMOUTMAP,1,I)

!! IF(ZM%IZOOM
! IF(WMENUGETSTATE(ID_ZOOMPREVIOUS,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMPREVIOUS,1,I)
! IF(WMENUGETSTATE(ID_ZOOMNEXT,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMNEXT,1,I)

 IF(WMENUGETSTATE(ID_ZOOMFULLMAP,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMFULLMAP,1,I)
 IF(WMENUGETSTATE(ID_ZOOMRECTANGLEMAP,1).NE.I)CALL WMENUSETSTATE(ID_ZOOMRECTANGLEMAP,1,I)
 IF(WMENUGETSTATE(ID_MOVEMAP,1).NE.I)CALL WMENUSETSTATE(ID_MOVEMAP,1,I)
 IF(WMENUGETSTATE(ID_REDRAW,1).NE.I)CALL WMENUSETSTATE(ID_REDRAW,1,I)

 IF(I.EQ.0)THEN
  IF(WMENUGETSTATE(ID_PROFILE,1).NE.I)CALL WMENUSETSTATE(ID_PROFILE,1,I)
  IF(WMENUGETSTATE(ID_3DTOOL,1).NE.I)CALL WMENUSETSTATE(ID_3DTOOL,1,I)
  IF(WMENUGETSTATE(ID_TOPOGRAPHY,1).NE.I)CALL WMENUSETSTATE(ID_TOPOGRAPHY,1,I)
  IF(WMENUGETSTATE(ID_IMODINFO,1).NE.I)CALL WMENUSETSTATE(ID_IMODINFO,1,I)
  IF(WMENUGETSTATE(ID_TIMESERIES,1).NE.I)CALL WMENUSETSTATE(ID_TIMESERIES,1,I)
  IF(WMENUGETSTATE(ID_MOVIE_CREATE,1).NE.I)CALL WMENUSETSTATE(ID_MOVIE_CREATE,1,I)
  IF(WMENUGETSTATE(ID_OPENIDF,1).NE.I)CALL WMENUSETSTATE(ID_OPENIDF,1,I)
 ENDIF
 IF(WMENUGETSTATE(ID_DISTANCE,1).NE.I)CALL WMENUSETSTATE(ID_DISTANCE,1,I)

 IF(I.EQ.1)CALL MANAGER_UTL_UPDATE()

 END SUBROUTINE PROFILE_FIELDSMAINMENU

END MODULE MOD_PROFILE_UTL