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

USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE MOD_PREF_PAR, ONLY : PREFVAL

USE IMODVAR
USE MOD_COLOURS
USE MOD_IDF, ONLY : IDFREAD,IDFGETVAL,IDFDEALLOCATEX
USE MOD_MDF, ONLY : READMDF,MDFDEALLOCATE,MDF,WRITEMDF
USE MOD_UTL, ONLY : ITOS,RTOS,UTL_WAITMESSAGE,UTL_GETUNIQUE,UTL_GETUNIT,UTL_CREATEDIR,UTL_MESSAGEHANDLE,UTL_IDFCURDIM,UTL_WSELECTFILE, &
    UTL_FILLARRAY,UTL_READARRAY,UTL_GETFORMAT,UTL_GETAXESCALES,SXVALUE,NSX,UTL_GETUNIQUE_POINTER,UTL_EQUALS_REAL
USE MOD_POLINT, ONLY : POL1LOCATE
USE MOD_LEGEND_UTL, ONLY : LEG_READ,LEG_WRITE,LEG_ALLOCATE
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_GRAPH, ONLY : GRAPH,GRAPH_PLOT,GRAPH_DEALLOCATE,GRAPH_ALLOCATE
USE MOD_QKSORT

INTEGER,DIMENSION(MXCGRAD) :: ID1,ID2,ID3

DATA    (ID1(ICGRAD),ICGRAD=1,MXCGRAD) /IDF_REAL1,IDF_REAL2,IDF_REAL3,IDF_REAL4, &
                                        IDF_REAL5,IDF_REAL6,IDF_REAL7/
DATA    (ID2(ICGRAD),ICGRAD=1,MXCGRAD) /IDF_CHECK1,IDF_CHECK2,IDF_CHECK3,IDF_CHECK4, &
                                        IDF_CHECK5,IDF_CHECK6,IDF_CHECK7/
DATA    (ID3(ICGRAD),ICGRAD=1,MXCGRAD) /IDF_INTEGER1,IDF_INTEGER2,IDF_INTEGER3,IDF_INTEGER4, &
                                        IDF_INTEGER5,IDF_INTEGER6,IDF_INTEGER7/

INTEGER,DIMENSION(7),PRIVATE :: IPOS

CONTAINS

 !###====================================================================
 SUBROUTINE LEG_MAIN(CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: CODE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,IPLOT,IROW,ICOL,IRGB,IOS,N,IOPTION,NLEG,LTYPE,I
 REAL :: XINT,DX,X1,X2,X3,X4
 CHARACTER(LEN=256) :: IDFNAME
 INTEGER,DIMENSION(4) :: IP
  
 !## copy legend from 
 IF(CODE.EQ.-1)THEN
  CALL WDIALOGSELECT(ID_DMANAGERTAB1)
  CALL WDIALOGGETMENU(ID_DMTABMENU,ACTLIST)
  IF(SUM(ACTLIST).GT.1)THEN; CALL LEG_COPYFROM(); RETURN; ENDIF
 ELSEIF(CODE.EQ.0)THEN
  CALL WDIALOGSELECT(ID_DMANAGERTAB1)
  CALL WDIALOGGETMENU(ID_DMTABMENU,ACTLIST)
  DO IPLOT=1,MXMPLOT; IF(ACTLIST(IPLOT).EQ.1)EXIT; END DO
 ELSE
  IPLOT=CODE
 ENDIF

 !## make copy of legend
 CALL LEG_COPY(IPLOT,1)
 !## initialise legend dialog
 CALL LEG_INIT()
 
 IF(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5)THEN
  CALL WDIALOGSELECT(ID_DLEGTAB1); CALL WDIALOGFIELDSTATE(ID_HISTOGRAM,1)
  CALL WDIALOGSELECT(ID_DLEGTAB2); CALL WDIALOGFIELDSTATE(ID_HISTOGRAM,1)
 ELSE
  CALL WDIALOGSELECT(ID_DLEGTAB1); CALL WDIALOGFIELDSTATE(ID_HISTOGRAM,0)
  CALL WDIALOGSELECT(ID_DLEGTAB2); CALL WDIALOGFIELDSTATE(ID_HISTOGRAM,0)
 ENDIF

 !## turn off min/max
 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK8,0)
 
 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGSHOW(-1,-1,1,3)
 
 CALL UTL_FILLARRAY(IP,4,MP(IPLOT)%IDFKIND)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,IP(1))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,IP(2))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,IP(3))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,IP(4))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MP(IPLOT)%THICKNESS)
 
 !## put/plot legend values in dialog and plot in case 256 legend
 CALL LEG_PUT(IPLOT)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (MESSAGE%WIN)

   !## main legend dialog
   CASE (ID_DLEGEND)

    SELECT CASE (ITYPE)
     CASE(TABCHANGED)
      !## new tab
      SELECT CASE (MESSAGE%VALUE2)
       !## goto classes
       CASE (ID_DLEGTAB1)
        NLEG=MP(IPLOT)%LEG%NCLR
        CALL LEG_GETNOCLASSES(IPLOT,LTYPE,IOPTION,XINT,NLEG)
        IF(MP(IPLOT)%LEG%NCLR.GT.0)THEN
         !## generate legend
         CALL LEG_SAMPLE_CLASSES(IPLOT,LTYPE,IOPTION,NLEG,XINT)
         CALL LEG_PUT(IPLOT) 
        ELSE
         MP(IPLOT)%LEG%NCLR=MXCLR
         CALL WDIALOGSELECT(ID_DLEGEND); CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB2)
        ENDIF
       !## goto stretched
       CASE (ID_DLEGTAB2)
        !## put classes to be used later for legend in leg_get()
        CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,1)
        X4=MP(IPLOT)%LEG%CLASS(0)
        X3=MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)
        DX=(X4-X3)/REAL(MXCGRAD-1)
        MP(IPLOT)%LEG%CGRAD=1; X2=X4
        DO I=2,MXCGRAD-1
         IF(IPOS(I).EQ.IPOS(I-1))MP(IPLOT)%LEG%CGRAD(I)=0
         X1=X2-DX*REAL(I-1)
         MP(IPLOT)%LEG%CLASS(IPOS(I)-1)=X1
        ENDDO
        MP(IPLOT)%LEG%CLASS(0)=X4
        MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)=X3
        !## generate legend
        IPOS(MXCGRAD)=MP(IPLOT)%LEG%NCLR+1
        CALL LEG_SAMPLE_STRETCHED(IPLOT,0)
        MP(IPLOT)%LEG%NCLR=MXCLR
        CALL LEG_GET(IPLOT); CALL LEG_PUT(IPLOT) 
      END SELECT
     CASE(FIELDCHANGED)

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       CASE (ID_SAVE)
        IF(LEG_CHECK(IPLOT))THEN
         IDFNAME=TRIM(PREFVAL(1))//'\legend\'
         IF(UTL_WSELECTFILE('iMOD Legend File (*.leg)|*.leg|', &
              SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,IDFNAME,'Save iMOD Legend file'))THEN
          CALL LEG_GET(IPLOT); CALL LEG_WRITE(MP(IPLOT)%LEG,IDFNAME)
         ENDIF
        ENDIF

       CASE (ID_OPEN)
        IDFNAME=TRIM(PREFVAL(1))//'\LEGEND'
        IF(UTL_WSELECTFILE('iMOD Legend File (*.leg)|*.leg|',&
                 LOADDIALOG+MUSTEXIST+DIRCHANGE+APPENDEXT,IDFNAME,'Load iMOD Legend file'))THEN
         CALL LEG_READ(MP(IPLOT)%LEG,IDFNAME,IOS)
         IF(IOS.EQ.0)CALL LEG_PUT(IPLOT)
        ENDIF

       CASE (ID_PRELEGEND)
        IF(LEG_PREDEFINED())THEN
         CALL LEG_READ(MP(IPLOT)%LEG,TRIM(PREFVAL(1))//'\tmp\tmp.leg',IOS)
         IF(IOS.EQ.0)CALL LEG_PUT(IPLOT)
        ENDIF

       CASE (IDCANCEL)
        CALL LEG_COPY(IPLOT,2)
        EXIT

       CASE (IDOK)
        IF(LEG_CHECK(IPLOT))THEN
         CALL LEG_GET(IPLOT)
         CALL WDIALOGSELECT(ID_DLEGEND)
         CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IP(1))
         CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IP(2))
         CALL WDIALOGGETCHECKBOX(IDF_CHECK3,IP(3))         
         CALL WDIALOGGETCHECKBOX(IDF_CHECK4,IP(4))         
         CALL UTL_READARRAY(IP,4,MP(IPLOT)%IDFKIND)
         CALL WDIALOGGETINTEGER(IDF_INTEGER1,MP(IPLOT)%THICKNESS)       
         CALL WDIALOGHIDE()
         CALL IDFPLOTFAST(1)
         EXIT
        ENDIF

       CASE (IDHELP)
        CALL IMODGETHELP('3.4.5','MMO.AdjustLeg')

      END SELECT
    END SELECT

   !## classes
   CASE (ID_DLEGTAB1)

    SELECT CASE (ITYPE)

     CASE(FIELDCHANGED)
      SELECT CASE (MESSAGE%VALUE2)
       CASE (ID_GRIDLEVELS)
        CALL WDIALOGSELECT(ID_DLEGTAB1)
        CALL WGRIDPOS(MESSAGE%Y,ICOL,IROW)
        IF(ICOL.EQ.3)THEN
         IF(MESSAGE%Y.NE.MESSAGE%X)THEN
          CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,IROW,IRGB)
          CALL WSELECTCOLOUR(IRGB)
          IF(WINFODIALOG(4).EQ.1)CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,IROW,IRGB)
          CALL WGRIDSETCELL(ID_GRIDLEVELS,1,IROW)
         ENDIF
        ELSEIF(ICOL.EQ.1)THEN
         IF(IROW.GT.1)THEN
          CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,IROW,XINT)
          CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,IROW-1,XINT)
         ENDIF
        ENDIF
        CALL LEG_PLOT(IPLOT,0)
        CALL WDIALOGPUTINTEGER(ID_IROW,IROW)
        CALL WDIALOGPUTINTEGER(ID_ICOL,ICOL)
      END SELECT

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       !## add/delete legend levels
       CASE (ID_PLUS,ID_MIN)
        CALL LEG_LEVELS(MESSAGE%VALUE1,IPLOT)
       CASE (ID_FLIP)
        CALL LEG_FLIPLEGEND(ID_DLEGTAB1,IPLOT)
        CALL LEG_PLOT(IPLOT,0)
       CASE (ID_HISTOGRAM)
        CALL LEG_HISTOGRAMLEGEND(IPLOT,1)
       !## update labels
       CASE (IDF_BUTTON5)
        CALL LEG_PLOT(IPLOT,1)
      END SELECT
    END SELECT

   !## 256 colours
   CASE (ID_DLEGTAB2)

    SELECT CASE (ITYPE)

     CASE(EXPOSE)
      CALL LEG_PLOT(IPLOT,0)

     CASE(FIELDCHANGED)
      !## previous
      SELECT CASE (MESSAGE%VALUE1)
