!!  Copyright (C) Stichting Deltares, 2005-2020.
!!
!!  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 MOD_DBL
USE MODPLOT
USE MOD_PREF_PAR
USE IMODVAR  
USE MOD_COLOURS
USE MOD_IDF
USE MOD_MDF
USE MOD_UTL
USE MOD_POLINT
USE MOD_LEGEND_UTL
USE MOD_LEGPLOT_PAR
USE MOD_OSD 
USE MOD_GRAPH
USE MOD_QKSORT

CONTAINS

 !###====================================================================
 LOGICAL FUNCTION LEG_MAIN(CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: CODE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,IPLOT,IROW,ICOL,IRGB,IOS,N,IOPTION,NLEG,LTYPE,I,DID
 REAL(KIND=DP_KIND) :: XINT,DX,X1,X2,X3,X4
 CHARACTER(LEN=256) :: IDFNAME
 INTEGER,DIMENSION(4) :: IP
  
 LEG_MAIN=.FALSE.
 
 DID=WINFODIALOG(CURRENTDIALOG)

 !## copy legend from 
 IF(CODE.EQ.-1)THEN
  CALL WDIALOGSELECT(ID_DMANAGERTAB1)
  CALL WDIALOGGETMENU(ID_DMTABMENU,ACTLIST)
  IF(SUM(ACTLIST).GT.1)THEN; LEG_MAIN=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 UTL_DIALOGSHOW(-1,-1,1,3)
 
 CALL UTL_FILLARRAY(IP,4,MP(IPLOT)%IDFKIND)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,IP(1))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK2,IP(2))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK3,IP(3))
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,IP(4))
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,MP(IPLOT)%THICKNESS)
 
 !## put/plot legend values in dialog and plot in case 256 legend
 CALL LEG_PUT(IPLOT)

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

   !## main legend dialog
   CASE (ID_DLEGEND)

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

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

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

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

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

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

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

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

      END SELECT
    END SELECT

   !## classes
   CASE (ID_DLEGTAB1)

    SELECT CASE (ITYPE)

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

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

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

   !## 256 colours
   CASE (ID_DLEGTAB2)

    SELECT CASE (ITYPE)

     CASE(EXPOSE)
      CALL LEG_PLOT(IPLOT,0)

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

     CASE(PUSHBUTTON)
      SELECT CASE (MESSAGE%VALUE1)

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

  END SELECT

 ENDDO

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

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGUNLOAD()

 IF(DID.NE.0)CALL WDIALOGSELECT(DID)
 
 !## reset to entire window
 CALL IGRSELECT(DRAWWIN,MPW%IWIN)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

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

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

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

 CALL LEG_CREATE_COLORS(IPLOT); CALL LEG_PUT(IPLOT)

 END SUBROUTINE LEG_DEFAULT

 !###====================================================================
 LOGICAL FUNCTION LEG_PREDEFINED()
 !###====================================================================
 IMPLICIT NONE
 INTEGER,PARAMETER :: MAXLEGEND=7
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,I
 CHARACTER(LEN=104),DIMENSION(MAXLEGEND) :: CLEGEND
 DATA CLEGEND/'GWS_NAP (-6:35)','GWS_SURFLEVEL (0:10)','FLUX_MMD (-1.5:0.05)','RESIDUAL (-2:2)','TRANSMISSIVITY (0:10.00)', &
     '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 UTL_DIALOGSHOW(-1,-1,0,3)
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE(FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
    END SELECT

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

 ENDDO

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

 LEG_PREDEFINED_WRITELEG=.FALSE.
 
 IU=UTL_GETUNIT(); CALL OSD_OPEN(IU,FILE=TRIM(PREFVAL(1))//'\tmp\tmp.leg',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot create the file'//CHAR(13)//TRIM(PREFVAL(1))//'\tmp\tmp.leg.'//CHAR(13)// &
    'Assign a correct directory for the keyword USER in the used preference file (*.PRF) for iMOD','Error')
  RETURN
 ENDIF
 
 SELECT CASE (ILEG)
  CASE (1) !## gws_nap
   WRITE(IU,'(A)') ' 24,1,1,1,1,1,1,1'
   WRITE(IU,'(A)') 'UPPERBND,LOWERBND,IRED,IGREEN,IBLUE,DOMAIN'
   WRITE(IU,'(A)') '200.000,35.00000,113,0,0,         "> 35.0m"    '
   WRITE(IU,'(A)') '35.00000,30.0000,160,0,0,         "30.0 - 35.0m"'  
   WRITE(IU,'(A)') '30.0000,25.00000,203,0,0,         "25.0 - 30.0m" ' 
   WRITE(IU,'(A)') '25.00000,20.0000,250,0,0,         "20.0 - 25.0m"  '
   WRITE(IU,'(A)') '20.0000,15.00000,255,27,0,        "15.0 - 20.0m"  '
   WRITE(IU,'(A)') '15.00000,10.0000,255,57,0,        "10.0 - 15.0m"   '
   WRITE(IU,'(A)') '10.0000,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.00000,255,248,0,       "1.0 - 2.0m"    '
   WRITE(IU,'(A)') '1.00000,0.0000000,206,255,0,  "0.0 - 1.0m"    '
   WRITE(IU,'(A)') '0.0000000,-1.00000,144,255,0, "-1.0 - 0.0m"   '
   WRITE(IU,'(A)') '-1.00000,-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.000,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.0             75          0          0 "> 10.0 m"'
   WRITE(IU,'(A)') ' 10.0      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.00            209        255        115 "1.0-1.2 m"'
   WRITE(IU,'(A)') ' 1.00     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.00             38        115          0 "0.0-0.2 m"'
   WRITE(IU,'(A)') '0.00     -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.000000     255     131     128     "-1.0 - -0.50 mm/d"'
   WRITE(IU,'(A)') '-1.000000     -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.00         0         0       153    "2 - 1 m"'
   WRITE(IU,'(A)') '  1.00     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.00       255       102         0    "-0.5 - -1 m"'
   WRITE(IU,'(A)') '    -1.00    -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.0    98    0    0    "> 10000"'
   WRITE(IU,'(A)') '10000.0    8000.00    147    0    0    "8000"'
   WRITE(IU,'(A)') '8000.00    6000.00    166    4    0    "6000"'
   WRITE(IU,'(A)') '6000.00    4000.00    221    58    11    "4000"'
   WRITE(IU,'(A)') '4000.00    2500.00    234    117    0    "2500"'
   WRITE(IU,'(A)') '2500.00    2000.00    234    165    10    "2000"'
   WRITE(IU,'(A)') '2000.00    1500.00    255    199    6    "1500"'
   WRITE(IU,'(A)') '1500.00    1000.00    245    222    5    "1000"'
   WRITE(IU,'(A)') '1000.00    950.000    252    240    20    "950"'
   WRITE(IU,'(A)') '950.000    900.000    255    255    128    "900"'
   WRITE(IU,'(A)') '900.000    850.000    225    255    90    "850"'
   WRITE(IU,'(A)') '850.000    800.000    195    255    45    "800"'
   WRITE(IU,'(A)') '800.000    750.000    166    254    3    "750"'
   WRITE(IU,'(A)') '750.000    700.000    80    254    50    "700"'
   WRITE(IU,'(A)') '700.000    650.000    4    253    104    "650"'
   WRITE(IU,'(A)') '650.000    600.000    3    243    135    "600"'
   WRITE(IU,'(A)') '600.000    550.000    5    243    172    "550"'
   WRITE(IU,'(A)') '550.000    500.000    57    232    215    "500"'
   WRITE(IU,'(A)') '500.000    450.000    96    187    242    "450"'
   WRITE(IU,'(A)') '450.000    400.000    110    160    250    "400"'
   WRITE(IU,'(A)') '400.000    300.000    128    128    255    "300"'
   WRITE(IU,'(A)') '300.000    200.000    128    70    255    "200"'
   WRITE(IU,'(A)') '200.000    100.000    128    0    255    "100"'
   WRITE(IU,'(A)') '100.000    80.0000    139    1    214    "80"'
   WRITE(IU,'(A)') '80.0000    60.0000    160    1    209    "60"'
   WRITE(IU,'(A)') '60.0000    40.0000    194    1    216    "40"'
   WRITE(IU,'(A)') '40.0000    30.0000    235    53    255    "30"'
   WRITE(IU,'(A)') '30.0000    20.0000    255    132    255    "20"'
   WRITE(IU,'(A)') '20.0000    10.0000    255    174    255    "10"'
   WRITE(IU,'(A)') '10.0000    5.000000    255    204    255    "5"'
   WRITE(IU,'(A)') '5.000000    0.000000E+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.00000,255,128,128,"2 Negative Decrease"'
   WRITE(IU,'(A)') '1.00000,0.000000E+00,255,0,0,"1 Negative Increase"'
   WRITE(IU,'(A)') '0.000000E+00,-1.00000,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,ITYPE,IEXIT
 REAL(KIND=DP_KIND) :: GRD,NHIST
 LOGICAL :: LEX
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=256) :: FNAME
 
 !## read classes
 CALL LEG_GET(IPLOT)

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

 CALL UTL_MESSAGEHANDLE(0)

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

 NHIST=0.0D0

 !## 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.0D0
     NHIST=NHIST+1.0D0
    ENDIF
   ENDIF
  ENDDO
  CALL UTL_WAITMESSAGE(IRAT,IRAT1,IROW,MP(IPLOT)%IDF%NROW,'Progress Histogram ')
 ENDDO

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

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

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

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

 GRAPHDIM%GRAPHNAMES=MP(IPLOT)%IDFNAME(INDEX(MP(IPLOT)%IDFNAME,'\',.TRUE.)+1:)
 GRAPH(1,1)%LEGTXT='Classes'; GRAPH(1,1)%ICLR=WRGB(56,180,176)
 GRAPHDIM(1)%IFIXX=0; GRAPHDIM(1)%IFIXY=0; GRAPHDIM(1)%XTITLE='Class'; GRAPHDIM(1)%YTITLE='Frequency (%)'; GRAPHDIM(1)%LDATE=.FALSE.
 GRAPHDIM(1)%IGROUP=1; GRAPHDIM(1)%TEXTSIZE=5.0D0
 !## display graph
 CALL GRAPH_INIT(3)
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  CALL GRAPH_MAIN(ITYPE,MESSAGE,IEXIT=IEXIT)
  IF(IEXIT.EQ.1)EXIT
 ENDDO
 
 CALL GRAPH_DEALLOCATE()

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

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

 IF(ITAB.EQ.ID_DLEGTAB1)THEN

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

 ELSEIF(ITAB.EQ.ID_DLEGTAB2)THEN

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

 CALL LEG_PUT(IPLOT)

 END SUBROUTINE LEG_FLIPLEGEND

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

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

 CALL LEG_GETNOCLASSES_FIELDS()

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

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DLEGEND)

 CALL WDIALOGSELECT(ID_DLEGTAB2)

 IF(LTYPE.EQ.2)THEN
  CALL WDIALOGPUTDOUBLE(ID1(1),XMAX)
  CALL WDIALOGPUTDOUBLE(ID1(SIZE(ID1)),XMIN)
 ENDIF

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

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

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

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

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

 CALL LEG_GET(IPLOT)
 CALL LEG_PUT(IPLOT) 

 END SUBROUTINE LEG_MINMAX

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

 CALL WDIALOGSELECT(ID_DLEGEND)
 CALL WDIALOGGETTAB(ID_DLEGTAB,ITAB)
 CALL WDIALOGSELECT(ITAB)
 IF(ITAB.EQ.ID_DLEGTAB1)THEN
  LEG_CHECK=.FALSE.
  DO I=1,MP(IPLOT)%LEG%NCLR
   CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,1,I,CLASS(1))
   CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,2,I,CLASS(2))
   IF(CLASS(1).LE.CLASS(2))EXIT
   IF(I.GT.1)THEN
    CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,2,I-1,CLASS(3))
    IF(CLASS(3).LT.CLASS(1))EXIT
   ENDIF
   IF(I.LT.MP(IPLOT)%LEG%NCLR)THEN
    CALL WGRIDGETCELLDOUBLE(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

 !###====================================================================
 LOGICAL FUNCTION 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

 LEG_COPYFROM=.FALSE.

 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 UTL_DIALOGSHOW(-1,-1,0,3)

 DO 
  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); CALL LEG_COPYTHEM(IPLOT,NI,IL)
   LEG_COPYFROM=.TRUE.; 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
 
 END FUNCTION LEG_COPYFROM

 !###====================================================================
 SUBROUTINE LEG_COPYTHEM(IPLOT,NI,IL)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,NI
 INTEGER,INTENT(IN),DIMENSION(NI) :: IL
 INTEGER :: I
 
 DO I=1,NI
  IF(IL(I).NE.IPLOT)THEN
   MP(IL(I))%LEG%NCLR  =MP(IPLOT)%LEG%NCLR
   MP(IL(I))%LEG%RGB   =MP(IPLOT)%LEG%RGB
   MP(IL(I))%LEG%CLASS =MP(IPLOT)%LEG%CLASS
   MP(IL(I))%LEG%CGRAD =MP(IPLOT)%LEG%CGRAD
   MP(IL(I))%LEG%LEGTXT=MP(IPLOT)%LEG%LEGTXT
   MP(IL(I))%LEG%HEDTXT=MP(IPLOT)%LEG%HEDTXT
   !## copy other legend settings
   MP(IL(I))%XCOL =MP(IPLOT)%XCOL
   MP(IL(I))%YCOL =MP(IPLOT)%YCOL
   MP(IL(I))%ZCOL =MP(IPLOT)%ZCOL
   MP(IL(I))%Z2COL=MP(IPLOT)%Z2COL
   MP(IL(I))%HCOL =MP(IPLOT)%HCOL
   MP(IL(I))%HCOL_METHOD =MP(IPLOT)%HCOL_METHOD
   MP(IL(I))%SYMBOL=MP(IPLOT)%SYMBOL
   MP(IL(I))%FADEOUT=MP(IPLOT)%FADEOUT
   MP(IL(I))%THICKNESS=MP(IPLOT)%THICKNESS
   MP(IL(I))%IDFI=MP(IPLOT)%IDFI
   MP(IL(I))%IEQ=MP(IPLOT)%IEQ
   MP(IL(I))%IDFKIND=MP(IPLOT)%IDFKIND
   MP(IL(I))%UNITS=MP(IPLOT)%UNITS
   MP(IL(I))%ILEG=MP(IPLOT)%ILEG
   MP(IL(I))%TSIZE=MP(IPLOT)%TSIZE
   MP(IL(I))%TFORMAT=MP(IPLOT)%TFORMAT
   MP(IL(I))%IATTRIB=MP(IPLOT)%IATTRIB
   MP(IL(I))%ASSCOL1=MP(IPLOT)%ASSCOL1
   MP(IL(I))%ASSCOL2=MP(IPLOT)%ASSCOL2
  ENDIF
 END DO
 
 END SUBROUTINE LEG_COPYTHEM
 
 !###====================================================================
 SUBROUTINE LEG_COPY(IPLOT,CODE)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,CODE

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

 END SUBROUTINE LEG_COPY

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

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

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

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

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

 END SUBROUTINE LEG_PLOT_CLASSES_LEGEND

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

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

 CALL IGRSELECT(DRAWWIN,MPW%IWIN)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

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

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

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

 !## stretched legend
 ELSE

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

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

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

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

   IF(I.EQ.1)THEN

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

   ELSE

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

   ENDIF

  END DO

 ENDIF

 CALL LEG_PLOT(IPLOT,0)

 END SUBROUTINE LEG_PUT

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

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

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

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

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

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

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

 ENDIF

 END SUBROUTINE LEG_GET

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

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

 END DO
 
 END SUBROUTINE LEG_SAMPLE_STRETCHED

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

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

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

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

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

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

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

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

   I=0; J=0; DO 

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

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

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

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

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

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

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

 IF(ID.EQ.ID_PLUS)THEN

  !## interpolate new value
  CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,1,IROW,X1)
  X2=X1-1.0D0
  IF(IROW-1.GE.1)CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,1,IROW-1,X2)
  X1=(X1+X2)/2.0D0
  !## 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 WGRIDPUTCELLDOUBLE(ID_GRIDLEVELS,1,IROW,X1) 
  IF(IROW.LT.MP(IPLOT)%LEG%NCLR)THEN
   CALL WGRIDGETCELLDOUBLE(ID_GRIDLEVELS,1,IROW+1,X2)
   CALL WGRIDPUTCELLDOUBLE(ID_GRIDLEVELS,2,IROW,X2) 
  ENDIF
  CALL WGRIDPUTCELLINTEGER(ID_GRIDLEVELS,3,IROW,I)

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

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

 ELSEIF(ID.EQ.ID_MIN)THEN

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

 ENDIF

 CALL LEG_PLOT(IPLOT,0)

 END SUBROUTINE LEG_LEVELS

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

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

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

 END SUBROUTINE LEG_CREATE_INIT

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

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

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

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

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

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

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

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

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

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

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

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

   IF(NODES.GT.0)THEN

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

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

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

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

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

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

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

    ENDDO

   ELSE

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

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

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

   DR=(DMAX-DMIN)/DBLE(MXCLR)

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

   IF(NODES.GT.0)THEN

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

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

    DO IPLOT=IP,JP 
     IF(ACTLIST(IPLOT).NE.1)CYCLE
     
     !## resample colours
     CALL LEG_SAMPLE_STRETCHED_GETIPOS(IPLOT,1)
     
     !## resort big to small
     CALL UTL_WSORT(IDFVAL,1,NUNIQUE,IFLAGS=SORTDESCEND)
     
     MP(IPLOT)%LEG%NCLR=MIN(MXCLASS,NUNIQUE)
     J=0
     DO I=0,NUNIQUE
      J=J+1
      IF(I.LT.NUNIQUE)THEN
