!!  Copyright (C) Stichting Deltares, 2005-2016.
!!
!!  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
USE MOD_POLINT, ONLY : POL1LOCATE
USE MOD_LEGEND_UTL, ONLY : LEG_READ,LEG_WRITE,LEG_ALLOCATE
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_PROFILE_UTL, ONLY : GRAPH,PROFILE_PLOTGRAPH,PROFILE_DEALLGRAPH,PROFILE_ALLGRAPH,PROFILE_GETFORMAT,PROFILE_AXES
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/

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,i
 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)
 
 !## computes clrgiven
 CALL LEG_CREATECOLORSGIVEN(IPLOT)
 !## put stretched classes
 CALL LEG_PUTSTRETCHEDCLASSES(IPLOT)
 !## put legend values in dialog and plot in case 256 legend
 CALL LEG_PUT(IPLOT,0)

 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)
       CASE (ID_DLEGTAB1)
        NLEG=MP(IPLOT)%LEG%NCLR
        CALL LEG_GETNOCLASSES(IPLOT,IOPTION)
        IF(MP(IPLOT)%LEG%NCLR.GT.0)THEN
         CALL LEG_GETCLASS(IPLOT)
         CALL LEG_SAMPLECLASS(IPLOT,IOPTION,NLEG)
         !## generate legend text
         CALL LEG_PUT(IPLOT,1) 
        ELSE
         MP(IPLOT)%LEG%NCLR=MXCLR
         CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB2)
        ENDIF
       CASE (ID_DLEGTAB2)
        MP(IPLOT)%LEG%NCLR=MXCLR
        CALL LEG_PUT(IPLOT,0) 
        CALL LEG_MINMAX()
      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)THEN
          CALL LEG_CREATECOLORSGIVEN(IPLOT)
          CALL LEG_PUTSTRETCHEDCLASSES(IPLOT)
          CALL LEG_PUT(IPLOT,0)
         ENDIF
        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)THEN
          CALL LEG_CREATECOLORSGIVEN(IPLOT)
          CALL LEG_PUTSTRETCHEDCLASSES(IPLOT)
          CALL LEG_PUT(IPLOT,0)
         ENDIF
        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
         CALL WGRIDGETCELLINTEGER(ID_GRIDLEVELS,3,IROW,IRGB)
         CALL WSELECTCOLOUR(IRGB)
         IF(WINFODIALOG(4).EQ.1)CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,IROW,IRGB)
        ENDIF
        CALL LEG_SORT(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)
       CASE (ID_FLIP)
        CALL LEG_FLIPLEGEND(ID_DLEGTAB1,IPLOT)
       CASE (ID_HISTOGRAM)
        CALL LEG_HISTOGRAMLEGEND(IPLOT,1)
       CASE (IDF_BUTTON5)
        CALL LEG_SORT(1)
      END SELECT
    END SELECT

   !## 256 colours
   CASE (ID_DLEGTAB2)

    SELECT CASE (ITYPE)

     CASE(EXPOSE)
      CALL LEG_PUT(IPLOT,0)

     CASE(FIELDCHANGED)
      SELECT CASE (MESSAGE%VALUE1)
       CASE (IDF_REAL1,IDF_REAL7)
        CALL LEG_MINMAX()
       CASE (IDF_CHECK1,IDF_CHECK2,IDF_CHECK3,IDF_CHECK4,IDF_CHECK5,IDF_CHECK6,IDF_CHECK7)

        CALL LEG_PUT(IPLOT,0)
      END SELECT
      SELECT CASE (MESSAGE%VALUE2)
      !## put in max/min values
       CASE (IDF_CHECK8)
        CALL LEG_MINMAX()
       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)
         DO I=1,SIZE(ID3); CALL WDIALOGGETINTEGER(ID3(I),IRGB); MP(IPLOT)%LEG%ICLRGRAD(I)=IRGB; ENDDO
         CALL LEG_CREATECOLORS(IPLOT)
         CALL LEG_PLOTSTRETCHEDLEGEND(IPLOT)
        ENDIF
      END SELECT

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       CASE (ID_DEFAULT)
        CALL LEG_DEFAULT(IPLOT)
        CALL LEG_PUT(IPLOT,0)
       CASE (ID_FLIP)
        CALL LEG_FLIPLEGEND(ID_DLEGTAB2,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_PICTURE1,ID_ICONGRID,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,IRGB
 
 !## put colors on dialog
 CALL WDIALOGSELECT(ID_DLEGTAB2)
 DO I=1,MXCGRAD
  CALL WDIALOGPUTINTEGER(ID3(I),WRGB(CLR(I,1),CLR(I,2),CLR(I,3)))
  CALL WDIALOGCOLOUR(ID3(I),WRGB(CLR(I,1),CLR(I,2),CLR(I,3)),WRGB(CLR(I,1),CLR(I,2),CLR(I,3)))
 END DO

 DO I=1,SIZE(ID3)
  CALL WDIALOGGETINTEGER(ID3(I),IRGB); MP(IPLOT)%LEG%ICLRGRAD(I)=IRGB
 ENDDO

 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_LEGEND)
 
 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,'Can not read file '//CHAR(13)//TRIM(MP(IPLOT)%IDFNAME),'Error')
  RETURN
 ENDIF

 CALL UTL_MESSAGEHANDLE(0)

 CALL PROFILE_ALLGRAPH(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) !+MP(IPLOT)%LEG%CLASS(I))/2.0
  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),'(F10.4)')
  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 PROFILE_PLOTGRAPH('Class','Frequency (%)',.FALSE.)
 
 CALL PROFILE_DEALLGRAPH()

 IF(IGRID.EQ.1)THEN
  CALL WDIALOGSELECT(ID_DLEGTAB1)
  CALL WGRIDSETCELL(ID_GRIDLEVELS,5,1)
 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