!       CASE (IDF_REAL1,IDF_REAL7)
!        CALL LEG_MINMAX(IPLOT)
       CASE (IDF_CHECK1,IDF_CHECK2,IDF_CHECK3,IDF_CHECK4,IDF_CHECK5,IDF_CHECK6,IDF_CHECK7)
        CALL LEG_GET(IPLOT); !CALL LEG_CREATE_COLORS(IPLOT);
        CALL LEG_PUT(IPLOT)
      END SELECT
      !## moved field
      SELECT CASE (MESSAGE%VALUE2)
      !## put in max/min values
       CASE (IDF_CHECK8)
        CALL LEG_MINMAX(IPLOT)
       CASE (IDF_INTEGER1,IDF_INTEGER2,IDF_INTEGER3,IDF_INTEGER4,IDF_INTEGER5,IDF_INTEGER6,IDF_INTEGER7)
        CALL WDIALOGGETINTEGER(MESSAGE%VALUE2,IRGB)
        CALL WSELECTCOLOUR(IRGB)
        IF(WINFODIALOG(4).EQ.1)THEN
         CALL WDIALOGPUTINTEGER(MESSAGE%VALUE2,IRGB)
         CALL WDIALOGCOLOUR(MESSAGE%VALUE2,IRGB,IRGB)
         CALL LEG_GET(IPLOT); !CALL LEG_CREATE_COLORS(IPLOT)
         CALL LEG_PLOT(IPLOT,0)
        ENDIF
      END SELECT

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       CASE (ID_DEFAULT)
        CALL LEG_DEFAULT(IPLOT)
        CALL LEG_PUT(IPLOT)
       CASE (ID_FLIP)
        CALL LEG_FLIPLEGEND(ID_DLEGTAB2,IPLOT)
        CALL LEG_PUT(IPLOT)
       CASE (ID_HISTOGRAM)
        CALL LEG_HISTOGRAMLEGEND(IPLOT,0)
      END SELECT
    END SELECT

  END SELECT

 ENDDO

 !## write legend in mdf file
 IF(MP(IPLOT)%IPLOT.EQ.5)THEN
  IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
   MDF(MP(IPLOT)%NLIDF)%LEG%NCLR   =MP(IPLOT)%LEG%NCLR
   MDF(MP(IPLOT)%NLIDF)%LEG%CGRAD  =MP(IPLOT)%LEG%CGRAD
   MDF(MP(IPLOT)%NLIDF)%LEG%CLASS  =MP(IPLOT)%LEG%CLASS
   MDF(MP(IPLOT)%NLIDF)%LEG%LEGTXT =MP(IPLOT)%LEG%LEGTXT
   MDF(MP(IPLOT)%NLIDF)%LEG%RGB    =MP(IPLOT)%LEG%RGB
   IF(WRITEMDF(MP(IPLOT)%IDFNAME,N))CALL MDFDEALLOCATE()
  ENDIF
 ENDIF

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGUNLOAD()

 !## reset to entire window
 CALL IGRSELECT(DRAWWIN,MPW%IWIN)
 CALL IGRAREA(0.0,0.0,1.0,1.0)
 CALL IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)

 END SUBROUTINE LEG_MAIN
 
 !###====================================================================
 SUBROUTINE LEG_INIT()
 !###====================================================================
 IMPLICIT NONE

 CALL WDIALOGLOAD(ID_DLEGEND)
 CALL WDIALOGPUTIMAGE(ID_OPEN,ID_ICONOPEN,1)
 CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVE,1)
 CALL WDIALOGPUTIMAGE(ID_PRELEGEND,ID_ICONLEGEND,1)
 CALL WDIALOGPUTIMAGE(IDF_CHECK1,ID_ICONGRID,1)
 CALL WDIALOGPUTIMAGE(IDF_CHECK2,ID_ICONCONTOUR,1)
 CALL WDIALOGPUTIMAGE(IDF_CHECK3,ID_ICONVECTOR,1)
 CALL WDIALOGPUTIMAGE(IDF_CHECK4,ID_ICONNUMBERS,1)
 CALL WDIALOGSELECT(ID_DLEGTAB1)
 CALL WDIALOGPUTIMAGE(ID_MIN,ID_ICONMIN,1)
 CALL WDIALOGPUTIMAGE(ID_PLUS,ID_ICONPLUS,1)
 CALL WDIALOGPUTIMAGE(ID_FLIP,ID_ICONFLIPCOLOUR,1)
 CALL WDIALOGPUTIMAGE(ID_HISTOGRAM,ID_ICONHISTOGRAM,1)
 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGPUTIMAGE(ID_FLIP,ID_ICONFLIPCOLOUR,1)
 CALL WDIALOGPUTIMAGE(ID_HISTOGRAM,ID_ICONHISTOGRAM,1)
 
 END SUBROUTINE LEG_INIT

 !###====================================================================
 SUBROUTINE LEG_DEFAULT(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT
 INTEGER :: I
 
 !## put colors on dialog
 DO I=1,MXCGRAD
  MP(IPLOT)%LEG%ICLRGRAD(I)=WRGB(CLR(I,1),CLR(I,2),CLR(I,3))
 END DO

 CALL LEG_CREATE_COLORS(IPLOT); CALL LEG_PUT(IPLOT)

 END SUBROUTINE LEG_DEFAULT

 !###====================================================================
 LOGICAL FUNCTION LEG_PREDEFINED()
 !###====================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: MAXLEGEND=7
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,I
 CHARACTER(LEN=104),DIMENSION(MAXLEGEND) :: CLEGEND
 DATA CLEGEND/'GWS_NAP (-6:35)','GWS_SURFLEVEL (0:10)','FLUX_MMD (-1.5:0.05)','RESIDUAL (-2:2)','TRANSMISSIVITY (0:10.000)', &
     'GT (100-802)','FLUXDIFF (0:6)'/ 
 
 LEG_PREDEFINED=.FALSE.

 CALL WDIALOGLOAD(ID_DLEGEND_PREDEFINED,ID_DLEGEND_PREDEFINED)
 CALL WDIALOGPUTMENU(IDF_MENU1,CLEGEND,MAXLEGEND,1)
 CALL WDIALOGSHOW(-1,-1,0,3)
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
    END SELECT

   CASE(PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETMENU(IDF_MENU1,I)
      LEG_PREDEFINED=LEG_PREDEFINED_WRITELEG(I)
      EXIT
     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DLEGEND)
 
 END FUNCTION LEG_PREDEFINED
 
 !###======================================================================
 LOGICAL FUNCTION LEG_PREDEFINED_WRITELEG(ILEG)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILEG
 INTEGER :: IU,IOS

 LEG_PREDEFINED_WRITELEG=.FALSE.
 
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(PREFVAL(1))//'\tmp\tmp.leg',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot create the file'//CHAR(13)//TRIM(PREFVAL(1))//'\tmp\tmp.leg.'//CHAR(13)// &
    'Assign a correct directory for the keyword USER in the used preference file (*.PRF) for iMOD','Error')
  RETURN
 ENDIF
 
 SELECT CASE (ILEG)
  CASE (1) !## gws_nap
   WRITE(IU,'(A)') ' 24,1,1,1,1,1,1,1'
   WRITE(IU,'(A)') 'UPPERBND,LOWERBND,IRED,IGREEN,IBLUE,DOMAIN'
   WRITE(IU,'(A)') '200.0000,35.00000,113,0,0,         "> 35.0m"    '
   WRITE(IU,'(A)') '35.00000,30.00000,160,0,0,         "30.0 - 35.0m"'  
   WRITE(IU,'(A)') '30.00000,25.00000,203,0,0,         "25.0 - 30.0m" ' 
   WRITE(IU,'(A)') '25.00000,20.00000,250,0,0,         "20.0 - 25.0m"  '
   WRITE(IU,'(A)') '20.00000,15.00000,255,27,0,        "15.0 - 20.0m"  '
   WRITE(IU,'(A)') '15.00000,10.00000,255,57,0,        "10.0 - 15.0m"   '
   WRITE(IU,'(A)') '10.00000,7.500000,255,91,0,        "7.5 - 10.0m"   '
   WRITE(IU,'(A)') '7.500000,5.000000,255,124,0,       "5.0 - 7.5m"   '
   WRITE(IU,'(A)') '5.000000,4.000000,255,152,0,       "4.0 - 5.0m"   '
   WRITE(IU,'(A)') '4.000000,3.000000,255,185,0,       "3.0 - 4.0m"   '
   WRITE(IU,'(A)') '3.000000,2.000000,255,215,0,       "2.0 - 3.0m"   '
   WRITE(IU,'(A)') '2.000000,1.000000,255,248,0,       "1.0 - 2.0m"    '
   WRITE(IU,'(A)') '1.000000,0.0000000E+00,206,255,0,  "0.0 - 1.0m"    '
   WRITE(IU,'(A)') '0.0000000E+00,-1.000000,144,255,0, "-1.0 - 0.0m"   '
   WRITE(IU,'(A)') '-1.000000,-2.000000,76,255,0,      "-2.0 - -1.0m"   '
   WRITE(IU,'(A)') '-2.000000,-2.500000,8,255,0,       "-2.5 - -2.0m"    '
   WRITE(IU,'(A)') '-2.500000,-3.000000,1,255,49,      "-3.0 - -2.5m"    '
   WRITE(IU,'(A)') '-3.000000,-3.500000,1,255,117,     "-3.5 - -3.0m"   '
   WRITE(IU,'(A)') '-3.500000,-4.000000,1,255,179,     "-4.0 - -3.5m"   '
   WRITE(IU,'(A)') '-4.000000,-4.500000,1,255,247,     "-4.5 - -4.0m"   '
   WRITE(IU,'(A)') '-4.500000,-5.000000,0,216,236,     "-5.0 - -4.5m"   '
   WRITE(IU,'(A)') '-5.000000,-5.500000,0,173,215,     "-5.5 - -5.0m"   '
   WRITE(IU,'(A)') '-5.500000,-6.000000,0,125,192,     "-6.0 - -5.5m"   '
   WRITE(IU,'(A)') '-6.000000,-200.0000,0,77,169,      "<-6.0m"      '
  CASE (2) !## gws_surface
   WRITE(IU,'(A)') '     24    1    1    1    1    1    1    1'
   WRITE(IU,'(A)') ' UPPER BND LOWER BND      IRED    IGREEN     IBLUE     DOMAIN'
   WRITE(IU,'(A)') ' 200.0      10.00             75          0          0 "> 10.0 m"'
   WRITE(IU,'(A)') ' 10.00      6.000            115          0          0 "6.0-10.0 m"'
   WRITE(IU,'(A)') ' 6.000      4.000            166          0          0 "4.0-6.0 m"'
   WRITE(IU,'(A)') ' 4.000      3.800            191          0          0 "3.8-4.0 m"'
   WRITE(IU,'(A)') ' 3.800      3.600            217          0          0 "3.6-3.8 m"'
   WRITE(IU,'(A)') ' 3.600      3.400            237          0          0 "3.4-3.6 m"'
   WRITE(IU,'(A)') ' 3.400      3.200            255         42          0 "3.2-3.4 m"'
   WRITE(IU,'(A)') ' 3.200      3.000            255         85          0 "3.0-3.2 m"'
   WRITE(IU,'(A)') ' 3.000      2.800            254        115          0 "2.8-3.0 m"'
   WRITE(IU,'(A)') ' 2.800      2.600            254        140          0 "2.6-2.8 m"'
   WRITE(IU,'(A)') ' 2.600      2.400            254        170          0 "2.4-2.6 m"'
   WRITE(IU,'(A)') ' 2.400      2.200            254        191         10 "2.2-2.4 m"'
   WRITE(IU,'(A)') ' 2.200      2.000            254        196         20 "2.0-2.2 m"'
   WRITE(IU,'(A)') ' 2.000      1.800            254        221         51 "1.8-2.0 m"'
   WRITE(IU,'(A)') ' 1.800      1.600            254        255          0 "1.6-1.8 m"'
   WRITE(IU,'(A)') ' 1.600      1.400            254        255        115 "1.4-1.6 m"'
   WRITE(IU,'(A)') ' 1.400      1.200            255        255        190 "1.2-1.4 m"'
   WRITE(IU,'(A)') ' 1.200      1.000            209        255        115 "1.0-1.2 m"'
   WRITE(IU,'(A)') ' 1.000     0.8000            163        255        115 "0.8-1.0 m"'
   WRITE(IU,'(A)') '0.8000     0.6000             85        255          0 "0.6-0.8 m"'
   WRITE(IU,'(A)') '0.6000     0.4000             76        230          0 "0.4-0.6 m"'
   WRITE(IU,'(A)') '0.4000     0.2000             56        168          0 "0.2-0.4 m"'
   WRITE(IU,'(A)') '0.2000      0.000             38        115          0 "0.0-0.2 m"'
   WRITE(IU,'(A)') '0.000     -200.0              0         77        168 "<0.0 m"'
  CASE (3) !## flux mm/d
   WRITE(IU,'(A)') '7     1     0     0     1     0     0     1'
   WRITE(IU,'(A)') 'UPPERBND     LOWERBND     IRED     IGREEN     IBLUE     DOMAIN'
   WRITE(IU,'(A)') '1E31     0.050000     10     28     254     ">0.05 mm/d"'
   WRITE(IU,'(A)') '0.050000     -0.0500000     55     81     255     "-0.05 - 0.05 mm/d"'
   WRITE(IU,'(A)') '-0.0500000     -0.2500000     136     151     255     "-0.25 - -0.05 mm/d"'
   WRITE(IU,'(A)') '-0.2500000     -0.5000000     255     255     187     "-0.50 - -0.25 mm/d"'
   WRITE(IU,'(A)') '-0.5000000     -1.0000000     255     131     128     "-1.0 - -0.50 mm/d"'
   WRITE(IU,'(A)') '-1.0000000     -1.500000     255     0     0     "-1.5 - -1.0 mm/d"'
   WRITE(IU,'(A)') '-1.500000     -1E31     217     0     0     "<-1.5mm/d"  '
  CASE (4) !## residual
   WRITE(IU,'(A)') '   11    1    0    0    0    0    0    1'
   WRITE(IU,'(A)') ' UPPER BND LOWER BND      IRED    IGREEN     IBLUE    DOMAIN'
   WRITE(IU,'(A)') '    1E31     2.000          0         0       115    ">2 m"'
   WRITE(IU,'(A)') '   2.000     1.000         0         0       153    "2 - 1 m"'
   WRITE(IU,'(A)') '  1.000     0.500         0       102       255    "1 - 0.5 m"'
   WRITE(IU,'(A)') '     0.500     0.100         0       204       255    "0.5 - 0.1 m"'
   WRITE(IU,'(A)') '     0.100     0.050       153       255       255    "0.1 - 0.05 m"'
   WRITE(IU,'(A)') '     0.050    -0.050       200       200       200    "0.05 - -0.05 m"'
   WRITE(IU,'(A)') '    -0.050    -0.100       255       255       153    "-0.05 - -0.1 m"'
   WRITE(IU,'(A)') '    -0.100    -0.500       255       204         0    "-0.1 - -0.5 m"'
   WRITE(IU,'(A)') '    -0.500    -1.000       255       102         0    "-0.5 - -1 m"'
   WRITE(IU,'(A)') '    -1.000    -2.00        202         0         0    "-1 - -2 m"'
   WRITE(IU,'(A)') '    -2.000    -1E31        115         0         0    "< -2 m"'
 CASE (5) !## c/kd
   WRITE(IU,'(A)') '31    1    1    1    1    1    1    1'
   WRITE(IU,'(A)') 'UPPERBND    LOWERBND    IRED    IGREEN    IBLUE    DOMAIN'
   WRITE(IU,'(A)') '100000.0    10000.00    98    0    0    "> 10.000"'
   WRITE(IU,'(A)') '10000.00    8000.000    147    0    0    "8.000"'
   WRITE(IU,'(A)') '8000.000    6000.000    166    4    0    "6.000"'
   WRITE(IU,'(A)') '6000.000    4000.000    221    58    11    "4.000"'
   WRITE(IU,'(A)') '4000.000    2500.000    234    117    0    "2.500"'
   WRITE(IU,'(A)') '2500.000    2000.000    234    165    10    "2.000"'
   WRITE(IU,'(A)') '2000.000    1500.000    255    199    6    "1.500"'
   WRITE(IU,'(A)') '1500.000    1000.000    245    222    5    "1.000"'
   WRITE(IU,'(A)') '1000.000    950.0000    252    240    20    "950"'
   WRITE(IU,'(A)') '950.0000    900.0000    255    255    128    "900"'
   WRITE(IU,'(A)') '900.0000    850.0000    225    255    90    "850"'
   WRITE(IU,'(A)') '850.0000    800.0000    195    255    45    "800"'
   WRITE(IU,'(A)') '800.0000    750.0000    166    254    3    "750"'
   WRITE(IU,'(A)') '750.0000    700.0000    80    254    50    "700"'
   WRITE(IU,'(A)') '700.0000    650.0000    4    253    104    "650"'
   WRITE(IU,'(A)') '650.0000    600.0000    3    243    135    "600"'
   WRITE(IU,'(A)') '600.0000    550.0000    5    243    172    "550"'
   WRITE(IU,'(A)') '550.0000    500.0000    57    232    215    "500"'
   WRITE(IU,'(A)') '500.0000    450.0000    96    187    242    "450"'
   WRITE(IU,'(A)') '450.0000    400.0000    110    160    250    "400"'
   WRITE(IU,'(A)') '400.0000    300.0000    128    128    255    "300"'
   WRITE(IU,'(A)') '300.0000    200.0000    128    70    255    "200"'
   WRITE(IU,'(A)') '200.0000    100.0000    128    0    255    "100"'
   WRITE(IU,'(A)') '100.0000    80.00000    139    1    214    "80"'
   WRITE(IU,'(A)') '80.00000    60.00000    160    1    209    "60"'
   WRITE(IU,'(A)') '60.00000    40.00000    194    1    216    "40"'
   WRITE(IU,'(A)') '40.00000    30.00000    235    53    255    "30"'
   WRITE(IU,'(A)') '30.00000    20.00000    255    132    255    "20"'
   WRITE(IU,'(A)') '20.00000    10.00000    255    174    255    "10"'
   WRITE(IU,'(A)') '10.00000    5.000000    255    204    255    "5"'
   WRITE(IU,'(A)') '5.000000    0.0000000E+00    255    225    255    "0"'
  CASE (6) !## gt
   WRITE(IU,'(A)') '   20    1    0    0    0    0    0    1'
   WRITE(IU,'(A)') 'UPPER BND LOWER BND      IRED    IGREEN     IBLUE     DOMAIN'
   WRITE(IU,'(A)') '  802.0      801.0    254        32         0    "GT VIIId"'
   WRITE(IU,'(A)') '  801.0      800.0    254        32         0    "GT VIIIo"'
   WRITE(IU,'(A)') '  800.0      700.0    254        32         0    "GT VIII"'
   WRITE(IU,'(A)') '  700.0      600.0    254       211         0    "GT VII"'
   WRITE(IU,'(A)') '  600.0      502.0    254       254       124    "GT VI"'
   WRITE(IU,'(A)') '  502.0      501.0    170       170        73    "GT Vb"'
   WRITE(IU,'(A)') '  501.0      500.0     88       127        73    "GT Va"'
   WRITE(IU,'(A)') '  500.0      401.0     78       137        63    "GT V"'
   WRITE(IU,'(A)') '  401.0      400.0    170       254        73    "GT IVc"'
   WRITE(IU,'(A)') '  400.0      302.0    170       254        73    "GT IVu"'
   WRITE(IU,'(A)') '  302.0      301.0     25       254        30    "GT IIIb"'
   WRITE(IU,'(A)') '  301.0      300.0     25       170        30    "GT IIIa"'
   WRITE(IU,'(A)') '  300.0      203.0     25       170        30    "GT III"'
   WRITE(IU,'(A)') '  203.0      202.0     50       254       254    "GT IIc"'
   WRITE(IU,'(A)') '  202.0      201.0     50       254       254    "GT IIb"'
   WRITE(IU,'(A)') '  201.0      200.0     25       170       254    "GT IIa"'
   WRITE(IU,'(A)') '  200.0      103.0     25       170       254    "GT II"'
   WRITE(IU,'(A)') '  103.0      101.0     88        76       208    "GT Ic"'
   WRITE(IU,'(A)') '  101.0      100.0     88        76       208    "GT Ia"'
   WRITE(IU,'(A)') '  100.0       99.0     88        76       208    "GT I"'  
  CASE (7) !##fluxdiff
   WRITE(IU,'(A)') '7,1,1,1,1,1,1,1'
   WRITE(IU,'(A)') 'UPPER BND LOWER BND      IRED    IGREEN     IBLUE     DOMAIN'
   WRITE(IU,'(A)') '6.000000,5.000000,255,255,128,"6 Switch Negative to Positive"'
   WRITE(IU,'(A)') '5.000000,4.000000,255,128,255,"5 Switch Positive to Negative"'
   WRITE(IU,'(A)') '4.000000,3.000000,0,255,128,"4 Positive Decrease"'
   WRITE(IU,'(A)') '3.000000,2.000000,0,128,64,"3 Positive Increase"'
   WRITE(IU,'(A)') '2.000000,1.000000,255,128,128,"2 Negative Decrease"'
   WRITE(IU,'(A)') '1.000000,0.0000000E+00,255,0,0,"1 Negative Increase"'
   WRITE(IU,'(A)') '0.0000000E+00,-1.000000,192,192,192,"0 Equal/Too small"'
 END SELECT

 CLOSE(IU)

 LEG_PREDEFINED_WRITELEG=.TRUE.

 END FUNCTION LEG_PREDEFINED_WRITELEG

 !###====================================================================
 SUBROUTINE LEG_HISTOGRAMLEGEND(IPLOT,IGRID)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,IGRID
 INTEGER :: IROW,ICOL,I,IRAT,IRAT1,N
 REAL :: GRD,NHIST
 LOGICAL :: LEX
 CHARACTER(LEN=256) :: FNAME
 
 !## read classes
 CALL LEG_GET(IPLOT)

 !## get idf for mdf file
 LEX=.TRUE.
 IF(MP(IPLOT)%IPLOT.EQ.5)THEN
  FNAME=MP(IPLOT)%IDFNAME
  !## read *.mdf file, only to get selected idf to be plotted
  IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
   MP(IPLOT)%IDFNAME=MDF(MP(IPLOT)%NLIDF)%FNAME
   CALL MDFDEALLOCATE()
  ENDIF
 ENDIF
 IF(.NOT.LEX)RETURN
 IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot read file '//CHAR(13)//TRIM(MP(IPLOT)%IDFNAME),'Error')
  RETURN
 ENDIF

 CALL UTL_MESSAGEHANDLE(0)

 CALL GRAPH_ALLOCATE(1,1)
 ALLOCATE(GRAPH(1,1)%RX(MP(IPLOT)%LEG%NCLR+1))
 ALLOCATE(GRAPH(1,1)%RY(MP(IPLOT)%LEG%NCLR+1))
 GRAPH(1,1)%RX=0.0 !PHIST=0.0
 GRAPH(1,1)%RY=0.0 !NHIST=0.0
 GRAPH(1,1)%NP=MP(IPLOT)%LEG%NCLR+1
 GRAPH(1,1)%GTYPE=1

 NHIST=0.0

 !## compute histogram
 CALL WINDOWSELECT(0)

 IRAT1=0
 DO IROW=1,MP(IPLOT)%IDF%NROW
  DO ICOL=1,MP(IPLOT)%IDF%NCOL
   GRD=IDFGETVAL(MP(IPLOT)%IDF,IROW,ICOL,MP(IPLOT)%UNITS)
   IF(GRD.NE.MP(IPLOT)%IDF%NODATA)THEN
    CALL POL1LOCATE(MP(IPLOT)%LEG%CLASS,MP(IPLOT)%LEG%NCLR,REAL(GRD,8),I)
    IF(I.GT.0.AND.I.LE.MP(IPLOT)%LEG%NCLR)THEN
     GRAPH(1,1)%RY(I)=GRAPH(1,1)%RY(I)+1.0
     NHIST=NHIST+1.0
    ENDIF
   ENDIF
  ENDDO
  CALL UTL_WAITMESSAGE(IRAT,IRAT1,IROW,MP(IPLOT)%IDF%NROW,'Progress Histogram ')
 ENDDO

 CLOSE(MP(IPLOT)%IDF%IU)
 MP(IPLOT)%IDF%IU=0
 CALL IDFDEALLOCATEX(MP(IPLOT)%IDF)

 !## fill in histogram results
 IF(IGRID.EQ.1)CALL WDIALOGSELECT(ID_DLEGTAB1)
 DO I=1,MP(IPLOT)%LEG%NCLR+1
  GRAPH(1,1)%RX(I)= MP(IPLOT)%LEG%CLASS(I-1) 
  IF(I.LE.MP(IPLOT)%LEG%NCLR)THEN
   GRAPH(1,1)%RY(I)=(GRAPH(1,1)%RY(I)*100.0)/NHIST
   IF(IGRID.EQ.1)CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,5,I,GRAPH(1,1)%RY(I)) 
  ENDIF
 END DO

 IF(MP(IPLOT)%IPLOT.EQ.5)MP(IPLOT)%IDFNAME=FNAME

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

 GRAPH(1,1)%LEGTXT='Frequency'
 GRAPH(1,1)%ICLR=WRGB(56,180,176)
 !## display graph
 CALL GRAPH_PLOT('Class','Frequency (%)',.FALSE.,.FALSE.)
 
 CALL GRAPH_DEALLOCATE()

 IF(IGRID.EQ.1)THEN
  CALL WDIALOGSELECT(ID_DLEGTAB1)
  CALL WGRIDSETCELL(ID_GRIDLEVELS,5,1)
 ELSE
  CALL WDIALOGSELECT(ID_DLEGTAB2)
 ENDIF
 
 END SUBROUTINE

 !###====================================================================
 SUBROUTINE LEG_FLIPLEGEND(ITAB,IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,ITAB
 INTEGER :: I,J
 INTEGER,DIMENSION(MXCGRAD) :: ICLR

 IF(ITAB.EQ.ID_DLEGTAB1)THEN

  DO I=1,MP(IPLOT)%LEG%NCLR/2
   ICLR(1)=MP(IPLOT)%LEG%RGB(I)
   MP(IPLOT)%LEG%RGB(I)=MP(IPLOT)%LEG%RGB(MP(IPLOT)%LEG%NCLR-I+1)
   MP(IPLOT)%LEG%RGB(MP(IPLOT)%LEG%NCLR-I+1)=ICLR(1)
  END DO

 ELSEIF(ITAB.EQ.ID_DLEGTAB2)THEN

  !## read current color settings on legend-dialog
  CALL WDIALOGSELECT(ID_DLEGTAB2)
  ICLR=0
  DO I=1,MXCGRAD
   CALL WDIALOGGETCHECKBOX(ID2(I),J)
   CALL WDIALOGGETINTEGER(ID3(I),ICLR(I))
   IF(J.NE.1)ICLR(I)=-1*ICLR(I)
  END DO
  DO I=1,MXCGRAD
   IF(ICLR(MXCGRAD-I+1).GT.0)THEN
    CALL WDIALOGPUTCHECKBOX(ID2(I),1)
   ELSE
    CALL WDIALOGPUTCHECKBOX(ID2(I),0)
   ENDIF
   CALL WDIALOGPUTINTEGER(ID3(I),ABS(ICLR(MXCGRAD-I+1)))
   CALL WDIALOGCOLOUR(ID3(I),ABS(ICLR(MXCGRAD-I+1)),ABS(ICLR(MXCGRAD-I+1)))
  ENDDO
  CALL LEG_GET(IPLOT)
  CALL LEG_CREATE_COLORS(IPLOT)
 ENDIF

 CALL LEG_PUT(IPLOT)

 END SUBROUTINE LEG_FLIPLEGEND

 !###====================================================================
 SUBROUTINE LEG_GETNOCLASSES(IPLOT,LTYPE,IOPTION,XINT,NLEG)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,NLEG
 INTEGER,INTENT(OUT) :: IOPTION,LTYPE
 REAL,INTENT(OUT) :: XINT
 REAL :: XMIN,XMAX
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE

 !## get minimal and maximal values
 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGGETREAL(ID1(1),XMAX)
 CALL WDIALOGGETREAL(ID1(SIZE(ID1)),XMIN)
   
 CALL WDIALOGLOAD(ID_DLEGENDNOCLASSES,ID_DLEGENDNOCLASSES)
 CALL WDIALOGPUTREAL(IDF_REAL2,XMIN)
 CALL WDIALOGPUTREAL(IDF_REAL3,XMAX)
 CALL WDIALOGPUTREAL(IDF_REAL1,(XMAX-XMIN)/50.0)

 CALL LEG_GETNOCLASSES_FIELDS()

 CALL WDIALOGSHOW(-1,-1,0,3)
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_RADIO1,IDF_RADIO2)
      CALL LEG_GETNOCLASSES_FIELDS()
    END SELECT
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,LTYPE)
      CALL WDIALOGGETREAL(IDF_REAL1,XINT)      
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,MP(IPLOT)%LEG%NCLR)
      CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IOPTION)
      IF(LTYPE.EQ.2)IOPTION=0
      CALL WDIALOGGETREAL(IDF_REAL2,XMIN)
      CALL WDIALOGGETREAL(IDF_REAL3,XMAX)
      EXIT
     CASE (IDCANCEL)
      MP(IPLOT)%LEG%NCLR=0
      EXIT
     CASE (IDHELP)
      CALL IMODGETHELP('3.4.5','MMO.AdjustLeg')
    END SELECT
  END SELECT
 ENDDO

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DLEGEND)

 CALL WDIALOGSELECT(ID_DLEGTAB2)

 IF(LTYPE.EQ.2)THEN
  CALL WDIALOGPUTREAL(ID1(1),XMAX)
  CALL WDIALOGPUTREAL(ID1(SIZE(ID1)),XMIN)