!       !## single precision
!       IF(MP(IPLOT)%IDF%ITYPE.EQ.4)THEN
!        XS=REAL(IDFVAL(I+1),4); WRITE(TXT1,*) XS; READ(TXT1,*) X 
!       !## double precision
!       ELSE
!        X=IDFVAL(I+1)
!       ENDIF
       MP(IPLOT)%LEG%CLASS(I)=IDFVAL(I+1)
       IF(LTOOMUCH)THEN
!        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),UTL_GETFORMAT(X)) X
        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),UTL_GETFORMAT(IDFVAL(I+1))) IDFVAL(I+1)
!        WRITE(LEGTXT,UTL_GETFORMAT(IDFVAL(I+2))) IDFVAL(I+2)
!        MP(IPLOT)%LEG%LEGTXT(I+1)=TRIM(MP(IPLOT)%LEG%LEGTXT(I+1))//'-'//TRIM(LEGTXT)
       ELSE
!        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),UTL_GETFORMAT(X)) X
        WRITE(MP(IPLOT)%LEG%LEGTXT(I+1),UTL_GETFORMAT(IDFVAL(I+1))) IDFVAL(I+1)
       ENDIF
       MP(IPLOT)%LEG%RGB(I+1)=ICOLOR(I+1)
      ELSE
       MP(IPLOT)%LEG%CLASS(I)=IDFVAL(I)-1.0D0
      ENDIF
     ENDDO
    ENDDO
    
   ELSE
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD found no unique values!','Error')
   ENDIF

 END SELECT

 IF(ASSOCIATED(IDFVAL))DEALLOCATE(IDFVAL)

 SELECT CASE (LEGOPTION)
  CASE ('NON','LIN')
   DO IPLOT=IP,JP 
    IF(ACTLIST(IPLOT).NE.1)CYCLE
    !## generate legend-text for all
    DO I=1,MP(IPLOT)%LEG%NCLR
     X=MP(IPLOT)%LEG%CLASS(I)
     IF(X.NE.X.OR.X.GT.HUGE(1.0D0).OR.X.LT.-HUGE(1.0D0))THEN
      TXT1='NaN'
     ELSE
      WRITE(TXT1,UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I))) MP(IPLOT)%LEG%CLASS(I)
     ENDIF
     MP(IPLOT)%LEG%LEGTXT(I)=TRIM(ADJUSTL(TXT1)) 
    ENDDO
    CALL LEG_CREATE_COLORS(IPLOT)

   ENDDO
 END SELECT

 LEG_CREATE_CLASSES=.TRUE.

 END FUNCTION LEG_CREATE_CLASSES

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

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

 CALL IGRPALETTEINIT()

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

 END SUBROUTINE LEG_CREATE_COLORS

END MODULE MOD_LEGEND