!  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

  !## 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
 ENDIF

 CALL LEG_PUT(IPLOT,0) !## do not create autom. legend-text

 END SUBROUTINE LEG_FLIPLEGEND

 !###====================================================================
 SUBROUTINE LEG_GETNOCLASSES(IPLOT,IOPTION)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER,INTENT(OUT) :: IOPTION
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE

 CALL WDIALOGLOAD(ID_DLEGENDNOCLASSES,ID_DLEGENDNOCLASSES)
 CALL WDIALOGSHOW(-1,-1,0,3)
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETINTEGER(IDF_INTEGER1,MP(IPLOT)%LEG%NCLR)
      CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IOPTION)
      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)

 END SUBROUTINE LEG_GETNOCLASSES

 !###====================================================================
 SUBROUTINE LEG_MINMAX()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: ID(7)
 INTEGER :: I,J
 REAL :: X1,X2,DX
 DATA ID/IDF_REAL1,IDF_REAL2,IDF_REAL3,IDF_REAL4,IDF_REAL5,IDF_REAL6,IDF_REAL7/

 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK8,I)
 J=1
 IF(I.EQ.1)J=3 
 DO I=2,6; CALL WDIALOGFIELDSTATE(ID(I),J); END DO

 IF(J.EQ.1)RETURN

 CALL WDIALOGGETREAL(ID(1),X1)
 CALL WDIALOGGETREAL(ID(7),X2)
 DX=(X2-X1)/6.0 
 DO I=2,6
  X1=X1+DX
  CALL WDIALOGPUTREAL(ID(I),X1)
 END DO

 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.
  CALL WDIALOGGETINTEGER(ID_NCLR,MP(IPLOT)%LEG%NCLR)
  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))%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
 INTEGER :: I

 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_PUTSTRETCHEDCLASSES(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J

 CALL WDIALOGSELECT(ID_DLEGTAB2)

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

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

  IF(I.EQ.1)THEN

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

  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
  J=MIN(MXCLR,J+CLRGIVEN(I))
 END DO

 END SUBROUTINE LEG_PUTSTRETCHEDCLASSES

 !###====================================================================
 SUBROUTINE LEG_PUT(IPLOT,CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,CODE
 INTEGER :: I,ICLR

 CALL WDIALOGSELECT(ID_DLEGEND)
 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)
  CALL WDIALOGPUTINTEGER(ID_NCLR,MP(IPLOT)%LEG%NCLR)
  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),'(G15.7)')
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,I,MP(IPLOT)%LEG%CLASS(I),'(G15.7)')
   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
  !## generate legend-text
  CALL LEG_SORT(CODE) 
 ELSE
  CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB2)
  CALL WDIALOGSELECT(ID_DLEGTAB2)
  CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(MP(IPLOT)%LEG%HEDTXT))
  CALL WDIALOGGETCHECKBOX(IDF_CHECK8,I)
  DO ICLR=1,MXCGRAD
   CALL WDIALOGGETINTEGER(ID3(ICLR),MP(IPLOT)%LEG%ICLRGRAD(ICLR))
   CALL WDIALOGGETCHECKBOX(ID2(ICLR),MP(IPLOT)%LEG%CGRAD(ICLR))
   IF(MP(IPLOT)%LEG%CGRAD(ICLR).EQ.0)THEN 
    CALL WDIALOGFIELDSTATE(ID1(ICLR),3)
    CALL WDIALOGFIELDSTATE(ID3(ICLR),3)  
   ELSE
    IF(I.EQ.0)CALL WDIALOGFIELDSTATE(ID1(ICLR),1)
    CALL WDIALOGFIELDSTATE(ID3(ICLR),1)
   ENDIF
  ENDDO
  CALL LEG_CREATECOLORS(IPLOT)
  CALL LEG_PLOTSTRETCHEDLEGEND(IPLOT)
 ENDIF

 END SUBROUTINE LEG_PUT

 !###====================================================================
 SUBROUTINE LEG_PLOTSTRETCHEDLEGEND(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_PLOTSTRETCHEDLEGEND

 !###====================================================================
 SUBROUTINE LEG_GET(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,ITAB

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGGETTAB(ID_DLEGTAB,ITAB)
 CALL WDIALOGSELECT(ITAB)
 IF(ITAB.EQ.ID_DLEGTAB1)THEN
  CALL WDIALOGGETSTRING(IDF_STRING1,MP(IPLOT)%LEG%HEDTXT)
  CALL WDIALOGGETINTEGER(ID_NCLR,MP(IPLOT)%LEG%NCLR)
  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
  CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,2,MP(IPLOT)%LEG%NCLR,MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR))
 ELSE
  CALL LEG_GETCLASS(IPLOT)
 ENDIF

 END SUBROUTINE LEG_GET

 !###====================================================================
 SUBROUTINE LEG_GETCLASS(IPLOT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,II,JJ
 REAL :: DC

 CALL WDIALOGSELECT(ID_DLEGTAB2)
 CALL WDIALOGGETSTRING(IDF_STRING1,MP(IPLOT)%LEG%HEDTXT)
 
 !## interpolate intermediate points linearly
 J =0
 JJ=0
 DO I=1,MXCGRAD
  CALL WDIALOGGETCHECKBOX(ID2(I),MP(IPLOT)%LEG%CGRAD(I))
  IF(MP(IPLOT)%LEG%CGRAD(I).EQ.1)THEN

   !## 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(J))
   ENDIF
   JJ=JJ+1
   IF(I.GT.1)THEN
    DC=(MP(IPLOT)%LEG%CLASS(J)-MP(IPLOT)%LEG%CLASS(J-CLRGIVEN(JJ-1)))/CLRGIVEN(JJ-1)
    DO II=J-CLRGIVEN(JJ-1)+1,J-1
     MP(IPLOT)%LEG%CLASS(II)=MP(IPLOT)%LEG%CLASS(II-1)+DC
    END DO
   ENDIF
   J=MIN(MXCLR,J+CLRGIVEN(JJ))
  ENDIF
 END DO
 
 END SUBROUTINE LEG_GETCLASS

 !###====================================================================
 SUBROUTINE LEG_SAMPLECLASS(IPLOT,IOPTION,NLEG)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,IOPTION,NLEG
 INTEGER :: I,J,M,N
 REAL :: DI,V1,V2

 !## create smooth interval
 IF(IOPTION.EQ.0)THEN
  !## first quess interval
  M =MP(IPLOT)%LEG%NCLR
  N =M
  V1=MP(IPLOT)%LEG%CLASS(NLEG) !## min
  V2=MP(IPLOT)%LEG%CLASS(0)    !## max
  IF(V1-V2.NE.0.0)THEN
   CALL PROFILE_AXES(V1,V2,0.0,M)
   !## check i
   IF(M.GT.N)THEN
    DO WHILE(M.GT.N); M=M/2; ENDDO
   ELSEIF(M.LT.N.AND.M.GT.0)THEN
    DO WHILE(M.LT.N); IF(M*2.GT.N)EXIT; M=M*2; ENDDO
   !## error occured, probably step too large
   ELSE
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can not translate this legend into proper classes'//CHAR(13)// &
      'A reason for this might be the enormeous legend range.','Error')
    M=MP(IPLOT)%LEG%NCLR 
    V1=MP(IPLOT)%LEG%CLASS(NLEG) !## min
    V2=MP(IPLOT)%LEG%CLASS(0)    !## max
   ENDIF
  ELSE
   M=1
  ENDIF

  MP(IPLOT)%LEG%CLASS(0)=V2
  MP(IPLOT)%LEG%NCLR=MIN(MXCLASS,M)

  !## interval
  DI=(V2-V1)/REAL(M)
 
  J=0; DO I=1,MP(IPLOT)%LEG%NCLR 

   V2=MP(IPLOT)%LEG%CLASS(0)-(REAL(I)*DI)
   
   MP(IPLOT)%LEG%CLASS(I)=V2 
   J=J+NINT(REAL(NLEG)/REAL(M)); J=MIN(J,NLEG) 
   MP(IPLOT)%LEG%RGB(I)=MP(IPLOT)%LEG%RGB(J)
  END DO
 
 !## 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
 
 END SUBROUTINE LEG_SAMPLECLASS

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

 CALL WDIALOGSELECT(ID_DLEGTAB1)
 CALL WDIALOGGETINTEGER(ID_IROW,IROW)
 CALL WDIALOGGETINTEGER(ID_NCLR,NCLR)
 IF(IROW.GT.NCLR)IROW=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,'(G15.7)')
  IF(IROW.LT.NCLR)THEN
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,IROW+1,X2)
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,IROW,X2,'(G15.7)')
  ENDIF
  CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,IROW,I)

  NCLR=MIN(MXCLR,NCLR+1)
  CALL WDIALOGPUTINTEGER(ID_NCLR,NCLR)

 ELSEIF(ID.EQ.ID_MIN)THEN

  CALL WGRIDDELETEROWS(ID_GRIDLEVELS,IROW,1,1,1)
  NCLR=MIN(MXCLR,NCLR-1)
  CALL WDIALOGPUTINTEGER(ID_NCLR,NCLR)

 ENDIF

 CALL LEG_SORT(0)

 END SUBROUTINE LEG_LEVELS

 !###====================================================================
 SUBROUTINE LEG_SORT(CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: CODE
 INTEGER :: NCLR,I,IRGB
 REAL :: X1,X2
 CHARACTER(LEN=50) :: TXT1,TXT2
 
 CALL WDIALOGSELECT(ID_DLEGTAB1)
 CALL WDIALOGGETINTEGER(ID_NCLR,NCLR)

 !## restore grid-colours
 DO I=1,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.NCLR)THEN
   CALL WGRIDGETCELLREAL(ID_GRIDLEVELS,1,I+1,X1)
   CALL WGRIDPUTCELLREAL(ID_GRIDLEVELS,2,I,X1,'(G15.7)')
   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(TXT1,'('//PROFILE_GETFORMAT(X1)//')') X1
   WRITE(TXT2,'('//PROFILE_GETFORMAT(X2)//')') X2
   CALL WGRIDPUTCELLSTRING(ID_GRIDLEVELS,4,I,TRIM(ADJUSTL(TXT1)))
  ENDIF
  CALL WGRIDLABELROW(ID_GRIDLEVELS,I,ITOS(I))
 END DO

 I=1
 IF(NCLR.GE.MXCLASS)I=0
 CALL WDIALOGFIELDSTATE(ID_PLUS,I)
 I=1
 IF(NCLR.LE.1)I=0
 CALL WDIALOGFIELDSTATE(ID_MIN,I)

 END SUBROUTINE LEG_SORT

 !###======================================================================
 SUBROUTINE LEG_CREATEINIT(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN)            :: ID
 INTEGER                       :: IPLOT,I,J,CLNODE,N
 REAL                          :: MINV,MAXV,DR,IR
 REAL,ALLOCATABLE,DIMENSION(:) :: IDFVAL

 DO IPLOT=1,MXMPLOT
  IF(ACTLIST(IPLOT).EQ.1)THEN
   CALL WINDOWSELECT(0)
   CALL WINDOWOUTSTATUSBAR(4,'Getting Legend for Map: '//TRIM(MP(IPLOT)%IDFNAME))
   SELECT CASE (ID)
    CASE (ID_CDLNL)
     CALL LEG_CREATECLASSES(IPLOT,'NON','ALC')
    CASE (ID_CDLL)
     CALL LEG_CREATECLASSES(IPLOT,'LIN','ALC')
    CASE (ID_CDUV)
     CALL LEG_CREATECLASSES(IPLOT,'UQV','ALC')
    CASE (ID_TDLNL)
     CALL LEG_CREATECLASSES(IPLOT,'NON','ALE')
    CASE (ID_TDLL)
     CALL LEG_CREATECLASSES(IPLOT,'LIN','ALE')
    CASE (ID_TDUV)
     CALL LEG_CREATECLASSES(IPLOT,'UQV','ALE')
   END SELECT
  ENDIF
 ENDDO

 SELECT CASE (ID)

  !## adjust to get total legend for total group (linear)
  CASE (ID_CDLL,ID_TDLL)
   MAXV=-10.0E10
   MINV= 10.0E10
   DO IPLOT=1,MXMPLOT
    IF(ACTLIST(IPLOT).EQ.1)THEN
     MINV=MIN(MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR),MINV)
     MAXV=MAX(MP(IPLOT)%LEG%CLASS(0),MAXV)
    ENDIF
   ENDDO
   DO IPLOT=1,MXMPLOT
    IF(ACTLIST(IPLOT).EQ.1)THEN
     DR=(MAXV-MINV)/REAL(MP(IPLOT)%LEG%NCLR-1)
     MP(IPLOT)%LEG%CLASS(0)=MAXV
     DO I=1,MP(IPLOT)%LEG%NCLR
      MP(IPLOT)%LEG%CLASS(I)=MP(IPLOT)%LEG%CLASS(I-1)-DR
     END DO
     CALL LEG_CREATECOLORS(IPLOT)
    ENDIF
   ENDDO

  !## percentiles
  CASE (ID_CDLNL,ID_TDLNL)
   ALLOCATE(IDFVAL(MXMPLOT*(MXCLR+1)))
   J=0
   DO IPLOT=1,MXMPLOT
    IF(ACTLIST(IPLOT).EQ.1)THEN
     DO I=0,MP(IPLOT)%LEG%NCLR
      J=J+1
      IDFVAL(J)=MP(IPLOT)%LEG%CLASS(I)
     END DO
    ENDIF
   ENDDO
   CALL UTL_QKSORT(J,J,IDFVAL)

   DR    =REAL(J)/REAL(MXCLR)
   DO IPLOT=1,MXMPLOT
    IF(ACTLIST(IPLOT).EQ.1)THEN
     MP(IPLOT)%LEG%CLASS(0)=IDFVAL(J)
     CLNODE=J
     I     =0
     IR    =REAL(J)
     DO WHILE(.TRUE.)
      IR=IR-DR
      CLNODE=INT(IR)
      IF(CLNODE.LE.0)EXIT
      IF(IDFVAL(CLNODE).NE.MP(IPLOT)%LEG%CLASS(I))THEN
       I=I+1
       MP(IPLOT)%LEG%CLASS(I)=IDFVAL(CLNODE)
      ENDIF
     END DO
     I=I+1
     I=MIN(I,MXCLR)
     MP(IPLOT)%LEG%CLASS(I)=IDFVAL(1)
     MP(IPLOT)%LEG%NCLR=I
     IF(MP(IPLOT)%LEG%NCLR.EQ.1)THEN
      IF(MP(IPLOT)%LEG%CLASS(0).EQ.MP(IPLOT)%LEG%CLASS(1))THEN
       MP(IPLOT)%LEG%CLASS(0)=MP(IPLOT)%LEG%CLASS(0)+0.5
       MP(IPLOT)%LEG%CLASS(1)=MP(IPLOT)%LEG%CLASS(1)-0.5
      ENDIF
     ENDIF
     CALL LEG_CREATECOLORS(IPLOT)
    ENDIF
   ENDDO
   DEALLOCATE(IDFVAL)

 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_CREATEINIT

 !###======================================================================
 SUBROUTINE LEG_CREATECLASSES(IPLOT,LEGOPTION,LEGDOMAIN)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER             :: SAMPFACT=2000  !#inital number of samples
 INTEGER,INTENT(IN)            :: IPLOT
 CHARACTER(LEN=3),INTENT(IN)   :: LEGOPTION,LEGDOMAIN
 INTEGER                       :: I,J,ICOL,IROW,NODES,CLNODE,NUNIQUE,N, &
                                  SAMPLE,LNCOL,LNROW,NC1,NC2,NR1,NR2,IRAT,IRAT1!,ITYPE
 REAL                          :: XMIN,XMAX,YMIN,YMAX,IDFVALUE,DR,IR
 REAL,ALLOCATABLE,DIMENSION(:) :: IDFVAL
 LOGICAL :: LTOOMUCH,LEX
 CHARACTER(LEN=50) :: LEGTXT,TXT1,TXT2
 CHARACTER(LEN=256) :: FNAME

 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 legend - based upon percentiles
 IF(LEGOPTION.EQ.'NON')THEN
 !##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

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

   !## initialize idfval2-array to max extent
   ALLOCATE(IDFVAL((LNCOL*LNROW)/SAMPLE**2))

   !## 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)THEN
      NODES=NODES+1
      IDFVAL(NODES)=IDFVALUE
     ENDIF
    END DO
   END DO

   IF(NODES.GT.0)THEN
    !## sort vector
    CALL UTL_QKSORT(NODES,NODES,IDFVAL)
    DR    =REAL(NODES)/REAL(MXCLR-1)
    MP(IPLOT)%LEG%CLASS(0)=IDFVAL(NODES)

    CLNODE=NODES
    I     =0
    IR    =REAL(NODES)
    DO WHILE(.TRUE.)
     IR=IR-DR
     CLNODE=INT(IR)
     IF(CLNODE.LE.0)EXIT
     IF(IDFVAL(CLNODE).NE.MP(IPLOT)%LEG%CLASS(I))THEN
      I=I+1
      MP(IPLOT)%LEG%CLASS(I)=IDFVAL(CLNODE)
     ENDIF
    END DO
    I=I+1
    I=MIN(I,MXCLR)
    MP(IPLOT)%LEG%CLASS(I)=IDFVAL(1)
    MP(IPLOT)%LEG%NCLR=I
    IF(MP(IPLOT)%LEG%NCLR.EQ.1)THEN
     IF(MP(IPLOT)%LEG%CLASS(0).EQ.MP(IPLOT)%LEG%CLASS(1))THEN
      MP(IPLOT)%LEG%CLASS(0)=MP(IPLOT)%LEG%CLASS(0)+0.5
      MP(IPLOT)%LEG%CLASS(1)=MP(IPLOT)%LEG%CLASS(1)-0.5
     ENDIF
    ENDIF

    IF(LEGDOMAIN.EQ.'ALE')THEN
     MP(IPLOT)%LEG%CLASS(0)                 =MP(IPLOT)%IDF%DMAX
     MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)=MP(IPLOT)%IDF%DMIN
    ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
     MP(IPLOT)%LEG%CLASS(0)                 =MP(IPLOT)%UMAX
     MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)=MP(IPLOT)%UMIN
    ENDIF

   ELSE
    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)
    CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'iMOD found no values for percentiles!'//CHAR(13)// &
     'Set legend to max. and minimal values according header in IDF','Information')
   ENDIF
   IF(ALLOCATED(IDFVAL))DEALLOCATE(IDFVAL)
  ENDIF

 !## linear legend
 ELSEIF(LEGOPTION.EQ.'LIN')THEN
  IF(LEGDOMAIN.EQ.'ALE')THEN
   DR                    =(MP(IPLOT)%IDF%DMAX-MP(IPLOT)%IDF%DMIN)/REAL(MXCLR+1)
   MP(IPLOT)%LEG%CLASS(0)= MP(IPLOT)%IDF%DMAX
  ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
   DR                    =(MP(IPLOT)%UMAX-MP(IPLOT)%UMIN)/REAL(MXCLR+1)
   MP(IPLOT)%LEG%CLASS(0)= MP(IPLOT)%UMAX
  ENDIF
  DO I=1,MXCLR
   MP(IPLOT)%LEG%CLASS(I)=MP(IPLOT)%LEG%CLASS(I-1)-DR
  END DO
  MP(IPLOT)%LEG%NCLR=MXCLR

 !## unique values
 ELSEIF(LEGOPTION.EQ.'UQV')THEN

   IRAT1=0

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

  !## initialize idfval2-array to max extent
   IF(ALLOCATED(IDFVAL))DEALLOCATE(IDFVAL)
   ALLOCATE(IDFVAL((LNCOL*LNROW)/SAMPLE**2))

  !## get idfvalue at sample-intervals, starting at distance 'sample' (nc1+sample-1,nr1+sample-1)
   NODES=0
   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)THEN
      NODES        =NODES+1
      IDFVAL(NODES)=IDFVALUE
     ENDIF
    END DO
    CALL UTL_WAITMESSAGE(IRAT,IRAT1,IROW-NR1+1,LNROW,'Progress ')
   END DO

   IF(NODES.GT.0)THEN

    !## determine number of unique classes
    CALL UTL_GETUNIQUE(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

    CALL WSORT(IDFVAL,1,NUNIQUE,1)

    MP(IPLOT)%LEG%NCLR=MIN(MXCLASS,NUNIQUE)
    DO I=0,NUNIQUE
     IF(I.LT.NUNIQUE)THEN
      MP(IPLOT)%LEG%CLASS(I)=IDFVAL(I+1)
      IF(LTOOMUCH)THEN
       WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),'('//PROFILE_GETFORMAT(IDFVAL(I+1))//')') IDFVAL(I+1)
       WRITE(LEGTXT,'('//PROFILE_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),'('//PROFILE_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

    IF(LEGDOMAIN.EQ.'ALE')THEN
     MP(IPLOT)%IDF%DMAX=MP(IPLOT)%LEG%CLASS(0)
     MP(IPLOT)%IDF%DMIN=MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)
    ELSEIF(LEGDOMAIN.EQ.'ALC')THEN
     MP(IPLOT)%UMAX=MP(IPLOT)%LEG%CLASS(0)
     MP(IPLOT)%UMIN=MP(IPLOT)%LEG%CLASS(MP(IPLOT)%LEG%NCLR)
    ENDIF

   ELSE
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD found no unique values!','Error')
   ENDIF
   IF(ALLOCATED(IDFVAL))DEALLOCATE(IDFVAL)
  ENDIF

 ENDIF

 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

 !## generate legend-text
 DO I=1,MP(IPLOT)%LEG%NCLR
  WRITE(TXT1,'('//PROFILE_GETFORMAT(MP(IPLOT)%LEG%CLASS(I))//')')   MP(IPLOT)%LEG%CLASS(I)
  WRITE(TXT2,'('//PROFILE_GETFORMAT(MP(IPLOT)%LEG%CLASS(I-1))//')') MP(IPLOT)%LEG%CLASS(I-1)
  MP(IPLOT)%LEG%LEGTXT(I)=TRIM(ADJUSTL(TXT1)) 
 ENDDO
 
 END SUBROUTINE LEG_CREATECLASSES

 !==============================================================================
 SUBROUTINE LEG_CREATECOLORSGIVEN(IPLOT)
 !==============================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,ICRIT,NCLR

 !## number of classes between color-zones
 ICRIT=INT(REAL(MP(IPLOT)%LEG%NCLR)/REAL(MXCGRAD-1))

 CLRGIVEN=0
 DO I=1,MXCGRAD-1
  CLRGIVEN(I)=ICRIT
  IF(SUM(CLRGIVEN(1:I)).GE.MP(IPLOT)%LEG%NCLR)EXIT
 ENDDO
 !## final number of color-zones
 NCLR=I
 !## get remaining (-/+)
 J=MP(IPLOT)%LEG%NCLR-SUM(CLRGIVEN(1:NCLR))
 !## correct over boxes
 DO I=1,ABS(J)
  CLRGIVEN(I)=CLRGIVEN(I)+SIGN(1,J)
 END DO

 END SUBROUTINE LEG_CREATECOLORSGIVEN

 !##==============================================================================
 SUBROUTINE LEG_CONSTUCTICLRGRAD(IPLOT)
 !##==============================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,K
  
 K=MXCLR/MXCGRAD
 
 J=1; DO I=1,MXCGRAD
  MP(IPLOT)%LEG%ICLRGRAD(I)=MP(IPLOT)%LEG%RGB(J)
  J=J+K
 ENDDO
 
 END SUBROUTINE LEG_CONSTUCTICLRGRAD
 
 !##==============================================================================
 SUBROUTINE LEG_CREATECOLORS(IPLOT)
 !##==============================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,K,IRED,IGREEN,IBLUE,NCLRDEF,II
 REAL,DIMENSION(3) :: INTCLR
 INTEGER,DIMENSION(MXCGRAD,3) :: PCLR
 
 !## default number of classes between color-zones
 CALL LEG_CREATECOLORSGIVEN(IPLOT)

 !## read current color settings on legend-dialog
 NCLRDEF=0
 II     =0
 DO I=1,MXCGRAD
  IF(MP(IPLOT)%LEG%CGRAD(I).EQ.1)THEN
   NCLRDEF=NCLRDEF+1
   II     =II+1
   CALL WRGBSPLIT(MP(IPLOT)%LEG%ICLRGRAD(I),PCLR(NCLRDEF,1),PCLR(NCLRDEF,2),PCLR(NCLRDEF,3))
  ELSE
   CLRGIVEN(II)=CLRGIVEN(II)+CLRGIVEN(I)
  ENDIF
 END DO

 CALL IGRPALETTEINIT()

 K=0
 DO I=1,NCLRDEF-1
  DO J=1,3
   INTCLR(J)=REAL(PCLR(I+1,J)-PCLR(I,J))/REAL(CLRGIVEN(I)-1.0)
  END DO
  DO J=0,CLRGIVEN(I)-1
   K=K+1
   K=MIN(K,MXCLR)
   IRED=  PCLR(I,1)+INT(INTCLR(1)*J)
   IGREEN=PCLR(I,2)+INT(INTCLR(2)*J)
   IBLUE= PCLR(I,3)+INT(INTCLR(3)*J)
   MP(IPLOT)%LEG%RGB(K)=WRGB(IRED,IGREEN,IBLUE)
  END DO
 END DO

 END SUBROUTINE LEG_CREATECOLORS

END MODULE MOD_LEGEND