!  MP(IPLOT)%LEG%CLASS(NLEG)=XMIN !## min
!  MP(IPLOT)%LEG%CLASS(0)=XMAX    !## max
 ENDIF

 MP(IPLOT)%LEG%CLASS(NLEG)=XMIN !## min
 MP(IPLOT)%LEG%CLASS(0)=XMAX    !## max
 
 END SUBROUTINE LEG_GETNOCLASSES

 !###====================================================================
 SUBROUTINE LEG_GETNOCLASSES_FIELDS()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I)
 J=1; IF(I.EQ.1)J=2

 CALL WDIALOGFIELDSTATE(IDF_CHECK2,I)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER1,I)
 
 CALL WDIALOGFIELDSTATE(IDF_REAL1,J)
 CALL WDIALOGFIELDSTATE(IDF_REAL2,J)
 CALL WDIALOGFIELDSTATE(IDF_REAL3,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2,J)
 CALL WDIALOGFIELDSTATE(IDF_LABEL3,J)
  
 END SUBROUTINE LEG_GETNOCLASSES_FIELDS

 !###====================================================================
 SUBROUTINE LEG_MINMAX(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J

 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK8,I); I=ABS(I-1)
 DO J=2,6; CALL WDIALOGPUTCHECKBOX(ID2(J),I); END DO

 CALL LEG_GET(IPLOT)
 CALL LEG_PUT(IPLOT) 

 END SUBROUTINE LEG_MINMAX

 !###====================================================================
 LOGICAL FUNCTION LEG_CHECK(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,ITAB
 REAL,DIMENSION(3) :: CLASS

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGGETTAB(ID_DLEGTAB,ITAB)
 CALL WDIALOGSELECT(ITAB)
 IF(ITAB.EQ.ID_DLEGTAB1)THEN
  LEG_CHECK=.FALSE.
  DO I=1,MP(IPLOT)%LEG%NCLR
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I,CLASS(1))
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,2,I,CLASS(2))
   IF(CLASS(1).LE.CLASS(2))EXIT
   IF(I.GT.1)THEN
    CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,2,I-1,CLASS(3))
    IF(CLASS(3).LT.CLASS(1))EXIT
   ENDIF
   IF(I.LT.MP(IPLOT)%LEG%NCLR)THEN
    CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I+1,CLASS(3))
    IF(CLASS(3).GT.CLASS(2))EXIT
   ENDIF
  END DO
  IF(I.LE.MP(IPLOT)%LEG%NCLR)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Legend class '//TRIM(ITOS(I))//' not valid','Error')
   CALL WGRIDSETCELL(ID_GRIDLEVELS,1,I)
   CALL WGRIDSETSELECTION(ID_GRIDLEVELS, 1,2,I,I)
  ELSE
   LEG_CHECK=.TRUE.
  ENDIF
 ELSE
  LEG_CHECK=.TRUE.
 ENDIF

 END FUNCTION LEG_CHECK

 !###====================================================================
 SUBROUTINE LEG_COPYFROM()
 !###====================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,I,NI,J,IPLOT,N
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IL
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: CL

 ALLOCATE(IL(MPW%NACT),CL(MPW%NACT))

 CALL WDIALOGLOAD(ID_DCOPYLEGEND)
 NI=0
 IL=0
 DO I=1,MPW%NACT
  IF(ACTLIST(I).EQ.1)THEN
   NI=NI+1
   CL(NI)=MP(I)%ALIAS 
   IL(NI)=I
  ENDIF
 END DO
 CALL WDIALOGPUTMENU(IDF_MENU1,CL,NI,1)
 CALL WDIALOGSHOW(-1,-1,0,3)

 DO WHILE(.TRUE.)
  CALL WMESSAGE(ITYPE,MESSAGE)
  IF(ITYPE.EQ.PUSHBUTTON.AND.MESSAGE%VALUE1.EQ.IDCANCEL)EXIT
  IF(ITYPE.EQ.PUSHBUTTON.AND.MESSAGE%VALUE1.EQ.IDOK)THEN
   CALL WDIALOGGETMENU(IDF_MENU1,J)
   IPLOT=IL(J)
   DO I=1,NI
    IF(IL(I).NE.IPLOT)THEN
     MP(IL(I))%LEG%NCLR  =MP(IPLOT)%LEG%NCLR
     MP(IL(I))%LEG%RGB   =MP(IPLOT)%LEG%RGB
     MP(IL(I))%LEG%CLASS =MP(IPLOT)%LEG%CLASS
     MP(IL(I))%LEG%CGRAD =MP(IPLOT)%LEG%CGRAD
     MP(IL(I))%LEG%LEGTXT=MP(IPLOT)%LEG%LEGTXT
     MP(IL(I))%LEG%HEDTXT=MP(IPLOT)%LEG%HEDTXT
     !## copy other legend settings
     MP(IL(I))%XCOL =MP(IPLOT)%XCOL
     MP(IL(I))%YCOL =MP(IPLOT)%YCOL
     MP(IL(I))%ZCOL =MP(IPLOT)%ZCOL
     MP(IL(I))%Z2COL=MP(IPLOT)%Z2COL
     MP(IL(I))%HCOL =MP(IPLOT)%HCOL
     MP(IL(I))%HCOL_METHOD =MP(IPLOT)%HCOL_METHOD
     MP(IL(I))%SYMBOL=MP(IPLOT)%SYMBOL
     MP(IL(I))%FADEOUT=MP(IPLOT)%FADEOUT
     MP(IL(I))%THICKNESS=MP(IPLOT)%THICKNESS
     MP(IL(I))%IDFI=MP(IPLOT)%IDFI
     MP(IL(I))%IEQ=MP(IPLOT)%IEQ
     MP(IL(I))%IDFKIND=MP(IPLOT)%IDFKIND
     MP(IL(I))%UNITS=MP(IPLOT)%UNITS
     MP(IL(I))%ILEG=MP(IPLOT)%ILEG
     MP(IL(I))%TSIZE=MP(IPLOT)%TSIZE
     MP(IL(I))%IATTRIB=MP(IPLOT)%IATTRIB
     MP(IL(I))%ASSCOL1=MP(IPLOT)%ASSCOL1
     MP(IL(I))%ASSCOL2=MP(IPLOT)%ASSCOL2
     
    ENDIF
   END DO
   EXIT
  ENDIF
 END DO
 CALL WDIALOGUNLOAD()

 DEALLOCATE(IL,CL)

 !## write legend in mdf file
 DO I=1,MPW%NACT
  IF(ACTLIST(I).EQ.1.AND.MP(I)%IPLOT.EQ.5)THEN
   IF(READMDF(MP(I)%IDFNAME,N))THEN
    MDF(MP(I)%NLIDF)%LEG%NCLR   =MP(I)%LEG%NCLR
    MDF(MP(I)%NLIDF)%LEG%CGRAD  =MP(I)%LEG%CGRAD
    MDF(MP(I)%NLIDF)%LEG%CLASS  =MP(I)%LEG%CLASS
    MDF(MP(I)%NLIDF)%LEG%LEGTXT =MP(I)%LEG%LEGTXT
    MDF(MP(I)%NLIDF)%LEG%HEDTXT =MP(I)%LEG%HEDTXT
    MDF(MP(I)%NLIDF)%LEG%RGB    =MP(I)%LEG%RGB
    IF(WRITEMDF(MP(I)%IDFNAME,N))CALL MDFDEALLOCATE()
   ENDIF
  ENDIF
 ENDDO

 IF(MESSAGE%VALUE1.EQ.IDOK)CALL IDFPLOTFAST(1)

 END SUBROUTINE LEG_COPYFROM

 !###====================================================================
 SUBROUTINE LEG_COPY(IPLOT,CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,CODE

 IF(CODE.EQ.1)THEN
  CLEGTXT=MP(IPLOT)%LEG%LEGTXT
  CHEDTXT=MP(IPLOT)%LEG%HEDTXT
  CNCLR  =MP(IPLOT)%LEG%NCLR
  CRGB   =MP(IPLOT)%LEG%RGB
  CCLASS =MP(IPLOT)%LEG%CLASS
  CCGRAD =MP(IPLOT)%LEG%CGRAD
 ELSE
  MP(IPLOT)%LEG%LEGTXT=CLEGTXT
  MP(IPLOT)%LEG%HEDTXT=CHEDTXT
  MP(IPLOT)%LEG%NCLR  =CNCLR
  MP(IPLOT)%LEG%RGB   =CRGB
  MP(IPLOT)%LEG%CLASS =CCLASS
  MP(IPLOT)%LEG%CGRAD =CCGRAD
!  CALL WDIALOGSELECT(ID_DLEGTAB2)
!  DO I=1,MXCGRAD
!   CALL WDIALOGPUTCHECKBOX(ID2(I),MP(IPLOT)%LEG%CGRAD(I))
!  ENDDO
 ENDIF

 END SUBROUTINE LEG_COPY

 !###====================================================================
 SUBROUTINE LEG_PLOT(IPLOT,CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,CODE

 !## plot legend classes
 IF(MP(IPLOT)%LEG%NCLR.LE.MXCLASS)THEN
  CALL LEG_PLOT_CLASSES_LEGEND(IPLOT,CODE)
 ELSE
  !## plot legend stretched
  CALL LEG_PLOT_STRETCHED_LEGEND(IPLOT)
 ENDIF
 
 END SUBROUTINE LEG_PLOT

 !###====================================================================
 SUBROUTINE LEG_PLOT_CLASSES_LEGEND(IPLOT,CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,CODE
 INTEGER :: I,IRGB
 REAL :: X1,X2
 CHARACTER(LEN=50) :: TXT2
 
 CALL WDIALOGSELECT(ID_DLEGTAB1)

 !## restore grid-colours
 DO I=1,MP(IPLOT)%LEG%NCLR
  CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,I,IRGB)
  CALL WGRIDCOLOURCELL(ID_GRIDLEVELS,3,I,IRGB,IRGB)
  CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I,X2)
  IF(I.LT.MP(IPLOT)%LEG%NCLR)THEN
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I+1,X1)
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,I,X1) 
   CALL WGRIDSTATECELL(ID_GRIDLEVELS,2,I,2)
  ELSE
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,2,I,X1)
   CALL WGRIDSTATECELL(  ID_GRIDLEVELS,2,I,1)
  ENDIF
  IF(CODE.EQ.1)THEN
   WRITE(TXT2,'('//UTL_GETFORMAT(X2)//')') X2
   CALL WGRIDPUTCELLSTRING(ID_GRIDLEVELS,4,I,TRIM(ADJUSTL(TXT2)))
  ENDIF
  CALL WGRIDLABELROW(ID_GRIDLEVELS,I,ITOS(I))
 END DO

 I=1; IF(MP(IPLOT)%LEG%NCLR.GE.MXCLASS)I=0; CALL WDIALOGFIELDSTATE(ID_PLUS,I)
 I=1; IF(MP(IPLOT)%LEG%NCLR.LE.1)I=0;       CALL WDIALOGFIELDSTATE(ID_MIN,I)

 END SUBROUTINE LEG_PLOT_CLASSES_LEGEND

 !###====================================================================
 SUBROUTINE LEG_PLOT_STRETCHED_LEGEND(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I
 REAL :: X,DX

 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL IGRSELECT(DRAWFIELD,IDF_PICTURE1)
 CALL IGRAREA(0.0,0.0,1.0,1.0)
 CALL IGRUNITS(0.0,0.0,1.0,1.0)
 CALL IGRPLOTMODE(MODECOPY)
 CALL IGRFILLPATTERN(SOLID)
 CALL IGRLINEWIDTH(1)
 CALL IGRLINETYPE(SOLIDLINE)
 
 DX=1.0/MP(IPLOT)%LEG%NCLR
 X =0.0
 DO I=1,MP(IPLOT)%LEG%NCLR
  CALL IGRCOLOURN(MP(IPLOT)%LEG%RGB(I))
  CALL IGRRECTANGLE(0.0,1.0-X,1.0,1.0-X+DX)
  X=X+DX
 ENDDO

 CALL IGRSELECT(DRAWWIN,MPW%IWIN)
 CALL IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX)

 END SUBROUTINE LEG_PLOT_STRETCHED_LEGEND
 
 !###====================================================================
 SUBROUTINE LEG_PUT(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J

 CALL WDIALOGSELECT(ID_DLEGEND)
 
 !## classes
 IF(MP(IPLOT)%LEG%NCLR.LE.MXCLASS)THEN

  CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB1)
  CALL WDIALOGSELECT(ID_DLEGTAB1)
  CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(MP(IPLOT)%LEG%HEDTXT))
  CALL WGRIDROWS(ID_GRIDLEVELS,MP(IPLOT)%LEG%NCLR)
  CALL WGRIDSETCELL(ID_GRIDLEVELS,1,1)
  CALL WDIALOGPUTINTEGER(ID_ICOL,1)
  CALL WDIALOGPUTINTEGER(ID_IROW,1)
  DO I=1,MP(IPLOT)%LEG%NCLR
   CALL WGRIDLABELROW(ID_GRIDLEVELS,I,ITOS(I))
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,1,I,MP(IPLOT)%LEG%CLASS(I-1))
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,I,MP(IPLOT)%LEG%CLASS(I))  
   CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,I,MP(IPLOT)%LEG%RGB(I))
   CALL WGRIDPUTCELLSTRING(ID_GRIDLEVELS,4,I,MP(IPLOT)%LEG%LEGTXT(I))
   CALL WGRIDCLEARCELL(ID_GRIDLEVELS,5,I)
  END DO

 !## stretched legend
 ELSE

  CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB2)
  CALL WDIALOGSELECT(ID_DLEGTAB2)
  CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(MP(IPLOT)%LEG%HEDTXT))

  !## give min/max values
  DO I=1,MXCGRAD

   J=CLRGIVEN(I)
   CALL WDIALOGPUTCHECKBOX(ID2(I),MP(IPLOT)%LEG%CGRAD(I))

   IF(MP(IPLOT)%LEG%CGRAD(I).EQ.0)THEN 
    CALL WDIALOGFIELDSTATE(ID1(I),3)
    CALL WDIALOGFIELDSTATE(ID3(I),3)  
   ELSE
    CALL WDIALOGFIELDSTATE(ID1(I),1)
    CALL WDIALOGFIELDSTATE(ID3(I),1)
   ENDIF

   IF(I.EQ.1)THEN

    CALL WDIALOGPUTREAL(ID1(I),MP(IPLOT)%LEG%CLASS(0))
    CALL WDIALOGPUTINTEGER(ID3(I),MP(IPLOT)%LEG%RGB(J))
    CALL WDIALOGCOLOUR(ID3(I),MP(IPLOT)%LEG%RGB(J),MP(IPLOT)%LEG%RGB(J))
    MP(IPLOT)%LEG%ICLRGRAD(I)=MP(IPLOT)%LEG%RGB(J) 

   ELSE

    CALL WDIALOGPUTREAL(ID1(I),MP(IPLOT)%LEG%CLASS(J))
    CALL WDIALOGPUTINTEGER(ID3(I),MP(IPLOT)%LEG%RGB(J))
    CALL WDIALOGCOLOUR(ID3(I),MP(IPLOT)%LEG%RGB(J),MP(IPLOT)%LEG%RGB(J))
    MP(IPLOT)%LEG%ICLRGRAD(I)=MP(IPLOT)%LEG%RGB(J)  

   ENDIF

  END DO

 ENDIF

 CALL LEG_PLOT(IPLOT,0)

 END SUBROUTINE LEG_PUT

 !###====================================================================
 SUBROUTINE LEG_GET(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,I1,II,ITAB,DR
 REAL :: DC

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGGETTAB(ID_DLEGTAB,ITAB)
 CALL WDIALOGSELECT(ITAB)
 CALL WDIALOGGETSTRING(IDF_STRING1,MP(IPLOT)%LEG%HEDTXT)

 !## classes
 IF(ITAB.EQ.ID_DLEGTAB1)THEN

  DO I=1,MP(IPLOT)%LEG%NCLR
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I,MP(IPLOT)%LEG%CLASS(I-1))
   CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,I,MP(IPLOT)%LEG%RGB(I))
   CALL WGRIDGETCELLSTRING(ID_GRIDLEVELS,4,I,MP(IPLOT)%LEG%LEGTXT(I))
  END DO
  IF(MP(IPLOT)%LEG%NCLR.GT.0)CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,2,MP(IPLOT)%LEG%NCLR,MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR))

 !## stretched
 ELSE
 
  !## interpolate intermediate points linearly
  I1=1
  DO I=1,MXCGRAD
   CALL WDIALOGGETCHECKBOX(ID2(I),MP(IPLOT)%LEG%CGRAD(I))
   MP(IPLOT)%LEG%ICLRGRAD(I)=0
   IF(MP(IPLOT)%LEG%CGRAD(I).EQ.0)CYCLE

   !## store colour in iclrgrad
   CALL WDIALOGGETINTEGER(ID3(I),MP(IPLOT)%LEG%ICLRGRAD(I))

   IF(I.EQ.1)THEN
    CALL WDIALOGGETREAL(ID1(I),MP(IPLOT)%LEG%CLASS(0))
   ELSE
    CALL WDIALOGGETREAL(ID1(I),MP(IPLOT)%LEG%CLASS(CLRGIVEN(I)))
    DC=(MP(IPLOT)%LEG%CLASS(CLRGIVEN(I))-MP(IPLOT)%LEG%CLASS(CLRGIVEN(I1)-1))
    DR=(CLRGIVEN(I)-CLRGIVEN(I1))+1
    DC= DC/DR
    DO II=CLRGIVEN(I1),CLRGIVEN(I)
     MP(IPLOT)%LEG%CLASS(II)=MP(IPLOT)%LEG%CLASS(II-1)+DC
    END DO
   ENDIF
   I1=I
  END DO
  
  CALL LEG_CREATE_COLORS(IPLOT) 

 ENDIF

 END SUBROUTINE LEG_GET

 !###====================================================================
 SUBROUTINE LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,ION)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,ION
 INTEGER :: I,J,N
 REAL :: DC
 
 N=MP(IPLOT)%LEG%NCLR
 !## cannot do anything
 IF(N.LE.0)RETURN
 
 IF(ION.EQ.1)THEN
 
  DC=REAL(N)/(7.0-1.0)
  DO I=1,MXCGRAD
   J=INT(REAL(I-1)*DC)+1
   IPOS(I)=J
  ENDDO
  IPOS(MXCGRAD)=MP(IPLOT)%LEG%NCLR
 
  !## put them all on
  MP(IPLOT)%LEG%CGRAD=1
 
 ENDIF
 
 DO I=1,MXCGRAD
  MP(IPLOT)%LEG%ICLRGRAD(I)=MP(IPLOT)%LEG%RGB(IPOS(I))
 ENDDO
 
 END SUBROUTINE LEG_SAMPLE_STRETCHED_GETIPOS
 
 !###====================================================================
 SUBROUTINE LEG_SAMPLE_STRETCHED(IPLOT,ION)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,ION
 INTEGER :: I
 
 CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,ION)
 
 CALL WDIALOGSELECT(ID_DLEGTAB2)

 !## interpolate intermediate points linearly
 DO I=1,MXCGRAD
  CALL WDIALOGPUTCHECKBOX(ID2(I),MP(IPLOT)%LEG%CGRAD(I))
 
  !## store colour in iclrgrad
  CALL WDIALOGPUTINTEGER(ID3(I),MP(IPLOT)%LEG%ICLRGRAD(I))
  
  CALL WDIALOGPUTREAL(ID1(I),MP(IPLOT)%LEG%CLASS(IPOS(I)-1))

 END DO
 
 END SUBROUTINE LEG_SAMPLE_STRETCHED

 !###====================================================================
 SUBROUTINE LEG_SAMPLE_CLASSES(IPLOT,LTYPE,IOPTION,NLEG,XINT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,IOPTION,NLEG,LTYPE
 REAL,INTENT(IN) :: XINT
 INTEGER :: I,J,K,M,N
 REAL :: DI,V1,V2,O1,O2,DC,DSI,DV
 CHARACTER(LEN=50) :: TXT

 !## create smooth interval
 IF(IOPTION.EQ.0)THEN
  
  V1=MP(IPLOT)%LEG%CLASS(NLEG) !## min
  V2=MP(IPLOT)%LEG%CLASS(0)    !## max

  !## compute classes
  IF(LTYPE.EQ.1)THEN

   !## first quess interval
   M=MP(IPLOT)%LEG%NCLR
   N=M
   IF(V1-V2.NE.0.0)THEN
    CALL UTL_GETAXESCALES(V1,0.0,V2,1.0)
    !## number of classes
    M=NSX; DI=SXVALUE(2)-SXVALUE(1)

    !## increase legend to include all values
    IF(SXVALUE(1)  .GT.V1)THEN; SXVALUE(1)  =SXVALUE(1)  -DI; M=M+1; ENDIF
    IF(SXVALUE(NSX).LT.V2)THEN; SXVALUE(NSX)=SXVALUE(NSX)+DI; M=M+1; ENDIF
    !## top/bottom values of legend
    V1=SXVALUE(1); V2=SXVALUE(NSX)

    !## look for best interval that suits classes
    DSI=DI
    IF(M.GT.N)THEN
     DO
      DV=V2-V1; M=DV/DI; IF(MOD(DV,DI).NE.0)M=M+1
      IF(M.LE.N)EXIT; DI=DI+DSI
     ENDDO
     IF(M.NE.N)DI=DI-DSI
    ELSEIF(M.LT.N.AND.M.GT.0)THEN
     DO
      DV=V2-V1; M=DV/DI; IF(MOD(DV,DI).NE.0)M=M+1
      IF(M.GE.N)EXIT; DSI=DSI/2.0; DI=DSI
     ENDDO
     IF(M.NE.N)DI=DI*2.0
    !## error occured, probably step too large
    ENDIF
   ELSE
    V2=V1+0.5; V1=V1-0.5
    !## interval
    M=1; DI=(V2-V1)/REAL(M)
   ENDIF
  
  ELSE
   IF(V1-V2.NE.0.0)THEN
    M=(V2-V1)/XINT; DI=XINT
   ELSE
    V2=V1+0.5; V1=V1-0.5
    !## interval
    M=1; DI=(V2-V1)/REAL(M)
   ENDIF   
  ENDIF

  !## look for appropriate start location for legend
  O1=MP(IPLOT)%LEG%CLASS(NLEG) !## min
  O2=MP(IPLOT)%LEG%CLASS(0)    !## max
  DO
   IF(V2-DI.LE.O2)EXIT
   V2=V2-DI
  ENDDO

  MP(IPLOT)%LEG%CLASS(0)=V2
  
  DO K=1,2
   IF(K.EQ.2)DC=REAL(NLEG)/REAL(MAX(1,I-1))

   I=0; J=0; DO 

    I=I+1; IF(I.GT.MXCLASS)EXIT
    V2=MP(IPLOT)%LEG%CLASS(0)-(REAL(I)*DI)

    MP(IPLOT)%LEG%CLASS(I)=V2 
    IF(K.EQ.2)THEN
     J=(REAL(I-1)*DC)+1
     J=MAX(1,MIN(J,NLEG))
     MP(IPLOT)%LEG%RGB(I)=MP(IPLOT)%LEG%RGB(J)
    ENDIF
    IF(V2.LT.O1)EXIT
   ENDDO
  END DO

  !## make sure take the last colour
  MP(IPLOT)%LEG%NCLR=MIN(MXCLASS,I)
 
 !## take over exactly
 ELSEIF(IOPTION.EQ.1)THEN

  DI=0.0
  DO I=1,MP(IPLOT)%LEG%NCLR 
   DI=DI+REAL(NLEG)/REAL(MP(IPLOT)%LEG%NCLR)
   J=INT(DI)
   J=MIN(J,NLEG) 
   MP(IPLOT)%LEG%CLASS(I)=MP(IPLOT)%LEG%CLASS(J)
   MP(IPLOT)%LEG%RGB(I)  =MP(IPLOT)%LEG%RGB(J)
  END DO
  MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)=MP(IPLOT)%LEG%CLASS(NLEG)
  MP(IPLOT)%LEG%RGB(MP(IPLOT)%LEG%NCLR)  =MP(IPLOT)%LEG%RGB(NLEG)

 ENDIF
 
 DO I=1,MP(IPLOT)%LEG%NCLR 
  WRITE(TXT,'('//UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I-1))//')') MP(IPLOT)%LEG%CLASS(I-1)
  MP(IPLOT)%LEG%LEGTXT(I)=ADJUSTL(TXT)
 ENDDO
 
 END SUBROUTINE LEG_SAMPLE_CLASSES

 !###====================================================================
 SUBROUTINE LEG_LEVELS(ID,IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID,IPLOT
 INTEGER :: I,IROW,IR1,IG1,IB1,IR2,IG2,IB2
 REAL :: X1,X2
 CHARACTER(LEN=50) :: TXT

 CALL WDIALOGSELECT(ID_DLEGTAB1)
 CALL WDIALOGGETINTEGER(ID_IROW,IROW)
 IF(IROW.GT.MP(IPLOT)%LEG%NCLR)IROW=MP(IPLOT)%LEG%NCLR

 IF(ID.EQ.ID_PLUS)THEN

  !## interpolate new value
  CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,IROW,X1)
  X2=X1-1.0
  IF(IROW-1.GE.1)CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,IROW-1,X2)
  X1=(X1+X2)/2.0
  !## interpolate new colour
  CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,IROW,I)
  CALL WRGBSPLIT(I,IR1,IG1,IB1)
  IF(IROW-1.GE.1)CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,IROW-1,I)
  CALL WRGBSPLIT(I,IR2,IG2,IB2)
  IR1=INT((IR1+IR2)/2)
  IG1=INT((IG1+IG2)/2)
  IB1=INT((IB1+IB2)/2)
  I=WRGB(IR1,IG1,IB1)
  !## insert row
  CALL WGRIDINSERTROWS(ID_GRIDLEVELS,IROW,1,1,1)
  CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,1,IROW,X1) 
  IF(IROW.LT.MP(IPLOT)%LEG%NCLR)THEN
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,IROW+1,X2)
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,IROW,X2) 
  ENDIF
  CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,IROW,I)

  WRITE(TXT,'('//UTL_GETFORMAT(X1)//')') X1
  CALL WGRIDPUTCELLSTRING(ID_GRIDLEVELS,4,IROW,TRIM(ADJUSTL(TXT)))

  MP(IPLOT)%LEG%NCLR=MIN(MXCLR,MP(IPLOT)%LEG%NCLR+1)

 ELSEIF(ID.EQ.ID_MIN)THEN

  CALL WGRIDDELETEROWS(ID_GRIDLEVELS,IROW,1,1,1)
  MP(IPLOT)%LEG%NCLR=MIN(MXCLR,MP(IPLOT)%LEG%NCLR-1)

 ENDIF

 CALL LEG_PLOT(IPLOT,0)

 END SUBROUTINE LEG_LEVELS

 !###======================================================================
 SUBROUTINE LEG_CREATE_INIT(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: IPLOT,N

 SELECT CASE (ID)
  CASE (ID_CDLNL)
   IF(.NOT.LEG_CREATE_CLASSES('NON','ALC',0))RETURN
  CASE (ID_CDLL)
   IF(.NOT.LEG_CREATE_CLASSES('LIN','ALC',0))RETURN
  CASE (ID_CDUV)
   IF(.NOT.LEG_CREATE_CLASSES('UQV','ALC',0))RETURN
  CASE (ID_TDLNL)
   IF(.NOT.LEG_CREATE_CLASSES('NON','ALE',0))RETURN
  CASE (ID_TDLL)
   IF(.NOT.LEG_CREATE_CLASSES('LIN','ALE',0))RETURN
  CASE (ID_TDUV)
   IF(.NOT.LEG_CREATE_CLASSES('UQV','ALE',0))RETURN
 END SELECT

 !## write legend in mdf file
 DO IPLOT=1,MXMPLOT
  IF(ACTLIST(IPLOT).EQ.1.AND.MP(IPLOT)%IPLOT.EQ.5)THEN
   IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
    MDF(MP(IPLOT)%NLIDF)%LEG%NCLR   =MP(IPLOT)%LEG%NCLR
    MDF(MP(IPLOT)%NLIDF)%LEG%CGRAD  =MP(IPLOT)%LEG%CGRAD
    MDF(MP(IPLOT)%NLIDF)%LEG%CLASS  =MP(IPLOT)%LEG%CLASS
    MDF(MP(IPLOT)%NLIDF)%LEG%LEGTXT =MP(IPLOT)%LEG%LEGTXT
    MDF(MP(IPLOT)%NLIDF)%LEG%HEDTXT =MP(IPLOT)%LEG%HEDTXT
    MDF(MP(IPLOT)%NLIDF)%LEG%RGB    =MP(IPLOT)%LEG%RGB
    IF(WRITEMDF(MP(IPLOT)%IDFNAME,N))CALL MDFDEALLOCATE()
   ENDIF
  ENDIF
 ENDDO

 END SUBROUTINE LEG_CREATE_INIT

 !###======================================================================
 LOGICAL FUNCTION LEG_CREATE_CLASSES(LEGOPTION,LEGDOMAIN,JPLOT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: SAMPFACT=2000  !## inital number of samples
 INTEGER,INTENT(IN) :: JPLOT
 CHARACTER(LEN=3),INTENT(IN) :: LEGOPTION,LEGDOMAIN
 INTEGER :: N,I,J,ICOL,IROW,NODES,NUNIQUE,SAMPLE,LNCOL,LNROW,NC1,NC2,NR1,NR2,IRAT,IRAT1,IPLOT,IP,JP,I1,I2
 REAL :: XMIN,XMAX,YMIN,YMAX,IDFVALUE,DMIN,DMAX,DR,X,DH,H,DX
 REAL,POINTER,DIMENSION(:) :: IDFVAL=>NULL()
 LOGICAL :: LTOOMUCH,LEX
 CHARACTER(LEN=50) :: LEGTXT,TXT1,TXT2
 CHARACTER(LEN=256) :: FNAME

 LEG_CREATE_CLASSES=.FALSE.
 
 IP=1; JP=MXMPLOT; IF(JPLOT.GT.0)THEN; ACTLIST(JPLOT)=1; IP=JPLOT; JP=IP; ENDIF
 
 DMIN=HUGE(1.0); DMAX=-HUGE(1.0); NODES=0

 DO IPLOT=IP,JP 
  IF(ACTLIST(IPLOT).NE.1)CYCLE

  IF(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5)THEN
   !## get idf for mdf file
   LEX=.TRUE.
   IF(MP(IPLOT)%IPLOT.EQ.5)THEN
    FNAME=MP(IPLOT)%IDFNAME
    !## read *.mdf file, only to get selected idf to be plotted
    IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
     MP(IPLOT)%IDFNAME=MDF(MP(IPLOT)%NLIDF)%FNAME
    ENDIF
   ENDIF
   IF(.NOT.LEX)RETURN
   IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))RETURN
  ENDIF

  !## nonlinear/unique legend
  SELECT CASE (LEGOPTION)
   CASE ('NON','UQV')

    !## read extent of entire domain
    IF(LEGDOMAIN.EQ.'ALE')THEN
     LNCOL=MP(IPLOT)%IDF%NCOL; LNROW=MP(IPLOT)%IDF%NROW
     NC1=1; NC2=LNCOL; NR1=1; NR2=LNROW
    !## define extent of current domain (col*row)
    ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
     XMIN=MAX(MP(IPLOT)%IDF%XMIN,MPW%XMIN); XMAX=MIN(MP(IPLOT)%IDF%XMAX,MPW%XMAX)
     YMIN=MAX(MP(IPLOT)%IDF%YMIN,MPW%YMIN); YMAX=MIN(MP(IPLOT)%IDF%YMAX,MPW%YMAX)
     CALL UTL_IDFCURDIM(XMIN,YMIN,XMAX,YMAX,MP(IPLOT)%IDF,NC1,NC2,NR1,NR2)
     LNCOL=NC2-NC1+1; LNROW=NR2-NR1+1
    ENDIF

    IF(LNCOL.GT.0.AND.LNROW.GT.0)THEN
    
     !## sample factor depends on number of cells (min. value =1)
     SAMPLE=1; IF(LEGOPTION.EQ.'NON')SAMPLE=NINT(SQRT(REAL(LNCOL*LNROW)/REAL(SAMPFACT))); SAMPLE=MAX(1,SAMPLE)

     !## initialize idfval2-array to max extent
     N=(LNCOL*LNROW)/SAMPLE**2
    
     !## increase memory
     CALL LEG_CREATE_ARRAYSIZE(IDFVAL,N,NODES)

     !## get idfvalue at sample-intervals, starting at distance 'sample' (nc1+sample-1,nr1+sample-1)
     DO IROW=(NR1+SAMPLE-1),NR2,SAMPLE
      DO ICOL=(NC1+SAMPLE-1),NC2,SAMPLE
       IDFVALUE=IDFGETVAL(MP(IPLOT)%IDF,IROW,ICOL,MP(IPLOT)%UNITS)
       IF(IDFVALUE.NE.MP(IPLOT)%IDF%NODATA.AND.IDFVALUE.EQ.IDFVALUE)THEN
        NODES=NODES+1; IDFVAL(NODES)=IDFVALUE
       ENDIF
      END DO
     END DO
    ENDIF
    
    IF(LEGDOMAIN.EQ.'ALE')THEN
     DMIN=MIN(DMIN,MP(IPLOT)%IDF%DMIN); DMAX=MAX(DMAX,MP(IPLOT)%IDF%DMAX)
    ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
     DMIN=MIN(DMIN,MP(IPLOT)%UMIN);     DMAX=MAX(DMAX,MP(IPLOT)%UMAX)
    ENDIF

   CASE ('LIN')
   
    IF(LEGDOMAIN.EQ.'ALE')THEN
     DMIN=MIN(DMIN,MP(IPLOT)%IDF%DMIN); DMAX=MAX(DMAX,MP(IPLOT)%IDF%DMAX)
    ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
     DMIN=MIN(DMIN,MP(IPLOT)%UMIN);     DMAX=MAX(DMAX,MP(IPLOT)%UMAX)
    ENDIF

  END SELECT
  
  IF(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5)THEN
   CLOSE(MP(IPLOT)%IDF%IU); IF(MP(IPLOT)%IPLOT.EQ.5)MP(IPLOT)%IDFNAME=FNAME
  ENDIF

 ENDDO
 
 !## nonlinear legend - based upon percentiles
 SELECT CASE (LEGOPTION)
  CASE ('NON')

   IF(NODES.GT.0)THEN

    !## sort vector from small to large
    CALL WSORT(IDFVAL,1,NODES)

    !## remove duplicates
    J=1; DO I=2,NODES
     IF(UTL_EQUALS_REAL(IDFVAL(I),IDFVAL(J)))CYCLE
     J=J+1; IDFVAL(J)=IDFVAL(I)
    ENDDO

    !## add one artificial if only one value is found
    IF(J.EQ.1)THEN
     IDFVAL(1)=IDFVAL(1)-0.5
     IDFVAL(2)=IDFVAL(1)+1.0
     J=J+1
    ENDIF

    !## number of unique values
    NODES=J
    
    !## stepsize
    DX=REAL(NODES)/REAL(MXCLR)

    DO IPLOT=IP,JP 
     IF(ACTLIST(IPLOT).NE.1)CYCLE

     X=0.0-DX; DO I=MXCLR,0,-1
      X = X+DX
      I1= MAX(1,MIN(NODES,FLOOR(X))); I2=MAX(1,MIN(NODES,CEILING(X)))
      DH= IDFVAL(I2)-IDFVAL(I1)
      H =IDFVAL(I1)+(X-I1)*DH
      MP(IPLOT)%LEG%CLASS(I)=H
     END DO
     
     !## overrule maximal value by maximal value of IDF - only for entire extent
     IF(LEGDOMAIN.EQ.'ALE')MP(IPLOT)%LEG%CLASS(0)=MP(IPLOT)%IDF%DMAX
     
     !## resample colours
     CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,1)

     !## number of classes
     MP(IPLOT)%LEG%NCLR=MXCLR

    ENDDO

   ELSE

    DO IPLOT=IP,JP 
     IF(ACTLIST(IPLOT).NE.1)CYCLE
     MP(IPLOT)%LEG%CLASS(0)=MP(IPLOT)%IDF%DMAX
     MP(IPLOT)%LEG%CLASS(1)=MP(IPLOT)%IDF%DMIN
     MP(IPLOT)%LEG%NCLR=1
     MP(IPLOT)%LEG%RGB(1)=WRGB(25,25,25)
    ENDDO

    CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'iMOD found no values for percentiles!'//CHAR(13)// &
     'iMOD will set single class to minimal and maximal values for all selected IDF files.','Information')

   ENDIF
 
  !## linear legend
  CASE ('LIN')

   DR=(DMAX-DMIN)/REAL(MXCLR+1)

   DO IPLOT=IP,JP 
    IF(ACTLIST(IPLOT).NE.1)CYCLE
    MP(IPLOT)%LEG%CLASS(0)=DMAX
    DO I=1,MXCLR; MP(IPLOT)%LEG%CLASS(I)=MP(IPLOT)%LEG%CLASS(I-1)-DR; ENDDO
    !## resample colours
    CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,1)
    MP(IPLOT)%LEG%NCLR=MXCLR
   ENDDO
   
  !## unique values
  CASE ('UQV')

   IF(NODES.GT.0)THEN

    !## determine number of unique classes
    CALL UTL_GETUNIQUE_POINTER(IDFVAL,NODES,NUNIQUE)

    IF(NUNIQUE.GT.MXCLASS)THEN
     LTOOMUCH=.TRUE.
     CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD found '//TRIM(ITOS(NUNIQUE))//' classes for selected domain'//&
       CHAR(13)//'The classes will be distributed evenly the occurence','Information')
     IRAT1=REAL(NUNIQUE)/REAL(MXCLASS)
     IRAT =1.0
     DO I=1,MXCLASS-1
      J        =INT(IRAT)
      IDFVAL(I)=IDFVAL(J)
      IRAT     =IRAT+IRAT1
     END DO
     IDFVAL(MXCLASS)=IDFVAL(NUNIQUE)
     NUNIQUE        =MXCLASS
    ELSE
     LTOOMUCH=.FALSE.
    ENDIF

    DO IPLOT=IP,JP 
     IF(ACTLIST(IPLOT).NE.1)CYCLE
     
     !## resample colours
     CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,1)
     
     !## resort big to small
     CALL WSORT(IDFVAL,1,NUNIQUE,IFLAGS=SORTDESCEND)
     
     MP(IPLOT)%LEG%NCLR=MIN(MXCLASS,NUNIQUE)
     j=0
     DO I=0,NUNIQUE
      j=j+1
      IF(I.LT.NUNIQUE)THEN
       MP(IPLOT)%LEG%CLASS(I)=IDFVAL(I+1)
       IF(LTOOMUCH)THEN
        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),'('//UTL_GETFORMAT(IDFVAL(I+1))//')') IDFVAL(I+1)
        WRITE(LEGTXT,'('//UTL_GETFORMAT(IDFVAL(I+2))//')') IDFVAL(I+2)
        MP(IPLOT)%LEG%LEGTXT(I+1)=TRIM(MP(IPLOT)%LEG%LEGTXT(I+1))//'-'//TRIM(LEGTXT)
       ELSE
        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),'('//UTL_GETFORMAT(IDFVAL(I+1))//')') IDFVAL(I+1)
       ENDIF
       MP(IPLOT)%LEG%RGB(I+1)=ICOLOR(I+1)
      ELSE
       MP(IPLOT)%LEG%CLASS(I)=IDFVAL(I)-1.0
      ENDIF
     ENDDO
    ENDDO
    
   ELSE
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD found no unique values!','Error')
   ENDIF

 END SELECT

 IF(ASSOCIATED(IDFVAL))DEALLOCATE(IDFVAL)

 SELECT CASE (LEGOPTION)
  CASE ('NON','LIN')
   DO IPLOT=IP,JP 
    IF(ACTLIST(IPLOT).NE.1)CYCLE
    !## generate legend-text for all
    DO I=1,MP(IPLOT)%LEG%NCLR
     WRITE(TXT1,'('//UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I))//')')   MP(IPLOT)%LEG%CLASS(I)
     WRITE(TXT2,'('//UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I-1))//')') MP(IPLOT)%LEG%CLASS(I-1)
     MP(IPLOT)%LEG%LEGTXT(I)=TRIM(ADJUSTL(TXT1)) 
    ENDDO
    CALL LEG_CREATE_COLORS(IPLOT)

   ENDDO
 END SELECT

 LEG_CREATE_CLASSES=.TRUE.

 END FUNCTION LEG_CREATE_CLASSES

 !###================================================================================
 SUBROUTINE LEG_CREATE_ARRAYSIZE(IDFVAL,N,NODES)
 !###================================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: N,NODES
 INTEGER :: M,I
 REAL,DIMENSION(:),POINTER,INTENT(INOUT) :: IDFVAL
 REAL,DIMENSION(:),POINTER :: IDFVAL_BU=>NULL()
 
 M=NODES+N
 IF(ASSOCIATED(IDFVAL))THEN
  IF(M.GT.SIZE(IDFVAL))THEN
   ALLOCATE(IDFVAL_BU(M)); DO I=1,NODES; IDFVAL_BU(I)=IDFVAL(I); ENDDO; DEALLOCATE(IDFVAL); IDFVAL=>IDFVAL_BU
  ENDIF
 ELSE
  ALLOCATE(IDFVAL(N))
 ENDIF

 END SUBROUTINE LEG_CREATE_ARRAYSIZE
 
 !##==============================================================================
 SUBROUTINE LEG_CREATE_COLORS(IPLOT)
 !##==============================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,K,IRED,IGREEN,IBLUE,I1,DC,DP
 REAL,DIMENSION(3) :: INTCLR
 INTEGER,DIMENSION(MXCGRAD,3) :: PCLR
 
 !## read current color settings on legend-dialog
 PCLR=0.0
 DO I=1,MXCGRAD
  IF(MP(IPLOT)%LEG%CGRAD(I).EQ.1)CALL WRGBSPLIT(MP(IPLOT)%LEG%ICLRGRAD(I),PCLR(I,1),PCLR(I,2),PCLR(I,3))
!  write(*,*) i
 END DO

 CALL IGRPALETTEINIT()

 I1=1; 
 
 DO I=2,MXCGRAD
  INTCLR=0.0
  IF(MP(IPLOT)%LEG%CGRAD(I).EQ.0)CYCLE
  !## get colour gradients
  DO J=1,3
   DC       = PCLR(I,J)-PCLR(I1,J)
   DP       =(CLRGIVEN(I)-CLRGIVEN(I1))+1
   INTCLR(J)= REAL(DC)/REAL(DP)
!write(*,*) j,i1,i,dc,dp,intclr(j)
  END DO
  K=0
  DO J=CLRGIVEN(I1),CLRGIVEN(I)
   IRED=  PCLR(I1,1)+INTCLR(1)*REAL(K)
   IGREEN=PCLR(I1,2)+INTCLR(2)*REAL(K)
   IBLUE= PCLR(I1,3)+INTCLR(3)*REAL(K)
   MP(IPLOT)%LEG%RGB(J)=WRGB(IRED,IGREEN,IBLUE)
   K=K+1
  END DO
  I1=I
 END DO

 END SUBROUTINE LEG_CREATE_COLORS

END MODULE MOD_LEGEND