!!  Copyright (C) Stichting Deltares, 2005-2014.
!!
!!  This file is part of iMOD.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!  Contact: imod.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands.
!!
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 : LEGREAD,LEGWRITE,LEGALLOCATE
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_PROFILE_UTL, ONLY : GRAPH,PROFILE_PLOTGRAPH,PROFILE_DEALLGRAPH,PROFILE_ALLGRAPH,PROFILE_GETFORMAT,PROFILE_AXES

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 LEGINIT()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I

 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)
 
 CALL LEGDEFAULT()

 !## initialize legend-memory if mp object
 DO I=1,MXMPLOT
  MP(I)%LEG%NCLR=0
  CALL LEGALLOCATE(MP(I)%LEG)
 END DO

 END SUBROUTINE LEGINIT

 !###====================================================================
 SUBROUTINE LEGDEFAULT()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 INTEGER,DIMENSION(MXCGRAD,3) :: CLR
 DATA                  ((CLR(I,J),J=1,3),I=1,MXCGRAD) /&
                                   64,0,0,     & !## brown
                                   255,0,0,    & !## red
                                   255,0,255  ,& !## purple
                                   0,0,255    ,& !## blue
                                   0,255,0    ,& !## green
                                   255,255,0  ,& !## yellow
                                   128,255,255/  !## cyan

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

 END SUBROUTINE LEGDEFAULT

 !###====================================================================
 SUBROUTINE LEGMAIN(CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: CODE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,IPLOT,IROW,ICOL,IRGB,IOS,N,IOPTION,NLEG
 CHARACTER(LEN=256) :: IDFNAME
 INTEGER,DIMENSION(4) :: IP
  
 IF(CODE.EQ.-1)THEN
  CALL WDIALOGSELECT(ID_DMANAGERTAB1)
  CALL WDIALOGGETMENU(ID_DMTABMENU,ACTLIST)
  IF(SUM(ACTLIST).GT.1)THEN
   CALL LEGCOPYFROM()
   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

 CALL LEGCOPY(IPLOT,1)

 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)
 
 CALL LEGINITCLRGIVEN(IPLOT)
 CALL LEGPUTCLASS(IPLOT)
 CALL LEGPUT(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 LEGGETNOCLASSES(IPLOT,IOPTION)
        IF(MP(IPLOT)%LEG%NCLR.GT.0)THEN
         CALL LEGGETCLASS(IPLOT)
         CALL LEGSAMPLECLASS(IPLOT,IOPTION,NLEG)
         !## generate legend text
         CALL LEGPUT(IPLOT,1) !0)
        ELSE
         MP(IPLOT)%LEG%NCLR=MXCLR
         CALL WDIALOGSETTAB(ID_DLEGTAB,ID_DLEGTAB2)
        ENDIF
       CASE (ID_DLEGTAB2)
        MP(IPLOT)%LEG%NCLR=MXCLR
        CALL LEGPUT(IPLOT,0) !1)
        CALL LEGMINMAX()
      END SELECT
     CASE(FIELDCHANGED)

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       CASE (ID_SAVE)
        IF(LEGCHECK(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 LEGGET(IPLOT)
          CALL LEGWRITE(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 LEGREAD(MP(IPLOT)%LEG,IDFNAME,IOS)
         IF(IOS.EQ.0)THEN
          CALL LEGINITCLRGIVEN(IPLOT)
          CALL LEGPUTCLASS(IPLOT)
          CALL LEGPUT(IPLOT,0)
         ENDIF
        ENDIF

       CASE (ID_PRELEGEND)
        IF(LEGPREDEFINED())THEN
         CALL LEGREAD(MP(IPLOT)%LEG,TRIM(PREFVAL(1))//'\tmp\tmp.leg',IOS)
         IF(IOS.EQ.0)THEN
          CALL LEGINITCLRGIVEN(IPLOT)
          CALL LEGPUTCLASS(IPLOT)
          CALL LEGPUT(IPLOT,0)
         ENDIF
        ENDIF

       CASE (IDCANCEL)
        CALL LEGCOPY(IPLOT,2)
        CALL WDIALOGSELECT(ID_DLEGEND)
        CALL WDIALOGHIDE()
        EXIT

       CASE (IDOK)
        IF(LEGCHECK(IPLOT))THEN
         CALL LEGGET(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 LEGSORT(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 LEGLEVELS(MESSAGE%VALUE1)
       CASE (ID_FLIP)
        CALL LEGENDFLIP(ID_DLEGTAB1,IPLOT)
       CASE (ID_HISTOGRAM)
        CALL LEGENDHISTOGRAM(IPLOT,1)
       CASE (IDF_BUTTON5)
        CALL LEGSORT(1)
      END SELECT
    END SELECT

   !## 256 colours
   CASE (ID_DLEGTAB2)

    SELECT CASE (ITYPE)

     CASE(EXPOSE)
      CALL LEGPUT(IPLOT,0)

     CASE(FIELDCHANGED)
      SELECT CASE (MESSAGE%VALUE1)
       CASE (IDF_REAL1,IDF_REAL7)
        CALL LEGMINMAX()
       CASE (IDF_CHECK1,IDF_CHECK2,IDF_CHECK3,IDF_CHECK4,IDF_CHECK5,IDF_CHECK6,IDF_CHECK7)
        CALL LEGPUT(IPLOT,0)
      END SELECT
      SELECT CASE (MESSAGE%VALUE2)
      !## put in max/min values
       CASE (IDF_CHECK8)
        CALL LEGMINMAX()
       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 LEGUPDATE(IPLOT)
        ENDIF
      END SELECT

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

       CASE (ID_DEFAULT)
        CALL LEGDEFAULT()
        CALL LEGPUT(IPLOT,0)
       CASE (ID_FLIP)
        CALL LEGENDFLIP(ID_DLEGTAB2,IPLOT)
       CASE (ID_HISTOGRAM)
        CALL LEGENDHISTOGRAM(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

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

 !###====================================================================
 LOGICAL FUNCTION LEGPREDEFINED()
 !###====================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: MAXLEGEND=6
 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)'/ 
 
 LEGPREDEFINED=.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)
      LEGPREDEFINED=LEGPREDEFINED_WRITELEG(I)
      EXIT
     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT

 ENDDO

 CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_LEGEND)
 
 END FUNCTION LEGPREDEFINED
 
 !###======================================================================
 LOGICAL FUNCTION LEGPREDEFINED_WRITELEG(ILEG)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILEG
 INTEGER :: IU,IOS

 LEGPREDEFINED_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"'  
 END SELECT

 CLOSE(IU)

 LEGPREDEFINED_WRITELEG=.TRUE.

 END FUNCTION LEGPREDEFINED_WRITELEG

 !###====================================================================
 SUBROUTINE LEGENDHISTOGRAM(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 LEGGET(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 LEGENDFLIP(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)
   IF(J.EQ.1)CALL WDIALOGGETINTEGER(ID3(I),ICLR(I))
  END DO
  DO I=1,MXCGRAD
   IF(ICLR(MXCGRAD-I+1).NE.0)THEN
    CALL WDIALOGPUTCHECKBOX(ID2(I),1)
    CALL WDIALOGPUTINTEGER(ID3(I),ICLR(MXCGRAD-I+1))
    CALL WDIALOGCOLOUR(ID3(I),ICLR(MXCGRAD-I+1),ICLR(MXCGRAD-I+1))
   ELSE
    CALL WDIALOGPUTCHECKBOX(ID2(I),0)
   ENDIF
  ENDDO
 ENDIF

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

 END SUBROUTINE

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

 !###====================================================================
 SUBROUTINE LEGMINMAX()
 !###====================================================================
 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 !REAL(7)
 DO I=2,6
  X1=X1+DX
  CALL WDIALOGPUTREAL(ID(I),X1)
 END DO

 END SUBROUTINE LEGMINMAX

 !###====================================================================
 LOGICAL FUNCTION LEGCHECK(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
  LEGCHECK=.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
   LEGCHECK=.TRUE.
  ENDIF
 ELSE
  LEGCHECK=.TRUE.
 ENDIF

 END FUNCTION LEGCHECK

 !###====================================================================
 SUBROUTINE LEGCOPYFROM()
 !###====================================================================
 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 LEGCOPYFROM

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

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

 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))
  ELSE

   CALL WDIALOGPUTREAL(ID1(I),MP(IPLOT)%LEG%CLASS(J))
   CALL WDIALOGPUTINTEGER(ID3(I),MP(IPLOT)%LEG%RGB(J))!-1))
   CALL WDIALOGCOLOUR(ID3(I),MP(IPLOT)%LEG%RGB(J),MP(IPLOT)%LEG%RGB(J))!-1))
  ENDIF
  J=MIN(MXCLR,J+CLRGIVEN(I))
 END DO

 END SUBROUTINE LEGPUTCLASS

 !###====================================================================
 SUBROUTINE LEGPUT(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 LEGSORT(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 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 LEGUPDATE(IPLOT)
 ENDIF

 END SUBROUTINE LEGPUT

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

 CALL LEGINITCLR(IPLOT)

 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 LEGUPDATE

 !###====================================================================
 SUBROUTINE LEGGET(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 LEGGETCLASS(IPLOT)
 ENDIF

 END SUBROUTINE LEGGET

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

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

 !###====================================================================
 SUBROUTINE LEGLEVELS(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 LEGSORT(0)

 END SUBROUTINE LEGLEVELS

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

 !###======================================================================
 SUBROUTINE LEGCREATEINIT(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 LEGCREATE(IPLOT,'NON','ALC')
    CASE (ID_CDLL)
     CALL LEGCREATE(IPLOT,'LIN','ALC')
    CASE (ID_CDUV)
     CALL LEGCREATE(IPLOT,'UQV','ALC')
    CASE (ID_TDLNL)
     CALL LEGCREATE(IPLOT,'NON','ALE')
    CASE (ID_TDLL)
     CALL LEGCREATE(IPLOT,'LIN','ALE')
    CASE (ID_TDUV)
     CALL LEGCREATE(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 LEGINITCLR(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 LEGINITCLR(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 LEGCREATEINIT

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

 !==============================================================================
 SUBROUTINE LEGINITCLRGIVEN(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 LEGINITCLRGIVEN

 !==============================================================================
 SUBROUTINE LEGINITCLR(IPLOT)
 !==============================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,K,IRED,IGREEN,IBLUE,NCLRDEF,IRGB,II
 INTEGER,DIMENSION(MXCGRAD,3) :: CLR
 REAL,DIMENSION(3) :: INTCLR

 !## default number of classes between color-zones
 CALL LEGINITCLRGIVEN(IPLOT)

 !##read current color settings on legend-dialog
 CALL WDIALOGSELECT(ID_DLEGTAB2)
 NCLRDEF=0
 II     =0
 DO I=1,MXCGRAD
  CALL WDIALOGGETCHECKBOX(ID2(I),J)
  IF(J.EQ.1)THEN
   NCLRDEF=NCLRDEF+1
   II     =II+1
   CALL WDIALOGGETINTEGER(ID3(I),IRGB)
   CALL WRGBSPLIT(IRGB,CLR(NCLRDEF,1),CLR(NCLRDEF,2),CLR(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(CLR(I+1,J)-CLR(I,J))/REAL(CLRGIVEN(I)-1.0)
  END DO
  DO J=0,CLRGIVEN(I)-1
   K=K+1
   K=MIN(K,MXCLR)
   IRED=  CLR(I,1)+INT(INTCLR(1)*J)
   IGREEN=CLR(I,2)+INT(INTCLR(2)*J)
   IBLUE= CLR(I,3)+INT(INTCLR(3)*J)
   MP(IPLOT)%LEG%RGB(K)=WRGB(IRED,IGREEN,IBLUE)
  END DO
 END DO

 END SUBROUTINE LEGINITCLR

END MODULE MOD_LEGEND