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

USE WINTERACTER
USE RESOURCE
USE MOD_DBL
USE MOD_QKSORT
USE MOD_PREF_PAR, ONLY  : PREFVAL
USE MODPLOT
USE MOD_COLOURS, ONLY  : COLOUR_RANDOM
USE IMODVAR, ONLY : DP_KIND,SP_KIND,IBACKSLASH,ILABELNAME,PI,SCLNAMES_UP
USE MOD_IDF
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_COLOURS, ONLY : ICOLOR
USE MOD_UTL, ONLY : UTL_INVERSECOLOUR,UTL_CAP,UTL_GETUNIT,ITOS,RTOS,UTL_FILLARRAY,UTL_IDFGETCLASS, &
       UTL_IDFSNAPTOGRID,UTL_MESSAGEHANDLE,DBL_IGRINSIDEPOLYGON,UTL_WAITMESSAGE,NEWLINE,UTL_LOADIMAGE, &
       UTL_EQUALS_REAL,UTL_GETAXESCALES,SXVALUE,SYVALUE,NSX,NSY,UTL_GETFORMAT,UTL_ROTATE_XYZ, &
       UTL_GETCURRENTDATE,UTL_GETCURRENTTIME,PEUCKER_SIMPLIFYLINE,UTL_SUBST,UTL_WSELECTFILE,UTL_GETHELP, &
       UTL_GETHELP,UTL_DIST,UTL_GETUNIQUE_DINT,YMDHMSTOITIME,UTL_DIALOGSHOW,UTL_CLOSEUNITS
USE MOD_GENPLOT_PAR
USE MOD_IFF, ONLY : IFF,IFFPLOT_GETIFFVAL,IFFGETUNIT
USE MOD_IPFASSFILE, ONLY : IPFOPENASSFILE,IPFREADASSFILELABEL,IPFREADASSFILE,IPFDRAWITOPIC2_ICLR, &
            IPFINITASSFILE
USE MOD_IPFASSFILE_UTL
USE MOD_IPF_PAR, ONLY : ASSF,IPF,NIPF,MAXLITHO,BH,NLITHO
USE MOD_IPF, ONLY : IPFINIT,IPFREAD,IPFDEALLOCATE
USE MOD_PROFILE_UTL, ONLY : PROFILE_COMPUTEPLOT,PROFILE_DEALLOCATE
USE MOD_PROFILE_PAR, ONLY : MXNIDF,PROFIDF,SERIE,MXSERIE,NXY,XY,MXSAMPLING,ICCOL,ISOLID
USE MOD_3D_PAR
USE MOD_3D_QUERY
USE MOD_3D_UTL, ONLY : IMOD3D_RETURNCOLOR,IMOD3D_SETCOLOR,IMOD3D_DRAWIDF_SIZE,IMOD3D_CREATE_SXY, &
     IMOD3D_BLANKOUT,IMOD3D_BLANKOUT_XY,IMOD3D_MAPWINDOWTOOBJ,IMOD3D_SETNORMALVECTOR,IMOD3D_SETTINGSINIT_IPF
USE MOD_3D_DISPLAY, ONLY : IMOD3D_DISPLAY
USE MOD_MDF, ONLY : READMDF,READMDF_GETN,MDF,MDFDEALLOCATE
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_SOLID_PAR, ONLY : SPF,NSPF,PX,PZ,SLD,ISEL_IDF,IACT,ICHECK,ICLEAN,IEXIST,XEXCLUDE,DTOL,NSPF,ISPF,NTBSOL
USE MOD_SOLID_PROFILE, ONLY : SOLID_PROFILEFITDRILL_CALC,SOLID_PROFILEDELETE,SOLID_PROFILEADD_SPFMEMORY
USE MOD_SOLID_UTL, ONLY : SOLIDOPENSPF,SOLID_INITSLD,SOLIDDEALLOCATESLD,SOLID_INITSLDPOINTER
USE MOD_SOF, ONLY : SOF_COMPUTE_GRAD,SOF_COMPUTE_GRAD_3D
USE MOD_POLYGON_UTL, ONLY : POLYGON1INIT,POLYGON1CLOSE,POLYGON1SAVELOADSHAPE,POLYGON_UTL_OPENGEN
USE MOD_POLYGON_PAR 
USE MOD_DEMO_PAR
USE MOD_MANAGER_UTL, ONLY : MANAGER_UTL_ADDFILE
USE MOD_IPFGETVALUE_COLOURS, ONLY : IPFGETVALUE_OPENSAVECOLOURS
USE MOD_IDFTIMESERIE_UTL, ONLY : IDFTIMESERIE_DATES
USE MOD_IDFTIMESERIE_PAR, ONLY : NFILES,LISTFILES

TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:),PRIVATE :: IDF  !## idf (part)
CHARACTER(LEN=12),DIMENSION(8) :: IDFTYPES
DATA IDFTYPES/'Planes','Cubes','Voxels','Vectors','Off','Tplanes','TCubes','TVoxels'/

CONTAINS

 !###======================================================================
 SUBROUTINE IMOD3D_ADDARTIFICIALWELLS(IOPT,X,Y,PNTFNAME) 
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IOPT
 REAL(KIND=DP_KIND),INTENT(IN) :: X,Y
 CHARACTER(LEN=*),INTENT(IN) :: PNTFNAME
 CHARACTER(LEN=256) :: FNAME,LINE
 CHARACTER(LEN=52) :: CID
 CHARACTER(LEN=3) :: EXT
 INTEGER :: I,J,K,IU,JU,IOS,IWEL,IROW,ICOL,N,IRED,IGREEN,IBLUE,IRGB,ILEG
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: Z
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IORDER,IIDF
 LOGICAL :: LEX
 TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:) :: IDF_SAMPLE

 IF(NIDFLIST.LE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You cannot add an artificial well whenever NO IDF files are active in 3D.','Warning')
  RETURN
 ENDIF
 
 IF(ALLOCATED(IDF_SAMPLE))DEALLOCATE(IDF_SAMPLE); ALLOCATE(IDF_SAMPLE(NIDFLIST),Z(NIDFLIST),IORDER(NIDFLIST),IIDF(NIDFLIST))
 DO I=1,NIDFLIST; CALL IDFNULLIFY(IDF_SAMPLE(I)); ENDDO
 DO I=1,NIDFLIST; IF(.NOT.IDFREAD(IDF_SAMPLE(I),IDFPLOT(I)%FNAME,0))EXIT; ENDDO
 
 IF(IOPT.EQ.1)THEN
  ALLOCATE(XYZWELL(1)); NXYZWELL=1; XYZWELL(1)%X=X; XYZWELL(1)%Y=Y
 ELSEIF(IOPT.EQ.2)THEN
  IU=UTL_GETUNIT(); OPEN(IU,FILE=PNTFNAME,STATUS='OLD',ACTION='READ')
  EXT=PNTFNAME(INDEX(PNTFNAME,'.',.TRUE.)+1:)
  IF(UTL_CAP(EXT,'U').EQ.'IPF')THEN
   READ(IU,*) NXYZWELL
   ALLOCATE(XYZWELL(NXYZWELL))
   READ(IU,*) K; DO I=1,K+1; READ(IU,*); ENDDO
   DO I=1,NXYZWELL; READ(IU,*) XYZWELL(I)%X,XYZWELL(I)%Y; ENDDO
  ELSE
   DO I=1,2
    READ(IU,*)
    NXYZWELL=0; DO
     READ(IU,'(A256)',IOSTAT=IOS) LINE
     IF(IOS.NE.0)EXIT
     NXYZWELL=NXYZWELL+1
     IF(I.EQ.2)READ(LINE,*,IOSTAT=IOS) XYZWELL(NXYZWELL)%X,XYZWELL(NXYZWELL)%Y
    ENDDO
    IF(I.EQ.1)THEN; ALLOCATE(XYZWELL(NXYZWELL)); REWIND(IU); ENDIF  
   ENDDO
  ENDIF
  CLOSE(IU) 
 ENDIF

 !## create ipf file + txt file
 CALL UTL_CREATEDIR(TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL')
 IWEL=0; DO
  IWEL=IWEL+1
  FNAME=TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\ARTIFICIAL_WELLS_'//TRIM(ITOS(IWEL))//'.IPF'
  INQUIRE(FILE=FNAME,EXIST=LEX); IF(.NOT.LEX)EXIT
 ENDDO
 CALL UTL_CREATEDIR(TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\AW'//TRIM(ITOS(IWEL)))

 IU=UTL_GETUNIT(); OPEN(IU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
 
 WRITE(IU,'(I10)') NXYZWELL
 WRITE(IU,'(I10)') 3
 WRITE(IU,'(A2)') 'XC'
 WRITE(IU,'(A2)') 'YC'
 WRITE(IU,'(A2)') 'ID'
 WRITE(IU,'(A5)') '3,TXT'
 DO I=1,NXYZWELL
  CID='AW'//TRIM(ITOS(IWEL))//'\WELL_'//TRIM(ITOS(I))
  WRITE(IU,'(2(G15.7,1A),A)') XYZWELL(I)%X,',',XYZWELL(I)%Y,',',TRIM(CID)
  FNAME=TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\'//TRIM(CID)//'.TXT'
  JU=UTL_GETUNIT(); OPEN(JU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
  !## sample selected idf
  N=1
  DO J=1,NIDFLIST
   CALL IDFIROWICOL(IDF_SAMPLE(J),IROW,ICOL,XYZWELL(I)%X,XYZWELL(I)%Y)
   IF(IROW.GE.1.AND.IROW.LE.IDF_SAMPLE(J)%NROW.AND. &
      ICOL.GE.1.AND.ICOL.LE.IDF_SAMPLE(J)%NCOL)THEN
    IIDF(N)=J
    Z(N)=IDFGETVAL(IDF_SAMPLE(J),IROW,ICOL)
    IF(Z(N).NE.IDF_SAMPLE(J)%NODATA)N=N+1
   ENDIF
  END DO
  N=N-1
  !## sort data
  DO J=1,NIDFLIST ; IORDER(J)=J ; ENDDO
  IF(N.GT.0)CALL UTL_WSORT(Z,1,N,IFLAGS=SORTDESCEND,IORDER=IORDER)
  WRITE(JU,'(I10)') N
  WRITE(JU,'(A)') '2,2'
  WRITE(JU,'(A)') 'Z,-999.99'
  WRITE(JU,'(A)') 'FORMATION,-999.99'
  DO J=1,N
   K=IIDF(IORDER(J))
   WRITE(JU,'(G15.7,A)') Z(J),','//IDFPLOT(K)%ALIAS(1:INDEX(IDFPLOT(K)%ALIAS,'.',.TRUE.)-1)
  ENDDO
  CLOSE(JU)
 ENDDO 
 CLOSE(IU)
 
 !## write legend file
 FNAME=TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\ARTIFICIAL_WELLS_'//TRIM(ITOS(IWEL))//'.DLF'
 IU=UTL_GETUNIT(); OPEN(IU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
 WRITE(IU,'(A)') 'Litho,Ired,Igreen,Iblue,Litho-text'
 DO I=1,NIDFLIST
  FNAME=IDFPLOT(I)%ALIAS(1:INDEX(IDFPLOT(I)%ALIAS,'.',.TRUE.)-1)
  IRGB=IDFPLOT(I)%ICOLOR; CALL WRGBSPLIT(IRGB,IRED,IGREEN,IBLUE)
  WRITE(IU,'(A)') CHAR(39)//TRIM(FNAME)//CHAR(39)//','//TRIM(ITOS(IRED))//','//TRIM(ITOS(IGREEN))//','//TRIM(ITOS(IBLUE))//','//CHAR(39)//TRIM(FNAME)//CHAR(39)
 ENDDO
 CLOSE(IU)

 IF(ALLOCATED(IDF_SAMPLE))DEALLOCATE(IDF_SAMPLE); ALLOCATE(IDF_SAMPLE(NIDFLIST))
 IF(ALLOCATED(Z))DEALLOCATE(Z); IF(ALLOCATED(IORDER))DEALLOCATE(IORDER); IF(ALLOCATED(IIDF))DEALLOCATE(IIDF)

 !## add them to the list of IPF files.
 FNAME=TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\ARTIFICIAL_WELLS_'//TRIM(ITOS(IWEL))//'.IPF'
 CALL WINDOWSELECT(0)
 CALL WMENUSETSTATE(ID_3DTOOL,2,0)
 CALL MANAGER_UTL_ADDFILE(IDFNAMEGIVEN=FNAME,LDEACTIVATE=.FALSE.)
 CALL WMENUSETSTATE(ID_3DTOOL,2,1)
 
 !## add them to iMOD Manager - keep selection retained
 IF(IMOD3D_IPF_INIT())THEN
  !## activate tab
  CALL IMOD3D_SETTINGSINIT_IPF()
  !## set new legend
  CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB2)
  CALL WDIALOGGETMENU(IDF_MENU2,ILEG)
  FNAME=TRIM(PREFVAL(1))//'\TMP\3D\ARTWELL\ARTIFICIAL_WELLS_'//TRIM(ITOS(IWEL))//'.DLF'
  CALL IPFGETVALUE_OPENSAVECOLOURS(FNAME,ID_OPEN,ID_D3DSETTINGS_TAB2,ILEG)
  !## fill display with drills
  IF(.NOT.IMOD3D_IPF(1,0))THEN; ENDIF
  !## refresh image and labels
  CALL IMOD3D_IPF_LABELS()
  !## enable identify option
  CALL WDIALOGSELECT(ID_D3DSETTINGS)
  CALL WDIALOGTABSTATE(IDF_TAB1,ID_D3DSETTINGS_TAB9,1)
 ENDIF
 
 END SUBROUTINE IMOD3D_ADDARTIFICIALWELLS
 
 !###======================================================================
 SUBROUTINE IMOD3D_SETUPDISPLAY_MISC(LADJTB) 
 !###======================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LADJTB
 INTEGER :: IZR
 
 !## nothing changed
 IF(.NOT.LADJTB)RETURN
 
! !## fill display with background
! IF(.NOT.IMOD3D_GEN())THEN; ENDIF
 
 IZR=0
 CALL WINDOWSELECT(IWIN3D)
 IF(WMENUGETSTATE(ID_ZRATIO1,ITEMCHECKED))IZR=1
 IF(WMENUGETSTATE(ID_ZRATIO2,ITEMCHECKED))IZR=2
 IF(WMENUGETSTATE(ID_ZRATIO3,ITEMCHECKED))IZR=3
 IF(WMENUGETSTATE(ID_ZRATIO4,ITEMCHECKED))IZR=4
 IF(WMENUGETSTATE(ID_ZRATIO5,ITEMCHECKED))IZR=5
 IF(WMENUGETSTATE(ID_ZRATIO6,ITEMCHECKED))IZR=6
 !## make sure one is selected
 IF(IZR.EQ.0)IZR=3
 
 IF(NIPFLIST.GT.0.OR.NIDFLIST.GT.0.OR.NIFFLIST.GT.0)THEN
  ZSCALE_FACTOR=ZR(IZR)
  INIT_ZSCALE_FACTOR=ZSCALE_FACTOR
 ENDIF

 !## set mid-location of view
 MIDPOS%Z=(TOP%Z+BOT%Z)/2.0_GLDOUBLE

 !## rotation point equal to midpoint
 ROTPOS=MIDPOS
 
 !## set/initiate lookat and lookfrom positions
 CALL IMOD3D_SETLOOKAT_LOOKFROM()
 
 !## make drawinglist for orientation
 CALL IMOD3D_SETUPORIENTATION()

 !## make drawinglist for axes
 CALL IMOD3D_SETUPAXES()
 !## make drawinglist for labels
 CALL IMOD3D_SETUPAXES_LABELS()

! !## make labels for ipfs
! CALL IMOD3D_IPF_LABELS()

 END SUBROUTINE IMOD3D_SETUPDISPLAY_MISC

 !###======================================================================
 SUBROUTINE IMOD3D_SETLOOKAT_LOOKFROM()
 !###======================================================================
 !## sets lookat to fit current view represented as a circle
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: D1,FOVYRAD,F

 INIT_SHIFTX=0.0_GLDOUBLE
 INIT_SHIFTY=0.0_GLDOUBLE 
 INIT_SHIFTZ=0.0_GLDOUBLE

 LOOKAT%X=ROTPOS%X !MIDPOS%X
 LOOKAT%Y=ROTPOS%Y !MIDPOS%Y
 LOOKAT%Z=ROTPOS%Z*ZSCALE_FACTOR !MIDPOS%Z*ZSCALE_FACTOR

 FOVYRAD=FOVY/(360.0_GLDOUBLE/(2.0_GLDOUBLE*PI_OPENGL))

 !## circle to describe entire volume
 D1=SQRT((TOP%X-BOT%X)**2.0D0+(TOP%Y-BOT%Y)**2.0D0+(ZSCALE_FACTOR*(TOP%Z-BOT%Z))**2.0D0)
 !## distance
 D1=(1.0_GLDOUBLE*D1)/ATAN(FOVYRAD)

 F=0.7D0
 LOOKFROM%X=LOOKAT%X-F*(0.5D0*D1)
 LOOKFROM%Y=LOOKAT%Y-F*(D1)
 LOOKFROM%Z=LOOKAT%Z+F*(0.5D0*D1) 
 
 ZFAR =2_GLDOUBLE*D1
 !## znear as far as you can, the depth buffer is scales non-linear, more detail in the beginning and less further
 ZNEAR=0.01_GLDOUBLE*D1

! !## printen ...
! write(*,*) zfar,znear,log(2.0)*zfar/znear
 
 END SUBROUTINE IMOD3D_SETLOOKAT_LOOKFROM

 !###======================================================================
 SUBROUTINE IMOD3D_SETUPAXES()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE) :: X1,X2,Y1,Y2,Z1,Z2,DX,DY,DZ,V1,V2,VI,DXY
 INTEGER :: I,J
 REAL(KIND=DP_KIND),PARAMETER :: D=100.0D0  !## 1/d=percentage of axes-lines

 X1=BOT%X 
 X2=TOP%X 
 Y1=BOT%Y 
 Y2=TOP%Y 
 Z1=BOT%Z
 Z2=TOP%Z

 !##----------------------------
 !## get filled background first
 !##----------------------------

 CALL IMOD3D_ERROR('IMOD3D_SETUPAXES_1')

 !## destroy current display list index
 IF(AXESINDEX(0).NE.0)CALL GLDELETELISTS(AXESINDEX(0),1_GLSIZEI)

 CALL IMOD3D_ERROR('IMOD3D_SETUPAXES_2')

 !## generate display-lists
 AXESINDEX(0)=GLGENLISTS(1)
 
 CALL GLNEWLIST(AXESINDEX(0),GL_COMPILE)

 CALL IMOD3D_ERROR('IMOD3D_SETUPAXES_3')
!The function was called between a call to glBegin and the corresponding call to glEnd.

 !## draw bottom
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X1,Y1,Z1)
   CALL GLVERTEX3D(X2,Y1,Z1)
   CALL GLVERTEX3D(X2,Y2,Z1)
   CALL GLVERTEX3D(X1,Y2,Z1)
  CALL GLEND()
  !## draw top
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X1,Y1,Z2)
   CALL GLVERTEX3D(X1,Y2,Z2)
   CALL GLVERTEX3D(X2,Y2,Z2)
   CALL GLVERTEX3D(X2,Y1,Z2)
  CALL GLEND()
  !## draw east
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X2,Y1,Z1)
   CALL GLVERTEX3D(X2,Y1,Z2)
   CALL GLVERTEX3D(X2,Y2,Z2)
   CALL GLVERTEX3D(X2,Y2,Z1)
  CALL GLEND()
  !## draw west
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X1,Y1,Z1)
   CALL GLVERTEX3D(X1,Y2,Z1)
   CALL GLVERTEX3D(X1,Y2,Z2)
   CALL GLVERTEX3D(X1,Y1,Z2)
  CALL GLEND()
  !## draw south
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X1,Y2,Z1)
   CALL GLVERTEX3D(X2,Y2,Z1)
   CALL GLVERTEX3D(X2,Y2,Z2)
   CALL GLVERTEX3D(X1,Y2,Z2)
  CALL GLEND()
  !## draw north
  CALL GLBEGIN(GL_POLYGON)
   CALL GLVERTEX3D(X1,Y1,Z1)
   CALL GLVERTEX3D(X1,Y1,Z2)
   CALL GLVERTEX3D(X2,Y1,Z2)
   CALL GLVERTEX3D(X2,Y1,Z1)
  CALL GLEND()

 CALL GLENDLIST()

 !##----------------------------
 !## get ribs of box secondly
 !##----------------------------

 !## destroy current display list index
 IF(AXESINDEX(1).NE.0)CALL GLDELETELISTS(AXESINDEX(1),1_GLSIZEI)

 !## generate display-lists
 AXESINDEX(1)=GLGENLISTS(1)
 CALL GLNEWLIST(AXESINDEX(1),GL_COMPILE)

  CALL GLLINEWIDTH(2.0_GLFLOAT)
  !## draw axes so we know the orientation
  CALL GLBEGIN(GL_LINES)

  !## bottom
  CALL GLVERTEX3D(X1,Y1,Z1)
  CALL GLVERTEX3D(X2,Y1,Z1)
  CALL GLVERTEX3D(X2,Y1,Z1)
  CALL GLVERTEX3D(X2,Y2,Z1)
  CALL GLVERTEX3D(X2,Y2,Z1)
  CALL GLVERTEX3D(X1,Y2,Z1)
  CALL GLVERTEX3D(X1,Y2,Z1)
  CALL GLVERTEX3D(X1,Y1,Z1)

  !## top
  CALL GLVERTEX3D(X2,Y1,Z2)
  CALL GLVERTEX3D(X2,Y2,Z2)
  CALL GLVERTEX3D(X2,Y2,Z2)
  CALL GLVERTEX3D(X1,Y2,Z2)

  !## ribs
  CALL GLVERTEX3D(X2,Y1,Z2)
  CALL GLVERTEX3D(X2,Y1,Z1)
  CALL GLVERTEX3D(X1,Y2,Z2)
  CALL GLVERTEX3D(X1,Y2,Z1)
  CALL GLVERTEX3D(X2,Y2,Z2)
  CALL GLVERTEX3D(X2,Y2,Z1)

  CALL GLEND()
  CALL GLLINEWIDTH(1.0_GLFLOAT)

 CALL GLENDLIST()

 !##----------------------------
 !## get axes secondly
 !##----------------------------

 !## destroy current display list index
 IF(AXESINDEX(2).NE.0)CALL GLDELETELISTS(AXESINDEX(2),1_GLSIZEI)

 !## generate display-lists
 AXESINDEX(2)=GLGENLISTS(1)
 CALL GLNEWLIST(AXESINDEX(2),GL_COMPILE)
  
  !## draw axes so we know the orientation
  CALL GLBEGIN(GL_LINES)

  !##===============
  !## x-axis
  !##===============

  !## get classes
  CALL UTL_GETAXESCALES(DBLE(BOT%X),DBLE(BOT%Y),DBLE(TOP%X),DBLE(TOP%Y))

  DX=(X2-X1)/100.0D0; DY=(Y2-Y1)/100.0D0; DXY=MIN(DX,DY)
  
  !## get axes-values in coordinate system of 3D
  V1= SXVALUE(1)  -(SXVALUE(2)-SXVALUE(1))
  V2= SXVALUE(NSX)+(SXVALUE(2)-SXVALUE(1))
  V1= X1+(V1-BOT%X)
  V2= X1+(V2-BOT%X)
  VI=(SXVALUE(2)-SXVALUE(1))
  
  VI=VI/4.0D0
  
  I=0; DO 
   I=I+1
    DX=V1+VI*DBLE(I-1) 
    IF(DX.GT.X1.AND.DX.LT.X2)THEN
     IF(MOD(I-1,4).EQ.0)THEN
      CALL GLVERTEX3D(DX,Y1-DXY*2.0D0,Z1); CALL GLVERTEX3D(DX,Y1+DXY*2.0D0,Z1)
      CALL GLVERTEX3D(DX,Y2-DXY*2.0D0,Z1); CALL GLVERTEX3D(DX,Y2+DXY*2.0D0,Z1)
      CALL GLVERTEX3D(DX,Y2-DXY*2.0D0,Z2); CALL GLVERTEX3D(DX,Y2+DXY*2.0D0,Z2)
     ELSE
      CALL GLVERTEX3D(DX,Y1-DXY,Z1); CALL GLVERTEX3D(DX,Y1+DXY,Z1)
      CALL GLVERTEX3D(DX,Y2-DXY,Z1); CALL GLVERTEX3D(DX,Y2+DXY,Z1)
      CALL GLVERTEX3D(DX,Y2-DXY,Z2); CALL GLVERTEX3D(DX,Y2+DXY,Z2)
     ENDIF
    ENDIF
   IF(DX.GT.X2)EXIT
  END DO

  !##===============
  !## y-axis
  !##===============

  V1= SYVALUE(1)  -(SYVALUE(2)-SYVALUE(1))  
  V2= SYVALUE(NSY)+(SYVALUE(2)-SYVALUE(1))
  V1= Y1+(V1-BOT%Y)
  V2= Y1+(V2-BOT%Y)
  VI=(SYVALUE(2)-SYVALUE(1))

  VI=VI/4.0D0

  I=0; DO 
   I=I+1
    DY=V1+VI*DBLE(I-1) 
    IF(DY.GT.Y1.AND.DY.LT.Y2)THEN
     IF(MOD(I-1,4).EQ.0)THEN
      CALL GLVERTEX3D(X1-DXY*2.0D0,DY,Z1); CALL GLVERTEX3D(X1+DXY*2.0D0,DY,Z1)
      CALL GLVERTEX3D(X2-DXY*2.0D0,DY,Z1); CALL GLVERTEX3D(X2+DXY*2.0D0,DY,Z1)
      CALL GLVERTEX3D(X2-DXY*2.0D0,DY,Z2); CALL GLVERTEX3D(X2+DXY*2.0D0,DY,Z2)
     ELSE
      CALL GLVERTEX3D(X1-DXY,DY,Z1); CALL GLVERTEX3D(X1+DXY,DY,Z1)
      CALL GLVERTEX3D(X2-DXY,DY,Z1); CALL GLVERTEX3D(X2+DXY,DY,Z1)
      CALL GLVERTEX3D(X2-DXY,DY,Z2); CALL GLVERTEX3D(X2+DXY,DY,Z2)
     ENDIF
    ENDIF
   IF(DY.GT.Y2)EXIT
  END DO

  !##===============
  !## z-axis
  !##===============

  CALL UTL_GETAXESCALES(DBLE(BOT%X),DBLE(BOT%Z),DBLE(TOP%X),DBLE(TOP%Z))

  V1= SYVALUE(1)   
  V2= SYVALUE(NSY) 
  V1= Z1+(V1-BOT%Z)
  V2= Z1+(V2-BOT%Z)
  VI=(SYVALUE(2)-SYVALUE(1))

  DO I=1,NSY 
   DO J=0,1
    DZ=V1+VI*(DBLE(I-1)+(DBLE(J)*0.5D0))
    IF(DZ.GT.Z1.AND.DZ.LT.Z2)THEN
     CALL GLVERTEX3D(X2-DXY,Y1,DZ); CALL GLVERTEX3D(X2+DXY,Y1,DZ)
     CALL GLVERTEX3D(X1-DXY,Y2,DZ); CALL GLVERTEX3D(X1+DXY,Y2,DZ)
     CALL GLVERTEX3D(X2-DXY,Y1,DZ); CALL GLVERTEX3D(X2+DXY,Y1,DZ)
    ENDIF
   END DO
  END DO

  CALL GLEND()
 CALL GLENDLIST()

 CALL IMOD3D_ERROR('IMOD3D_SETUPAXES')

 END SUBROUTINE IMOD3D_SETUPAXES

 !###======================================================================
 SUBROUTINE IMOD3D_SETUPAXES_LABELS()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE) :: X1,X2,Y1,Y2,Z1,Z2,DX,DY,DZ,V1,V2,VI,DT,FCT
 REAL(KIND=GLDOUBLE) :: XS,YS,ZS,TS
 INTEGER :: I 
 REAL(KIND=DP_KIND),PARAMETER :: D=100.0D0  !## 1/d=percentage of axes-lines
 CHARACTER(LEN=32) :: STRING
 
 X1=BOT%X
 X2=TOP%X
 Y1=BOT%Y
 Y2=TOP%Y
 Z1=BOT%Z
 Z2=TOP%Z

 !## kilometers
 FCT=1000.0D0

 DT=MIN((Y2-Y1)/D,(X2-X1)/D)
 TS=2.5_GLDOUBLE*DT
 
 XS=XSCALE_FACTOR
 YS=YSCALE_FACTOR
 ZS=ZSCALE_FACTOR

 !## destroy current display list index
 IF(AXESINDEX(3).NE.0)CALL GLDELETELISTS(AXESINDEX(3),1_GLSIZEI)

 AXESINDEX(3)=GLGENLISTS(1)
 CALL GLNEWLIST(AXESINDEX(3),GL_COMPILE)

 CALL UTL_GETAXESCALES(REAL(BOT%X,8),REAL(BOT%Y,8),REAL(TOP%X,8),REAL(TOP%Y,8))

  !## ------------------------
  !## write X-axes-information
  !## ------------------------

  V1=SXVALUE(1)
  V2=SXVALUE(NSX) 
  V1= X1+(V1-BOT%X)
  V2= X1+(V2-BOT%X)
  VI=(SXVALUE(2)-SXVALUE(1))

  !## write X-axes-information
  DY=DT*2.0D0
  I=0; DO 
   I=I+1
   DX=V1+VI*REAL(I-1)
   IF(DX.GT.X2)EXIT
   IF(DX.GT.X1.AND.DX.LT.X2)THEN

    WRITE(STRING,UTL_GETFORMAT(REAL(DX/FCT,8))) DX/FCT

    !## bottom
    CALL WGLTEXTORIENTATION(ALIGNLEFT)
    CALL GLPUSHMATRIX()
    CALL GLTRANSLATED(DX,Y1-DY,Z1)
    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
    CALL GLSCALED(TS,TS,TS)
    CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
    CALL WGLTEXTSTRING(TRIM(ADJUSTL(STRING)))
    CALL GLPOPMATRIX()
!    !## top
!    CALL WGLTEXTORIENTATION(ALIGNRIGHT)
!    CALL GLPUSHMATRIX()
!    CALL GLTRANSLATED(DX,Y2+DY,Z2)
!    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!    CALL GLSCALED(TS,TS,TS)
!    CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
!    CALL WGLTEXTSTRING(TRIM(ADJUSTR(STRING)))
!    CALL GLPOPMATRIX()
   ENDIF
  END DO

  DY=DT*3.0D0
  CALL WGLTEXTORIENTATION(ALIGNCENTRE)
!  CALL GLPUSHMATRIX()
!  CALL GLTRANSLATED((V2+V1)/2.0,Y1-DY,Z1)
!  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!  CALL GLSCALED(TS,TS,TS)
!  CALL WGLTEXTSTRING('x coordinate (km)')
!  CALL GLPOPMATRIX()
  CALL GLPUSHMATRIX()
  CALL GLTRANSLATED((V2+V1)/2.0,Y2+DY,Z2)
  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
  CALL GLSCALED(TS,TS,TS)
  CALL WGLTEXTSTRING('x coordinate (km)')
  CALL GLPOPMATRIX()

  !## ------------------------
  !## write Y-axes-information
  !## ------------------------

  V1=SYVALUE(1)
  V2=SYVALUE(NSY)
  V1= Y1+(V1-BOT%Y)
  V2= Y1+(V2-BOT%Y)
  VI=(SYVALUE(2)-SYVALUE(1))
  
  DX=DT*2.0D0
  I=0; DO 
   I=I+1
   DY=V1+VI*REAL(I-1)
   IF(DY.GT.Y2)EXIT
   IF(DY.GT.Y1.AND.DY.LT.Y2)THEN

    WRITE(STRING,UTL_GETFORMAT(REAL(DY/FCT,8))) DY/FCT

    !## left
    CALL WGLTEXTORIENTATION(ALIGNRIGHT)
    CALL GLPUSHMATRIX()
    CALL GLTRANSLATED(X1-DX,DY,Z1)
    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
    CALL GLSCALED(TS,TS,TS)
    CALL WGLTEXTSTRING(TRIM(ADJUSTR(STRING)))
    CALL GLPOPMATRIX()
    !## right
!    CALL WGLTEXTORIENTATION(ALIGNLEFT)
!    CALL GLPUSHMATRIX()
!    CALL GLTRANSLATED(X2+DX,DY,Z2)
!    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!    CALL GLSCALED(TS,TS,TS)
!    CALL WGLTEXTSTRING(TRIM(ADJUSTL(STRING)))
!    CALL GLPOPMATRIX()
   ENDIF
  ENDDO

  DX=DT*3.0D0
  CALL WGLTEXTORIENTATION(ALIGNCENTRE)
!  CALL GLPUSHMATRIX()
!  CALL GLTRANSLATED(X1-DX,(V1+V2)/2.0,Z1)
!  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!  CALL GLSCALED(TS,TS,TS)
!  CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
!  CALL WGLTEXTSTRING('y coordinate (km)')
!  CALL GLPOPMATRIX()
  CALL GLPUSHMATRIX()
  CALL GLTRANSLATED(X2+DX,(V1+V2)/2.0,Z2)
  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
  CALL GLSCALED(TS,TS,TS)
  CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
  CALL WGLTEXTSTRING('y coordinate (km)')
  CALL GLPOPMATRIX()

  !## ------------------------
  !## write Z-axes-information
  !## ------------------------

  CALL UTL_GETAXESCALES(REAL(BOT%X,8),REAL(BOT%Z,8),REAL(TOP%X,8),REAL(TOP%Z,8))
 
  V1=SYVALUE(1)
  V2=SYVALUE(NSY)
  V1= Z1+(V1-BOT%Z)
  V2= Z1+(V2-BOT%Z)
  VI=(SYVALUE(2)-SYVALUE(1))

  DX=DT*2.0D0
  DO I=1,NSY
   DZ=V1+VI*REAL(I-1)
   IF(DZ.GT.Z1.AND.DZ.LT.Z2)THEN

    WRITE(STRING,UTL_GETFORMAT(REAL(DZ,8))) DZ

    !## left
    CALL WGLTEXTORIENTATION(ALIGNRIGHT)
    CALL GLPUSHMATRIX()
    CALL GLTRANSLATED(X1-DX,Y2,DZ)
    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
    CALL GLSCALED(TS,TS,TS)
    CALL GLROTATED( 90.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE)
    CALL WGLTEXTSTRING(TRIM(ADJUSTR(STRING)))
    CALL GLPOPMATRIX()
!    !## right
!    CALL WGLTEXTORIENTATION(ALIGNLEFT)
!    CALL GLPUSHMATRIX()
!    CALL GLTRANSLATED(X2+DX,Y1,DZ)
!    CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!    CALL GLSCALED(TS,TS,TS)
!    CALL GLROTATED( 90.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE)
!    CALL WGLTEXTSTRING(TRIM(ADJUSTL(STRING)))
!    CALL GLPOPMATRIX()
   ENDIF
  ENDDO

!  CALL GLPUSHMATRIX()
!  CALL GLTRANSLATED(X1-DX,Y2,REAL(TOP%Z+BOT%Z)/2.0)
!  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
!  CALL GLSCALED(TS,TS,TS)
!  CALL GLROTATED( 90.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE)
!  CALL GLTRANSLATED(-DX*60.0D0,0.0D0,0.0D0)
!  CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
!  CALL WGLTEXTORIENTATION(ALIGNCENTRE)
!  CALL WGLTEXTSTRING('elevation (m)')
!  CALL GLPOPMATRIX()
  CALL GLPUSHMATRIX()
  CALL GLTRANSLATED(X2+DX,Y1,(TOP%Z+BOT%Z)/2.0_GLDOUBLE)
  CALL GLSCALED(1.0_GLDOUBLE/XS,1.0_GLDOUBLE/YS,1.0_GLDOUBLE/ZS)
  CALL GLSCALED(TS,TS,TS)
  CALL GLROTATED( 90.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE)
  CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
  CALL WGLTEXTORIENTATION(ALIGNCENTRE)
  CALL WGLTEXTSTRING('elevation (m)')
  CALL GLPOPMATRIX()

 CALL GLENDLIST()

 CALL IMOD3D_ERROR('IMOD3D_SETUPAXES_LABELS')

 END SUBROUTINE IMOD3D_SETUPAXES_LABELS

 !###======================================================================
 SUBROUTINE IMOD3D_SETUPORIENTATION()
 !###======================================================================
 IMPLICIT NONE
! REAL(KIND=GLDOUBLE) :: DX,DY,DZ,X,Y,Z
! REAL(KIND=GLDOUBLE),PARAMETER :: TS= 0.25D0 !## textsize

 !## destroy current display list index
 IF(ORIENTINDEX.NE.0)CALL GLDELETELISTS(ORIENTINDEX,1_GLSIZEI)
 
 !ORIENTINDEX=GLGENLISTS(1); CALL GLNEWLIST(ORIENTINDEX,GL_COMPILE)
 !
 !!## draw axes so we know the orientation
 !CALL GLBEGIN(GL_LINES)
 !
 !DX=0.75_GLDOUBLE; DY=0.75_GLDOUBLE; DZ=0.75_GLDOUBLE
 !
 !X=0.0_GLDOUBLE; Y=0.0_GLDOUBLE; Z=LOOKAT%Z  !## dit werkt ... logisch???
 !
 !!## bottom
 !CALL GLVERTEX3D(X,Y,Z)
 !CALL GLVERTEX3D(DX,Y,Z)
 !CALL GLVERTEX3D(X,Y,Z)
 !CALL GLVERTEX3D(X,DY,Z)
 !CALL GLVERTEX3D(X,Y,Z)
 !CALL GLVERTEX3D(X,Y,DZ+Z)
 !
 !CALL GLEND()
 !
 !CALL WGLTEXTORIENTATION(ALIGNLEFT)
 !
 !CALL GLPUSHMATRIX()
 !CALL GLTRANSLATED(DX,0.0_GLDOUBLE,Z)
 !CALL GLSCALED(TS,TS,TS)
 !CALL WGLTEXTSTRING('East')
 !CALL GLPOPMATRIX()
 !
 !CALL GLPUSHMATRIX()
 !CALL GLTRANSLATED(0.0_GLDOUBLE,DY,Z)
 !CALL GLSCALED(TS,TS,TS)
 !CALL GLROTATED(90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
 !CALL WGLTEXTSTRING('North')
 !CALL GLPOPMATRIX()
 !
 !CALL GLPUSHMATRIX()
 !CALL GLTRANSLATED(0.0_GLDOUBLE,0.0_GLDOUBLE,DZ+Z)
 !CALL GLSCALED(TS,TS,TS)
 !CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE)
 !CALL WGLTEXTSTRING('Top')
 !CALL GLPOPMATRIX()
 !
 !CALL GLENDLIST()
 !
 !CALL IMOD3D_ERROR('IMOD3D_SETUPORIENTATION')

 END SUBROUTINE IMOD3D_SETUPORIENTATION

 !###======================================================================
 SUBROUTINE IMOD3D_LEGEND_MAIN() 
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,LLST,ILEG
 REAL(KIND=GLDOUBLE) :: X,Y,DX,DY,DDY,RAT
 INTEGER(GLINT) :: IVIEWPORT(4)
 REAL(KIND=GLDOUBLE),PARAMETER :: XSIZE=1.5_GLDOUBLE
 REAL(KIND=GLDOUBLE),PARAMETER :: TS=XSIZE*0.9_GLDOUBLE !## textsize
 
 IF(LEGENDINDEX.NE.0)CALL GLDELETELISTS(LEGENDINDEX,1_GLSIZEI); LEGENDINDEX=0
 I=0
 IF(NIDFLIST.GT.0)THEN; IF(SUM(IDFPLOT%IPLOTLEGEND).GT.0)I=I+1; ENDIF
 IF(NIPFLIST.GT.0)THEN; IF(SUM(IPFPLOT%IPLOTLEGEND).GT.0)I=I+1; ENDIF
 IF(NIFFLIST.GT.0)THEN; IF(SUM(IFFPLOT%IPLOTLEGEND).GT.0)I=I+1; ENDIF
 IF(I.EQ.0)RETURN
 
 CALL GLGETINTEGERV(GL_VIEWPORT,IVIEWPORT)
 RAT=REAL(IVIEWPORT(4))/REAL(IVIEWPORT(3))
 !## size of colour box (1% of width = 100)
 !## width>heigth
 IF(RAT.LT.1.0D0)THEN
  DY=XSIZE; DX=DY*RAT
 !## heigth>width
 ELSE
  DX=XSIZE; DY=DX/RAT
 ENDIF

 LEGENDINDEX=GLGENLISTS(1)
 CALL GLNEWLIST(LEGENDINDEX,GL_COMPILE)
 CALL IMOD3D_SETCOLOR(WRGB(255,255,255))  !## white

 CALL WGLTEXTORIENTATION(ALIGNLEFT)
 
 !## start box
 X=DX; Y=100_GLDOUBLE-DY

 DO I=1,NIDFLIST
  IF(IDFPLOT(I)%ISEL.EQ.0.OR.IDFPLOT(I)%IPLOTLEGEND.EQ.0)CYCLE

  !## single colour legend
  IF(IDFPLOT(I)%ILEG.EQ.1)THEN
   !## colour box
   CALL IMOD3D_SETCOLOR(IDFPLOT(I)%ICOLOR)
   CALL GLBEGIN(GL_POLYGON)
    CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
   CALL GLEND()
   CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
   CALL GLLINEWIDTH(1.0)
   CALL GLBEGIN(GL_LINES)
    CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
   CALL GLEND()

   CALL GLPUSHMATRIX()
    CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
    CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
    CALL GLSCALED(TS,TS,TS)
    CALL WGLTEXTSTRING(TRIM(IDFPLOT(I)%ALIAS))
   CALL GLPOPMATRIX()
   
  !## legend colouring
  ELSEIF(IDFPLOT(I)%ILEG.EQ.2)THEN

   LLST=IDFPLOT(IDFPLOT(I)%IDFLEGEND)%ILIST
   !## classes
   IF(IDFPLOT(LLST)%LEG%NCLR.LE.MXCLASS)THEN
   
    DO J=1,IDFPLOT(LLST)%LEG%NCLR

     CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
     CALL GLPUSHMATRIX()
      CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
      CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
      CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(IDFPLOT(LLST)%LEG%LEGTXT(J)))
     CALL GLPOPMATRIX()

     CALL IMOD3D_SETCOLOR(IDFPLOT(LLST)%LEG%RGB(J))
     CALL GLBEGIN(GL_POLYGON)
      CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
     CALL GLEND()
     CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
     CALL GLLINEWIDTH(1.0)
     CALL GLBEGIN(GL_LINES)
      CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
     CALL GLEND()
     IF(J.NE.IDFPLOT(LLST)%LEG%NCLR)Y=Y-(DY*1.5_GLDOUBLE)

    ENDDO 

   !## 256 colours
   ELSE

    CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(IDFPLOT(LLST)%LEG%LEGTXT(1)))
    CALL GLPOPMATRIX()

    DDY=3.0_GLDOUBLE; DDY=((DDY-1.0_GLDOUBLE)*1.5_GLDOUBLE)+1.5_GLDOUBLE
    DDY=(DDY*DY)/REAL(IDFPLOT(LLST)%LEG%NCLR)
    DO J=1,IDFPLOT(I)%LEG%NCLR
     CALL IMOD3D_SETCOLOR(IDFPLOT(LLST)%LEG%RGB(J))
     CALL GLBEGIN(GL_POLYGON)
      CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE);  CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y-DDY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DDY,0.0_GLDOUBLE)
     CALL GLEND()
     Y=Y-DDY
    ENDDO 

    Y=Y+DY 
    CALL IMOD3D_SETCOLOR(WRGB(0,0,0))
    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(IDFPLOT(LLST)%LEG%LEGTXT(IDFPLOT(LLST)%LEG%NCLR)))
    CALL GLPOPMATRIX()
   ENDIF
   
  ENDIF

  Y=Y-(DY*1.5_GLDOUBLE)
    
 ENDDO

 DO I=1,NIFFLIST
  IF(IFFPLOT(I)%ISEL.EQ.0.OR.IFFPLOT(I)%IPLOTLEGEND.EQ.0)CYCLE

  !## single colour legend
  IF(MP(IFFPLOT(I)%IPLOT)%ILEG.EQ.0)THEN
   !## colour box
   CALL IMOD3D_SETCOLOR(MP(IFFPLOT(I)%IPLOT)%SCOLOR)
   CALL GLLINEWIDTH(2.0)
   CALL GLBEGIN(GL_LINES)
    CALL GLVERTEX3D(X       ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX    ,Y   ,0.0_GLDOUBLE)
   CALL GLEND()
   CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
   CALL GLLINEWIDTH(1.0)
   CALL GLBEGIN(GL_LINES)
    CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
    CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
   CALL GLEND()
   CALL GLPUSHMATRIX()
    CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) !X,Y,0.0_GLDOUBLE)
    CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
    CALL GLSCALED(TS,TS,TS)
    CALL WGLTEXTSTRING(TRIM(IFFPLOT(I)%FNAME))
   CALL GLPOPMATRIX()
   
  !## legend colouring
  ELSEIF(MP(IFFPLOT(I)%IPLOT)%ILEG.EQ.1)THEN

   !## classes
   IF(MP(IFFPLOT(I)%IPLOT)%LEG%NCLR.LE.MXCLASS)THEN
  
    DO J=1,MP(IFFPLOT(I)%IPLOT)%LEG%NCLR

     CALL IMOD3D_SETCOLOR(WRGB(0,0,0))
     CALL GLPUSHMATRIX()
      CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
      CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
      CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IFFPLOT(I)%IPLOT)%LEG%LEGTXT(J)))
     CALL GLPOPMATRIX()

     CALL IMOD3D_SETCOLOR(MP(IFFPLOT(I)%IPLOT)%LEG%RGB(J))
     CALL GLLINEWIDTH(2.0)
     CALL GLBEGIN(GL_LINES)
      CALL GLVERTEX3D(X       ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX    ,Y   ,0.0_GLDOUBLE)
     CALL GLEND()
     CALL GLLINEWIDTH(1.0)
     CALL GLBEGIN(GL_LINES)
      CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
     CALL GLEND()

     IF(J.NE.MP(IFFPLOT(I)%IPLOT)%LEG%NCLR)Y=Y-(DY*1.5_GLDOUBLE)

    ENDDO 

   !## 256 colours
   ELSE

    CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IFFPLOT(I)%IPLOT)%LEG%LEGTXT(1)))
    CALL GLPOPMATRIX()

    DDY=3.0_GLDOUBLE; DDY=((DDY-1.0_GLDOUBLE)*1.5_GLDOUBLE)+1.5_GLDOUBLE
    DDY=(DDY*DY)/REAL(MP(IFFPLOT(I)%IPLOT)%LEG%NCLR)
    DO J=1,MP(IFFPLOT(I)%IPLOT)%LEG%NCLR
     CALL IMOD3D_SETCOLOR(MP(IFFPLOT(I)%IPLOT)%LEG%RGB(J))
     CALL GLBEGIN(GL_POLYGON)
      CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE);  CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
      CALL GLVERTEX3D(X+DX,Y-DDY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DDY,0.0_GLDOUBLE)
     CALL GLEND()
     Y=Y-DDY
    ENDDO 

    Y=Y+DY 
    CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IFFPLOT(I)%IPLOT)%LEG%LEGTXT(MP(IFFPLOT(I)%IPLOT)%LEG%NCLR)))
    CALL GLPOPMATRIX()
   ENDIF
   
  ENDIF

  Y=Y-(DY*1.5_GLDOUBLE)
    
 ENDDO

 DO I=1,NIPF
  IF(IPFPLOT(I)%ISEL.EQ.0.OR.IPFPLOT(I)%IPLOTLEGEND.EQ.0)CYCLE

  !## plot legend (dlf)
  IF(IPF(I)%ACOL.NE.0)THEN
   
   ILEG=IPFPLOT(I)%ILEGDLF
   
   DO J=1,NLITHO(ILEG)

    CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(BH(ILEG,J)%LITHOTXT))
    CALL GLPOPMATRIX() 

    CALL IMOD3D_SETCOLOR(BH(ILEG,J)%LITHOCLR)
    CALL GLBEGIN(GL_POLYGON)
     CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
    CALL GLEND()
    CALL GLLINEWIDTH(1.0)
    CALL GLBEGIN(GL_LINES)
     CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
    CALL GLEND()

    IF(J.NE.NLITHO(ILEG))Y=Y-(DY*1.5_GLDOUBLE)

   ENDDO 

  ELSE
   
   !## single colour legend
   IF(MP(IPFPLOT(I)%IPLOT)%ILEG.EQ.0)THEN
    !## colour box
    CALL IMOD3D_SETCOLOR(MP(IPFPLOT(I)%IPLOT)%SCOLOR)
    CALL GLLINEWIDTH(2.0)
    CALL GLBEGIN(GL_LINES) 
     CALL GLVERTEX3D(X       ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX    ,Y   ,0.0_GLDOUBLE)
    CALL GLEND()
    CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
    CALL GLLINEWIDTH(1.0)
    CALL GLBEGIN(GL_LINES)
     CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
     CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
    CALL GLEND()

    CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) !X,Y,0.0_GLDOUBLE)
     CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
     CALL GLSCALED(TS,TS,TS)
     CALL WGLTEXTSTRING(TRIM(IPFPLOT(I)%FNAME))
    CALL GLPOPMATRIX()
   !## legend colouring
   ELSEIF(MP(IPFPLOT(I)%IPLOT)%ILEG.EQ.1)THEN
    !## classes
    IF(MP(IPFPLOT(I)%IPLOT)%LEG%NCLR.LE.MXCLASS)THEN
   
     DO J=1,MP(IPFPLOT(I)%IPLOT)%LEG%NCLR  

      CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
      CALL GLPUSHMATRIX()
       CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
       CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
       CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IPFPLOT(I)%IPLOT)%LEG%LEGTXT(J)))
      CALL GLPOPMATRIX() 

      CALL IMOD3D_SETCOLOR(MP(IPFPLOT(I)%IPLOT)%LEG%RGB(J))
      CALL GLLINEWIDTH(2.0)
      CALL GLBEGIN(GL_LINES) 
       CALL GLVERTEX3D(X       ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X+DX*0.3,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X+DX*0.6,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX    ,Y   ,0.0_GLDOUBLE)
      CALL GLEND()
      CALL GLLINEWIDTH(1.0)
      CALL GLBEGIN(GL_LINES)
       CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE); CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X+DX,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X   ,Y-DY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE)
      CALL GLEND()

      IF(J.NE.MP(IPFPLOT(I)%IPLOT)%LEG%NCLR)Y=Y-(DY*1.5_GLDOUBLE)

     ENDDO 

    !## 256 colours
    ELSE

     CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
     CALL GLPUSHMATRIX()
      CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
      CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
      CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IPFPLOT(I)%IPLOT)%LEG%LEGTXT(1)))
     CALL GLPOPMATRIX()

     DDY=3.0_GLDOUBLE; DDY=((DDY-1.0_GLDOUBLE)*1.5_GLDOUBLE)+1.5_GLDOUBLE
     DDY=(DDY*DY)/REAL(MP(IPFPLOT(I)%IPLOT)%LEG%NCLR)
     DO J=1,MP(IPFPLOT(I)%IPLOT)%LEG%NCLR
      CALL IMOD3D_SETCOLOR(MP(IPFPLOT(I)%IPLOT)%LEG%RGB(J))
      CALL GLBEGIN(GL_POLYGON)
       CALL GLVERTEX3D(X   ,Y   ,0.0_GLDOUBLE);  CALL GLVERTEX3D(X+DX,Y   ,0.0_GLDOUBLE)
       CALL GLVERTEX3D(X+DX,Y-DDY,0.0_GLDOUBLE); CALL GLVERTEX3D(X   ,Y-DDY,0.0_GLDOUBLE)
      CALL GLEND()
      Y=Y-DDY
     ENDDO  

     Y=Y+DY 
     CALL IMOD3D_SETCOLOR(WRGB(0,0,0)) 
     CALL GLPUSHMATRIX()
      CALL GLTRANSLATED(X+(DX*1.5_GLDOUBLE),Y- DY+((XSIZE-TS)/2.0_GLDOUBLE),0.0_GLDOUBLE) 
      CALL GLSCALED(1.0_GLDOUBLE,1.0_GLDOUBLE/RAT,1.0_GLDOUBLE)
      CALL GLSCALED(TS,TS,TS); CALL WGLTEXTSTRING(TRIM(MP(IPFPLOT(I)%IPLOT)%LEG%LEGTXT(MP(IPFPLOT(I)%IPLOT)%LEG%NCLR)))
     CALL GLPOPMATRIX()
    ENDIF
   
   ENDIF
  
  ENDIF
  
  Y=Y-(DY*1.5_GLDOUBLE)
    
 ENDDO
 
 CALL GLENDLIST()
 
 END SUBROUTINE IMOD3D_LEGEND_MAIN

! !###======================================================================
! LOGICAL FUNCTION IMOD3D_LEGEND_INIT()
! !###======================================================================
! IMPLICIT NONE
! REAL(KIND=GLDOUBLE) :: X1,X2,Y1,Y2,Z
! 
! IMOD3D_LEGEND_INIT=.FALSE.
!
! X1=-XYZAXES(1); X2= XYZAXES(1); Y1=-XYZAXES(2); Y2= XYZAXES(2)
! Z=0.0_GLDOUBLE
!
! !## destroy current display list index
! IF(LEGENDINDEX.NE.0)CALL GLDELETELISTS(LEGENDINDEX,1_GLSIZEI)
! LEGENDINDEX=GLGENLISTS(1); CALL GLNEWLIST(LEGENDINDEX,GL_COMPILE)
!
! !## draw axes so we know the orientation
! CALL GLBEGIN(GL_QUADS)
!
! !## connect 2d texture to 3d object
! CALL GLVERTEX3D(X1,Y1,Z)
! CALL GLVERTEX3D(X1,Y2,Z)
! CALL GLVERTEX3D(X2,Y2,Z)
! CALL GLVERTEX3D(X2,Y1,Z)
!
! CALL GLEND()
!
! CALL GLENDLIST()
!
! IMOD3D_LEGEND_INIT=.TRUE.
!
! CALL IMOD3D_ERROR('IMOD3D_LEGEND')
!
! END FUNCTION IMOD3D_LEGEND_INIT
!
! !###======================================================================
! LOGICAL FUNCTION IMOD3D_LEGEND_BITMAP()
! !###======================================================================
! IMPLICIT NONE
! INTEGER(GLSIZEI) :: IWIDTH,IHEIGHT
! INTEGER,ALLOCATABLE,DIMENSION(:) :: IBMPDATA
! INTEGER :: I,J,IW,IH,IOS
! REAL(KIND=GLDOUBLE),ALLOCATABLE,DIMENSION(:) :: FRGB
!
! IMOD3D_LEGEND_BITMAP=.FALSE.
! 
! !## get display-list pointers
! LEGENDINDEX=0
!
! !## create legend ...
! 
! IWIDTH =WINFOBITMAP(MPW%IBITMAP,BITMAPWIDTH)
! IHEIGHT=WINFOBITMAP(MPW%IBITMAP,BITMAPHEIGHT)
! ALLOCATE(IBMPDATA(IWIDTH*IHEIGHT),STAT=IOS)
! IF(IOS.NE.0)THEN
!  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot allocate enough memory IBMPDATA() to store background image','Error'); RETURN
! ENDIF
!
! ALPHA=0.75_GLDOUBLE
! IALPHA=1
!
! ALLOCATE(FRGB(IWIDTH*IHEIGHT*(3+IALPHA)),STAT=IOS)
! IF(IOS.NE.0)THEN
!  DEALLOCATE(IBMPDATA)
!  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot allocate enough memory FRGB() to store background image','Error'); RETURN
! ENDIF
!
! CALL WBITMAPPUTDATA(MPW%IBITMAP,IBMPDATA)
!
! !## draw pixels at the current rasterposition
! J=-2-IALPHA
! DO IH=IHEIGHT,1,-1
!  DO IW=1,IWIDTH
!   J=J+3+IALPHA
!   I=(IH-1)*IWIDTH+IW
!   CALL IMOD3D_RETURNCOLOR(IBMPDATA(I),FRGB(J))
!   IF(IALPHA.EQ.1)THEN
!    FRGB(J+3)=ALPHA !## alpha value
!   ENDIF
!  ENDDO
! ENDDO
!
! !## turns on texturing
! CALL GLENABLE(GL_TEXTURE_2D)
! !## sets the drawing mode to GL_DECAL so that the textured
! !## polygons are drawn using the colors from the texture map (rather than taking into account what color the polygons
! !## would have been drawn without the texture)
! CALL GLTEXENVI(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_MODULATE)
! CALL GLCOLOR4D(1.0_GLDOUBLE,1.0_GLDOUBLE,1.0_GLDOUBLE,1.0_GLDOUBLE)
!
! !## it describes how the bitmap data is stored in computer memory
! CALL GLPIXELSTOREI(GL_UNPACK_ALIGNMENT,1)
!
! !## parameters indicate the size of the image, type of the image, location of the image, and other properties of it
! IF(IALPHA.EQ.0)THEN
!  CALL GLTEXIMAGE2D(GL_TEXTURE_2D,0_GLINT,3_GLINT,IWIDTH,IHEIGHT,0_GLINT,GL_RGB ,GL_FLOAT,FRGB)
! ELSE
!  CALL GLTEXIMAGE2D(GL_TEXTURE_2D,0_GLINT,GL_RGBA,IWIDTH,IHEIGHT,0_GLINT,GL_RGBA,GL_FLOAT,FRGB)
! ENDIF
!
! DEALLOCATE(IBMPDATA,FRGB)
!
! IMOD3D_LEGEND_BITMAP=.TRUE.
!
! CALL WINDOWOUTSTATUSBAR(2,'')
!
! CALL IMOD3D_ERROR('IMOD3D_LEGEND_INIT')
!
! END FUNCTION IMOD3D_LEGEND_BITMAP
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IDF_INIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I,N,ICLR
 
 IMOD3D_IDF_INIT=.FALSE.

 NIDFLIST=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5))THEN
   IF(MP(IPLOT)%IPLOT.EQ.5)THEN
    NIDFLIST=NIDFLIST+READMDF_GETN(MP(IPLOT)%IDFNAME)
   ELSE
    NIDFLIST=NIDFLIST+1
   ENDIF
  ENDIF
 ENDDO

 !## nothing to do - no idf"s found
 IF(NIDFLIST.LE.0)THEN; IMOD3D_IDF_INIT=.TRUE.; RETURN; ENDIF

 !## all idfs
 ALLOCATE(IDFPLOT(NIDFLIST))
 !## get display-list pointers - wireframe/solid
 ALLOCATE(IDFLISTINDEX(NIDFLIST))
 DO I=1,NIDFLIST; ALLOCATE(IDFLISTINDEX(I)%INDEX(1)); IDFLISTINDEX(I)%INDEX=0; ENDDO

 CALL WINDOWSELECT(IWIN3D)

 !## read idf
 NIDFLIST=0
 ICLR=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.(MP(IPLOT)%IPLOT.EQ.1.OR.MP(IPLOT)%IPLOT.EQ.5))THEN
   !## get idf for mdf file
   IF(MP(IPLOT)%IPLOT.EQ.5)THEN
    IF(READMDF(MP(IPLOT)%IDFNAME,N))THEN
     DO I=1,N
      NIDFLIST= NIDFLIST+1; ICLR=ICLR+1
      IDFPLOT(NIDFLIST)%ICOLOR =MDF(I)%SCOLOR  !## constant colour
      IDFPLOT(NIDFLIST)%ILEG   =1  !## constant colour
      IDFPLOT(NIDFLIST)%IFILL  =1  !## coloured (2=fishnet)
      IDFPLOT(NIDFLIST)%ISHADED=1  !## shaded
      IDFPLOT(NIDFLIST)%ISEL   =1  !## activated
      IDFPLOT(NIDFLIST)%ICLIP  =1  !## clipped
      IDFPLOT(NIDFLIST)%ILIST  =NIDFLIST  !## list sequence
      IDFPLOT(NIDFLIST)%ALIAS  =MDF(I)%ALIAS
      IDFPLOT(NIDFLIST)%FNAME  =MDF(I)%FNAME
      IDFPLOT(NIDFLIST)%IPLOT  =IPLOT !## IPLOT
      IDFPLOT(NIDFLIST)%ICOMBINE=NIDFLIST
      IDFPLOT(NIDFLIST)%IDFLEGEND=NIDFLIST
      IDFPLOT(NIDFLIST)%ICUBE   =1 !## plane
      IDFPLOT(NIDFLIST)%LEG     =MDF(I)%LEG !## legend
      IDFPLOT(NIDFLIST)%IPLOTLEGEND=0 !## plOT LEGEND
      IDFPLOT(NIDFLIST)%ZMIN=0.0D0
      IDFPLOT(NIDFLIST)%ZMAX=0.0D0
      IDFPLOT(NIDFLIST)%ITRANSPARANCY=0 !## opaque mode
      IDFPLOT(NIDFLIST)%ICONFIG=1
      IDFPLOT(NIDFLIST)%IACC=1
      IDFPLOT(NIDFLIST)%ISTACKED=0
     ENDDO
     CALL MDFDEALLOCATE()
    ENDIF
   ELSE
    NIDFLIST=NIDFLIST+1; ICLR=ICLR+1
    IDFPLOT(NIDFLIST)%ICOLOR =MP(IPLOT)%SCOLOR  !## constant colour
    IDFPLOT(NIDFLIST)%ILEG   =1  !## constant colour
    IDFPLOT(NIDFLIST)%IFILL  =1  !## coloured (2=fishnet)
    IDFPLOT(NIDFLIST)%ISHADED=1  !## shaded
    IDFPLOT(NIDFLIST)%ISEL   =1  !## activated
    IDFPLOT(NIDFLIST)%ICLIP  =1  !## clipped
    IDFPLOT(NIDFLIST)%ILIST  =NIDFLIST  !## list sequence
    IDFPLOT(NIDFLIST)%FNAME  =MP(IPLOT)%IDFNAME
    IDFPLOT(NIDFLIST)%IPLOT  =IPLOT
    IDFPLOT(NIDFLIST)%ALIAS  =MP(IPLOT)%ALIAS
    IDFPLOT(NIDFLIST)%ICOMBINE=NIDFLIST
    IDFPLOT(NIDFLIST)%IDFLEGEND=NIDFLIST
    IDFPLOT(NIDFLIST)%ICUBE  =1  !## plane
    IDFPLOT(NIDFLIST)%LEG    =MP(IPLOT)%LEG !## legend
    IDFPLOT(NIDFLIST)%IPLOTLEGEND=0 !## plOT LEGEND
    IDFPLOT(NIDFLIST)%ZMIN=0.0D0
    IDFPLOT(NIDFLIST)%ZMAX=0.0D0
    IDFPLOT(NIDFLIST)%ITRANSPARANCY=0 !## opagua mode 100
    IDFPLOT(NIDFLIST)%ICONFIG=1
    IDFPLOT(NIDFLIST)%IACC=1
    IDFPLOT(NIDFLIST)%ISTACKED=0
   ENDIF
  ENDIF
 ENDDO
 
 CALL WINDOWSELECT(IWIN3D)
  
 !## see what "meat we have in the bucket"
 ALLOCATE(IDF(1)); CALL IDFNULLIFY(IDF(1))
 DO I=1,NIDFLIST
  IF(.NOT.IDFREAD(IDF(1),IDFPLOT(I)%FNAME,0))EXIT
  IF(IDF(1)%ITB.EQ.1)IDFPLOT(I)%ICUBE=3 !## voxel
  IF(IDF(1)%IU.GT.0)CLOSE(IDF(1)%IU); IDF(1)%IU=0
 ENDDO
 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 
 CALL UTL_MESSAGEHANDLE(1)
 CALL IMOD3D_SETTINGS_IDF_ALIAS()
 IF(.NOT.IMOD3D_SETTINGS_IDF(0))RETURN
 CALL UTL_MESSAGEHANDLE(0)
 CALL IMOD3D_SETTINGS_IDF_ALIAS()
 
 !## draw planes/cubes/voxels/tplanes/tcubes/tvoxels
 IF(IMOD3D_REDRAWIDF(0))THEN; ENDIF
 !## draw vectors
 IF(IMOD3D_REDRAWIDF(1))THEN; ENDIF

 IF(ALLOCATED(NANSTRING))DEALLOCATE(NANSTRING)
 ALLOCATE(NANSTRING(NIDFLIST)); NANSTRING='NaN'

 CALL WINDOWOUTSTATUSBAR(2,'')

 IMOD3D_IDF_INIT=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_IDF')

 END FUNCTION IMOD3D_IDF_INIT

 !###======================================================================
 SUBROUTINE IMOD3D_SETTINGS_IDF_ALIAS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J
 CHARACTER(LEN=12) :: TXT
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
 
 DO I=1,SIZE(IDFPLOT)
  IF(IDFPLOT(I)%ICUBE.EQ.0)    THEN; TXT='outside'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.1)THEN; TXT='plane'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.2)THEN; TXT='cubes'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.3)THEN; TXT='voxel'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.4)THEN; TXT='vector'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.5)THEN; TXT='off'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.6)THEN; TXT='tplane'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.7)THEN; TXT='tcube'
  ELSEIF(IDFPLOT(I)%ICUBE.EQ.8)THEN; TXT='tvoxel'
  ENDIF
  IDFPLOT(I)%DISP_ALIAS='('//TRIM(ITOS(I))//'-'//TRIM(TXT)//') '//TRIM(IDFPLOT(I)%ALIAS)
  IF(IDFPLOT(I)%ICUBE.EQ.3.OR.IDFPLOT(I)%ICUBE.EQ.7)THEN
   IDFPLOT(I)%ILEG=2
  ELSE
   IF(IDFPLOT(I)%IDFLEGEND.NE.I)IDFPLOT(I)%ILEG=2
  ENDIF
 END DO
 
 IDFPLOT%DISP_ILIST=0; J=0
 DO I=1,NIDFLIST
  IF(IDFPLOT(I)%ICUBE.NE.5)THEN; J=J+1; IDFPLOT(J)%DISP_ILIST=I; IDFPLOT(J)%DISP_ALIAS=IDFPLOT(I)%DISP_ALIAS; ENDIF
 ENDDO
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB1); IDFPLOT%DISP_ISEL=1
 DISP_NIDFLIST=J; 
 ALLOCATE(TMPNAME(DISP_NIDFLIST),TMPINT(DISP_NIDFLIST)); TMPNAME=IDFPLOT%DISP_ALIAS; TMPINT=IDFPLOT%DISP_ISEL
 CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,DISP_NIDFLIST,TMPINT) ! IDFPLOT%DISP_ALIAS
 DEALLOCATE(TMPNAME,TMPINT)
 
 END SUBROUTINE IMOD3D_SETTINGS_IDF_ALIAS

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SETTINGS_IPF(IIPF)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIPF
 INTEGER :: I,ITYPE,N,IRGB,NQUERY
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=256) :: FNAME

 IMOD3D_SETTINGS_IPF=.FALSE.

 CALL WDIALOGLOAD(ID_D3DIPFSETTINGS,ID_D3DIPFSETTINGS)
 
 N=0; DO I=1,NSOLLIST; IF(SOLPLOT(I)%ISEL.EQ.1)N=N+1; ENDDO
 IF(N.LE.0)THEN; IPFPLOT(IIPF)%ISELECT(3)=0; CALL WDIALOGFIELDSTATE(IDF_CHECK3,0); ENDIF
 
 !## put selections
 IF(.NOT.IMOD3D_IPF_QUERY_INIT(IIPF))THEN
  CALL IMOD3D_IPF_QUERY_DEALLOCATE(); CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB2); RETURN
 ENDIF
 
 IF(IMOD3D_IPF_QUERY_FILL(IIPF))THEN
 NQUERY=IPFPLOT(IIPF)%NQUERY
   
  CALL UTL_DIALOGSHOW(-1,-1,0,3)

  DO
   CALL WMESSAGE(ITYPE,MESSAGE)
   SELECT CASE (ITYPE)
    CASE (FIELDCHANGED)
     SELECT CASE (MESSAGE%VALUE2)
      CASE (IDF_GRID1)
       IF(.NOT.IMOD3D_IPF_QUERY_FIELDS(MESSAGE,IIPF))THEN; ENDIF
      CASE (IDF_CHECK1)
       CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I); CALL WDIALOGFIELDSTATE(IDF_REAL1,I)
      CASE (IDF_CHECK2)
       CALL WDIALOGGETCHECKBOX(IDF_CHECK2,I); CALL WDIALOGFIELDSTATE(IDF_REAL2,I)
      CASE (IDF_CHECK3)
       CALL WDIALOGGETCHECKBOX(IDF_CHECK3,I); CALL WDIALOGFIELDSTATE(IDF_REAL3,I)
      CASE (IDF_CHECK5)
       CALL WDIALOGGETCHECKBOX(IDF_CHECK5,I); CALL WDIALOGFIELDSTATE(IDF_STRING1,I); CALL WDIALOGFIELDSTATE(ID_OPEN,I)
      CASE (IDF_RADIO1,IDF_RADIO2,IDF_CHECK4)
       CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,I); I=I-1
       CALL WDIALOGFIELDSTATE(IDF_CHECK4,I)
       IF(I.EQ.1)CALL WDIALOGGETCHECKBOX(IDF_CHECK4,I)
       CALL WDIALOGFIELDSTATE(IDF_COLOUR,I)
       CALL WDIALOGFIELDSTATE(IDF_LABEL6,I)
     END SELECT
    CASE (PUSHBUTTON)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (ID_OPEN)
       IF(UTL_WSELECTFILE('Load GEN File (*.gen)|*.gen|',LOADDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,&
        FNAME,'Load GEN File (*.gen)'))CALL WDIALOGPUTSTRING(IDF_STRING1,FNAME)    
      CASE (ID_NEW)
       IF(.NOT.IMOD3D_IPF_QUERY_NEW(IIPF))THEN; ENDIF
      CASE (ID_LOAD)
       IF(.NOT.IMOD3D_IPF_QUERY_LOAD(IIPF))THEN; ENDIF
      CASE (ID_SAVE,ID_SAVEAS)
       IF(.NOT.IMOD3D_IPF_QUERY_SAVE(IIPF,MESSAGE%VALUE1))THEN; ENDIF
      CASE (ID_DELETE)
       IF(.NOT.IMOD3D_IPF_QUERY_DELETE(IIPF))THEN; ENDIF
      CASE (ID_NEWCLAUSE)
       IF(IMOD3D_IPF_QUERY_READ(IIPF))THEN
        IF(.NOT.IMOD3D_IPF_QUERY_NEWCLAUSE(IIPF))THEN; ENDIF
       ENDIF
      CASE (ID_DELETECLAUSE)
       IF(IMOD3D_IPF_QUERY_READ(IIPF))THEN
        IF(.NOT.IMOD3D_IPF_QUERY_DELETECLAUSE(IIPF))THEN; ENDIF
       ENDIF
      CASE (IDF_COLOUR)
       IRGB=IPFPLOT(IIPF)%EXCLCOLOUR; CALL WSELECTCOLOUR(IRGB)
       IF(WINFODIALOG(4).EQ.1)IPFPLOT(IIPF)%EXCLCOLOUR=IRGB; CALL WDIALOGCOLOUR(IDF_LABEL6,IRGB,IRGB)
      CASE (IDOK)
       IF(IMOD3D_IPF_QUERY_READ(IIPF))THEN
        CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IPFPLOT(IIPF)%IEXCLUDE)
        CALL WDIALOGGETCHECKBOX(IDF_CHECK4,IPFPLOT(IIPF)%IEXCLCOLOUR)
        CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IPFPLOT(IIPF)%ISELECT(1))
        CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IPFPLOT(IIPF)%ISELECT(2))
        CALL WDIALOGGETCHECKBOX(IDF_CHECK3,IPFPLOT(IIPF)%ISELECT(3))
        CALL WDIALOGGETCHECKBOX(IDF_CHECK5,IPFPLOT(IIPF)%ISELECT(4))
        CALL WDIALOGGETDOUBLE(IDF_REAL1,IPFPLOT(IIPF)%RSELECT(1))
        CALL WDIALOGGETDOUBLE(IDF_REAL2,IPFPLOT(IIPF)%RSELECT(2))
        CALL WDIALOGGETDOUBLE(IDF_REAL3,IPFPLOT(IIPF)%RSELECT(3))
        CALL WDIALOGGETSTRING(IDF_STRING1,IPFPLOT(IIPF)%GENFNAME)
        EXIT
       ENDIF
      CASE (IDCANCEL)
       EXIT
      CASE (IDHELP)
       CALL UTL_GETHELP('5.3.2','TMO.3DT.PlotSet') 
     END SELECT
   END SELECT
  END DO
 
 ENDIF

 CALL IMOD3D_IPF_QUERY_DEALLOCATE()
 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB2)

 IF(MESSAGE%VALUE1.EQ.IDOK)THEN
  !## reconstruct ipf if needed ... is nquery was > 0 before entering this tool
  IF(IPFPLOT(IIPF)%NQUERY.GT.0.OR.IPFPLOT(IIPF)%NQUERY.NE.NQUERY)THEN
   !## reset ipf always for new selection ...
   CALL UTL_MESSAGEHANDLE(0); IF(.NOT.IMOD3D_IPF(1,0))THEN; ENDIF; CALL UTL_MESSAGEHANDLE(1)
  ENDIF
  !## apply global selections
  IF(IMOD3D_IPF_SELECTION(IIPF))THEN; ENDIF
 ENDIF
 
 IMOD3D_SETTINGS_IPF=.TRUE.

 END FUNCTION IMOD3D_SETTINGS_IPF
 
 !###======================================================================
 SUBROUTINE IMOD3D_SETTINGS_IPF_SELECTED()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,IIPF
 INTEGER,ALLOCATABLE,DIMENSION(:) :: NSEL
 
 ALLOCATE(NSEL(NIPF)); NSEL=0
  
 !## associated file drawn
 DO I=1,NIPFLIST
  !## skip those not equal to the current selected ipf file
  IIPF=IPFDLIST(1,I)
  IF(IPFDLIST(3,I).EQ.1)NSEL(IIPF)=NSEL(IIPF)+IPFDLIST(1,I)
!  IF(IPFPLOT(IIPF)%ISEL.EQ.1)NSEL(IIPF)=NSEL(IIPF)+IPFDLIST(1,I)
 ENDDO

 CALL WINDOWOUTSTATUSBAR(1,'Selected: '//TRIM(ITOS(SUM(NSEL)))//' out of '//TRIM(ITOS(NIPFLIST)))
 
 DEALLOCATE(NSEL)
 
 END SUBROUTINE IMOD3D_SETTINGS_IPF_SELECTED
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SETTINGS_IDF(IOPTION)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IOPTION
 INTEGER :: I,J,II,ITYPE,ICONFIG,N,M,IC1,IC2,IR1,IR2
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=52),DIMENSION(6) :: CACC
 INTEGER,DIMENSION(6,2) :: IACC
 LOGICAL :: LEX
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
 
 IF(IOPTION.EQ.0)THEN
  CALL WDIALOGLOAD(ID_D3DIDFSETTINGS,ID_D3DIDFSETTINGS)
  CALL WGRIDROWS(IDF_GRID1,NIDFLIST)
  ALLOCATE(TMPNAME(NIDFLIST),TMPINT(NIDFLIST)); TMPNAME=IDFPLOT%ALIAS
  CALL WGRIDPUTSTRING(IDF_GRID1,1,TMPNAME,NIDFLIST)
  CALL WGRIDSTATE(IDF_GRID1,1,2)
  TMPINT=IDFPLOT%ICUBE
  CALL WGRIDPUTMENU  (IDF_GRID1,2,IDFTYPES,SIZE(IDFTYPES),TMPINT,NIDFLIST)
  TMPINT=IDFPLOT%ICOMBINE
  CALL WGRIDPUTMENU  (IDF_GRID1,3,TMPNAME,NIDFLIST,TMPINT ,NIDFLIST)
  TMPINT=IDFPLOT%IDFLEGEND
  CALL WGRIDPUTMENU  (IDF_GRID1,4,TMPNAME,NIDFLIST,TMPINT,NIDFLIST)
  CALL WDIALOGPUTMENU(IDF_MENU3,IDFTYPES,SIZE(IDFTYPES),1)
  DEALLOCATE(TMPNAME,TMPINT)

  IDFDATA(3)=10; CALL WDIALOGPUTMENU(IDF_MENU2,SCLNAMES_UP,SIZE(SCLNAMES_UP),IDFDATA(3))

  N=0; M=0
  DO I=1,NIDFLIST
   CALL IDFIROWICOL(MP(IDFPLOT(I)%IPLOT)%IDF,IR2,IC1,BOT%X,BOT%Y)
   CALL IDFIROWICOL(MP(IDFPLOT(I)%IPLOT)%IDF,IR1,IC2,TOP%X,TOP%Y)
   IF(BOT%X.LE.MP(IDFPLOT(I)%IPLOT)%IDF%XMIN)IC1=1
   IF(TOP%X.GE.MP(IDFPLOT(I)%IPLOT)%IDF%XMAX)IC2=MP(IDFPLOT(I)%IPLOT)%IDF%NCOL
   IF(BOT%Y.LE.MP(IDFPLOT(I)%IPLOT)%IDF%YMIN)IR2=MP(IDFPLOT(I)%IPLOT)%IDF%NROW
   IF(TOP%Y.GE.MP(IDFPLOT(I)%IPLOT)%IDF%YMAX)IR1=1
   N=MAX(N,(IC2-IC1)+1)
   M=MAX(M,(IR2-IR1)+1)
  ENDDO
  I=N/5; J=M/5; I=MAX(1,MIN(100,I)) ; J=MAX(1,MIN(100,J))
  CACC(1)='Minimal (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(1,1)=I; IACC(1,2)=J
  I=N/4; J=M/4; I=MAX(1,MIN(250,I)) ; J=MAX(1,MIN(250,J))
  CACC(2)='Low (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(2,1)=I; IACC(2,2)=J
  I=N/3; J=M/3; I=MAX(1,MIN(500,I)) ; J=MAX(1,MIN(500,J))
  CACC(3)='Normal (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(3,1)=I; IACC(3,2)=J
  I=N/2; J=M/2; I=MAX(1,MIN(750,I)) ; J=MAX(1,MIN(750,J))
  CACC(4)='High (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(4,1)=I; IACC(4,2)=J
  I=N/1; J=M/1; I=MAX(1,MIN(1000,I)); J=MAX(1,MIN(1000,J))
  CACC(5)='Very High (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(5,1)=I; IACC(5,2)=J
  I=N/1; J=M/1; I=MAX(1,I); J=MAX(1,J)                            
  CACC(6)='Maximal (ncol '//TRIM(ITOS(I))//' x nrow '//TRIM(ITOS(J))//')'
  IACC(6,1)=I; IACC(6,2)=J

  DO I=6,1,-1; IF(IACC(I,1).LE.150.AND.IACC(I,2).LE.150)EXIT; ENDDO; I=MAX(I,1)
  IF(IOPTION.EQ.0)THEN
   CALL WDIALOGPUTMENU(IDF_MENU1,CACC,6,I)
  ELSE
   CALL WDIALOGPUTMENU(IDF_MENU1,CACC,6,IDFPLOT(1)%IACC)
  ENDIF
 
  CALL WDIALOGPUTSTRING(IDF_LABEL5,IMOD3D_CONFIGTXT(1))
 
 ELSE
 
  CALL WDIALOGSELECT(ID_D3DIDFSETTINGS) 
 
 ENDIF
 
 IF(DEMO%IDEMO.EQ.2)THEN
  ICONFIG=DEMO%CONFLAG
  I=DEMO%ACCFLAG
  CALL IMOD3D_SETTINGS_IDF_CONFIG(ICONFIG)
  MESSAGE%VALUE1=IDOK
  CALL WDIALOGPUTOPTION(IDF_MENU1,I)
  DEMO%IDEMO=0
 ELSE
  CALL UTL_DIALOGSHOW(-1,-1,0,3) 
  DO
   CALL WMESSAGE(ITYPE,MESSAGE)
   SELECT CASE (ITYPE)
    
    CASE (PUSHBUTTON)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (IDOK)
       ALLOCATE(TMPINT(NIDFLIST))
       CALL WGRIDGETMENU  (IDF_GRID1,2,TMPINT    ,NIDFLIST)
       IDFPLOT%ICUBE=TMPINT
       CALL WGRIDGETMENU  (IDF_GRID1,3,TMPINT ,NIDFLIST)
       IDFPLOT%ICOMBINE=TMPINT
       CALL WGRIDGETMENU  (IDF_GRID1,4,TMPINT,NIDFLIST)
       IDFPLOT%IDFLEGEND=TMPINT
       DEALLOCATE(TMPINT)
       !## if idftype contains a time-dependent entry - popup time-selection window
       LEX=.TRUE.; DO II=1,NIDFLIST; SELECT CASE (IDFPLOT(II)%ICUBE); CASE (6:8); LEX=IMOD3D_SETTINGS_IDF_GETTIMES(); EXIT; END SELECT; ENDDO
       CALL WDIALOGSELECT(ID_D3DIDFSETTINGS); IF(LEX)EXIT
      CASE (IDCANCEL)
       EXIT
      CASE (IDHELP)
       CALL UTL_GETHELP('5.3.2','TMO.3DT.PlotSet') 
     END SELECT

    CASE (FIELDCHANGED)
     SELECT CASE (MESSAGE%VALUE2)
      CASE (IDF_MENU4)
       CALL WDIALOGGETMENU(IDF_MENU4,ICONFIG)
       IDFPLOT%ICONFIG=ICONFIG
       CALL IMOD3D_SETTINGS_IDF_CONFIG(ICONFIG)

      CASE (IDF_MENU3)
       CALL WDIALOGGETMENU(IDF_MENU3,J)
       DO I=1,NIDFLIST; IDFPLOT(I)%ICUBE=J; ENDDO
       CALL WGRIDPUTMENU(IDF_GRID1,2,IDFTYPES,SIZE(IDFTYPES),IDFPLOT%ICUBE,NIDFLIST)      
     END SELECT   
   END SELECT
   CALL WDIALOGGETMENU(IDF_MENU1,I)
   IDFPLOT%IACC=I
  END DO
 ENDIF
 
 IMOD3D_SETTINGS_IDF=.FALSE.
 IF(MESSAGE%VALUE1.EQ.IDOK)THEN
  CALL WDIALOGGETMENU(IDF_MENU1,I)
  IDFDATA(1)=IACC(I,1); IDFDATA(2)=IACC(I,2)  !## col,row
  CALL WDIALOGGETMENU(IDF_MENU2,IDFDATA(3))
  IMOD3D_SETTINGS_IDF=.TRUE.; CALL WINDOWSELECT(IWIN3D)
 ENDIF
 
 CALL WDIALOGSELECT(ID_D3DIDFSETTINGS); CALL WDIALOGHIDE() !CALL WDIALOGUNLOAD()
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB1)
 
 END FUNCTION IMOD3D_SETTINGS_IDF

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SETTINGS_IDF_GETTIMES()
 !###======================================================================
 IMPLICIT NONE
 INTEGER,ALLOCATABLE,DIMENSION(:) :: BUISEL
 INTEGER :: N,NU,I,J,K,IDATE,IYR,IMH,IDY,IHR,IMT,ISC,NF,NP
 LOGICAL :: LEX
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IFILES
 INTEGER(KIND=8),ALLOCATABLE,DIMENSION(:) :: LDATES
 INTEGER(KIND=8),ALLOCATABLE,DIMENSION(:,:) :: FDATES

 IMOD3D_SETTINGS_IDF_GETTIMES=.FALSE.
 
 ALLOCATE(BUISEL(MXMPLOT)); BUISEL=MP%ISEL; MP%ISEL=0
 
 !## manipulate list of selected files first
 N=0; DO I=1,NIDFLIST
  SELECT CASE (IDFPLOT(I)%ICUBE)
   CASE (6,7)
    !## select IDF files selected for legend
    MP(IDFPLOT(IDFPLOT(I)%IDFLEGEND)%IPLOT)%ISEL=1; N=N+1  
   CASE (8)
    MP(IDFPLOT(I)%IPLOT)%ISEL=1; N=N+1
  END SELECT
 ENDDO
 
 !## get number of dates
 ALLOCATE(NFILES(N)); NFILES=0; LEX=IDFTIMESERIE_DATES(1); MP%ISEL=BUISEL; DEALLOCATE(BUISEL)
 IF(.NOT.LEX)THEN; DEALLOCATE(NFILES); IF(ALLOCATED(LISTFILES))DEALLOCATE(LISTFILES); RETURN; ENDIF
 
 CALL UTL_MESSAGEHANDLE(0)

 !## get all the available data
 N=SUM(NFILES); NF=SIZE(NFILES); NP=MAXVAL(NFILES)
 ALLOCATE(LDATES(N)); N=0; ALLOCATE(FDATES(NP,NF)); FDATES=0
 J=0; DO I=1,NIDFLIST
  SELECT CASE (IDFPLOT(I)%ICUBE)
   CASE (6:8)
    J=J+1
    DO K=1,NFILES(J)
     IDATE=UTL_IDFGETDATE(LISTFILES(K,J),IYR=IYR,IMH=IMH,IDY=IDY,IHR=IHR,IMT=IMT,ISC=ISC)
     IF(IDATE.NE.0)THEN
      FDATES(K,J)=YMDHMSTOITIME(IYR,IMH,IDY,IHR,IMT,ISC)
      N=N+1; LDATES(N)=FDATES(K,J)
     ENDIF
    ENDDO
  END SELECT
 ENDDO
 
 !## sort all dates; get number unique dates
 CALL UTL_GETUNIQUE_DINT(LDATES,N,NU,0); N=NU
  
 CALL UTL_MESSAGEHANDLE(1)

 !## message/question
 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to continue to process '//TRIM(ITOS(N))//' files ?','Question')
 IF(WINFODIALOG(4).NE.1)THEN; DEALLOCATE(LDATES,FDATES,NFILES,LISTFILES); RETURN; ENDIF
  
 CALL UTL_MESSAGEHANDLE(0)
 
 !## allocate memory
 DO I=1,NIDFLIST
  SELECT CASE (IDFPLOT(I)%ICUBE)
   CASE (6:8)
    ALLOCATE(IDFPLOT(I)%TFILES(N),IDFPLOT(I)%CDATES(N)); IDFPLOT(I)%TFILES=''; IDFPLOT(I)%CDATES=''
  END SELECT
 ENDDO
 
 ALLOCATE(IFILES(SIZE(NFILES))); IFILES=1
 
 !## get file that needs to be plotted for this timestep
 !## 1,fname,fname,fname
 !## 2,fname,fname,fname
 !## 3,etc.
 DO K=1,N
  J=0; DO I=1,NIDFLIST
   SELECT CASE (IDFPLOT(I)%ICUBE)
    CASE (6:8)
     J=J+1
     DO  
      !## do not update filename for plotting
      IF(FDATES(IFILES(J),J).GT.LDATES(K))EXIT
      !## take the next, next time
      IDFPLOT(I)%TFILES(IFILES(J) )=LISTFILES(IFILES(J),J)
      IFILES(J)                    =IFILES(J)+1
      EXIT
     ENDDO
   END SELECT
  ENDDO
 ENDDO

 CALL UTL_MESSAGEHANDLE(1)
 DEALLOCATE(LDATES,FDATES,NFILES,LISTFILES)
 
 IMOD3D_SETTINGS_IDF_GETTIMES=.TRUE.
 
 END FUNCTION IMOD3D_SETTINGS_IDF_GETTIMES
 
 !###======================================================================
 SUBROUTINE IMOD3D_SETTINGS_IDF_CONFIG(ICONFIG)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICONFIG
 INTEGER :: I,J,IS
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
 
 CALL WDIALOGPUTSTRING(IDF_LABEL5,IMOD3D_CONFIGTXT(ICONFIG))
 CALL WDIALOGGETMENU(IDF_MENU3,J)

 !## turn them all on (reset them)
 DO I=1,NIDFLIST; IDFPLOT(I)%ICOMBINE=I; IDFPLOT(I)%IDFLEGEND=I; IF(IDFPLOT(I)%ICUBE.NE.3)IDFPLOT(I)%ICUBE=J; ENDDO
 DO I=1,NIDFLIST; IF(IDFPLOT(I)%ICUBE.NE.3)EXIT; ENDDO; IS=I+1  

 SELECT CASE (ICONFIG)
  !## create clay and top and bottom are fishnets
  CASE (2)
   J=0; DO I=IS,NIDFLIST-1,2; J=J+1; IDFPLOT(I)%ICOMBINE=I+1; ENDDO 
   !## turn bot-clay to top-next clay off
   IDFPLOT%IPLOTLEGEND=1
   IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT%IFILL=1; IDFPLOT(IS-1)%IFILL=2; ENDIF
   DO I=IS+1,NIDFLIST,2; IDFPLOT(I)%ICUBE=5; IDFPLOT(I)%IPLOTLEGEND=0; ENDDO     
  !## create aquifers as solids top/bot bot/top
  CASE (3)
   !## combine top-bot, top-bot, top-bot
   DO I=IS-1,NIDFLIST-1,2; IDFPLOT(I)%ICOMBINE=I+1; IDFPLOT(I+1)%ICUBE=5; ENDDO
   IDFPLOT%IPLOTLEGEND=0
   IF(DEMO%IDEMO.EQ.2)THEN
    IDFPLOT%IFILL=DEMO%IFILL
   ELSE
    IDFPLOT%IFILL=1
   ENDIF
  !## combine top-bot, bot-top, bot-top
  CASE (4)
   DO I=IS-1,NIDFLIST-1; IDFPLOT(I)%ICOMBINE=I+1; ENDDO; IDFPLOT(I)%ICUBE=5
   !## turn bot-clay to top-next clay off
   IDFPLOT%IPLOTLEGEND=0 
   IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT%IFILL=1; ENDIF
  !## solid clays coloured by e.g. c-value
  CASE (5)
   IDFPLOT%IPLOTLEGEND=0
   IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT%IFILL=1; ENDIF       
   DO I=IS,NIDFLIST-1,3
    IDFPLOT(I)%ICOMBINE=MIN(NIDFLIST,I+2); IDFPLOT(I)%IDFLEGEND=MIN(NIDFLIST,I+1)
    IF(I+1.LE.SIZE(IDFPLOT))IDFPLOT(I+1)%ICUBE=5
    IF(I+2.LE.SIZE(IDFPLOT))IDFPLOT(I+2)%ICUBE=5
   ENDDO
   !## fishnet for surface
   IDFPLOT(IS-1)%IPLOTLEGEND=1
   IF(IS.LE.SIZE(IDFPLOT))IDFPLOT(IS)%IPLOTLEGEND=1
   IDFPLOT(NIDFLIST)%IPLOTLEGEND=1
   IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT(IS-1)%IFILL=2; ENDIF
  !## solid aquifers coloured by e.g. k-value
  CASE (6)
   IDFPLOT%IPLOTLEGEND=0 
   IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT%IFILL=1; ENDIF     
   DO I=IS-1,NIDFLIST-1,3
    IDFPLOT(I)%ICOMBINE=MIN(NIDFLIST,I+2); IDFPLOT(I)%IDFLEGEND=MIN(NIDFLIST,I+1)
    IF(I+1.LE.SIZE(IDFPLOT))IDFPLOT(I+1)%ICUBE=5
    IF(I+2.LE.SIZE(IDFPLOT))IDFPLOT(I+2)%ICUBE=5
   ENDDO
  !## coloured solid for aquifers/aquitards
  CASE (7)
   DO I=IS-1,NIDFLIST-2,2
    IF(DEMO%IDEMO.EQ.2)THEN; IDFPLOT%IFILL=DEMO%IFILL; ELSE; IDFPLOT%IFILL=1; ENDIF       
    IDFPLOT(I)%ICOMBINE=MIN(NIDFLIST,I+2); IDFPLOT(I)%IDFLEGEND=MIN(NIDFLIST,I+1); IDFPLOT(I+1)%ICUBE=5
   ENDDO
   IDFPLOT(NIDFLIST)%ICUBE=5
 END SELECT
      
 ALLOCATE(TMPNAME(NIDFLIST),TMPINT(NIDFLIST))
 TMPNAME=IDFPLOT%ALIAS
 TMPINT=IDFPLOT%ICUBE
 CALL WGRIDPUTMENU(IDF_GRID1,2,IDFTYPES,SIZE(IDFTYPES),TMPINT,NIDFLIST)
 TMPINT=IDFPLOT%ICOMBINE
 CALL WGRIDPUTMENU(IDF_GRID1,3,TMPNAME,NIDFLIST,TMPINT ,NIDFLIST)
 TMPINT=IDFPLOT%IDFLEGEND
 CALL WGRIDPUTMENU(IDF_GRID1,4,TMPNAME,NIDFLIST,TMPINT,NIDFLIST)
       
 END SUBROUTINE IMOD3D_SETTINGS_IDF_CONFIG

!###======================================================================
 FUNCTION IMOD3D_CONFIGTXT(ICONFIG)
!###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICONFIG
 CHARACTER(LEN=256) :: IMOD3D_CONFIGTXT

 IMOD3D_CONFIGTXT='Configuration:'

 !## configuration
 SELECT CASE (ICONFIG)
  !## interfaces
  CASE (1)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Interfaces for all entries.'
  !## quasi 3d model (aquitards)
  CASE (2)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Surface Level represented as a fishnet;'//NEWLINE// &
                 'Solid appearances for interfaces 2-3,4-5,...;'//NEWLINE// &
                 'Interface for the hydrological base.'
  !## quasi 3d model (aquifer)
  CASE (3)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Solid appearances for all adjacent interfaces 1-2,3-4,5-6,... .'
  !## 3d model
  CASE (4)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Solid appearances for all adjacent interfaces 1-2,2-3,3-4,... .'
  !## coloured quasi 3d model (aquitard)
  CASE (5)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Surface Level represented as a fishnet;'//NEWLINE// &
                 'Solid appearances for interfaces 2-4,5-7,..., coloured for given parameters in 3,6,9,...;'//NEWLINE// &
                 'Interface for the hydrological base.'
  !## coloured quasi 3d model (aquifer)
  CASE (6)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Solid appearances for all adjacent interfaces 1-3,4-6,7-9,..., coloured for given parameters in 2,5,8... .'
  !## coloured 3d model
  CASE (7)
   IMOD3D_CONFIGTXT=TRIM(IMOD3D_CONFIGTXT)//NEWLINE//'Solid appearances for all adjacent interfaces 1-3,3-5,5-8,..., coloured for given parameters in 2,4,6... .'
 END SELECT

 END FUNCTION IMOD3D_CONFIGTXT
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_REDRAWIDF(IMODE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IMODE
 INTEGER :: I,II,JJ,ILST,KLST,LLST,ICOL,IROW,IU,ITYPE,IPLOT
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,DIMENSION(3) :: ID_IDF,ND_IDF
 REAL(KIND=DP_KIND) :: F
 INTEGER(KIND=GLSIZEI) :: N
 
 IMOD3D_REDRAWIDF=.FALSE.

 !## skip this if nof IDF-files are active
 IF(NIDFLIST.LE.0)THEN; IMOD3D_REDRAWIDF=.TRUE.; RETURN; ENDIF

 !## create cookie-cutter
 IF(IMODE.EQ.0)THEN
  IF(IMOD3D_CREATECOOKIECUTTERS())THEN; ENDIF
 ENDIF
  
 !## allocate idf memory
 ALLOCATE(IDF(5)); DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 
 !## read idf
 ILST=0; DO I=1,SIZE(IDFPLOT) 

  !## skip processing of vectors the first loop
  IF(IMODE.EQ.0.AND.IDFPLOT(I)%ICUBE.EQ.4)CYCLE  
  !## skip others for the other loop
  IF(IMODE.EQ.1.AND.IDFPLOT(I)%ICUBE.NE.4)CYCLE  

  !## deselected in menu field
  IF(IDFPLOT(I)%ISEL.EQ.0)CYCLE
  !## off
  IF(IDFPLOT(I)%ICUBE.EQ.5)THEN
   ILST=IDFPLOT(I)%ILIST; IDFPLOT(ILST)%ISEL=0; CYCLE
  ENDIF  
  
  JJ=1; ID_IDF(1)=I; ID_IDF(2)=IDFPLOT(I)%ICOMBINE; ID_IDF(3)=IDFPLOT(I)%IDFLEGEND 
  IF(ID_IDF(1).NE.ID_IDF(2))JJ=2 !## combine make a solid
  IF(ID_IDF(1).NE.ID_IDF(3))JJ=3 !## use another legend
  KLST=IDFPLOT(ID_IDF(2))%ILIST; LLST=IDFPLOT(ID_IDF(3))%ILIST
  !## filled with data initially
  ND_IDF=1
  
  DO II=1,JJ
   
   IF(II.GT.1.AND.(ID_IDF(II).EQ.ID_IDF(1)))CYCLE
      
   IF(.NOT.IDFREAD(IDF(II),IDFPLOT(ID_IDF(II))%FNAME,0))EXIT

   CALL WINDOWOUTSTATUSBAR(2,'Processing '//TRIM(IDFPLOT(I)%FNAME)//'('//TRIM(RTOS(DBLE(I*100)/DBLE(SIZE(IDFPLOT)),'F',2))//'%)')
   !## first is template
   IF(II.EQ.1)THEN
    !## create mother if number of columns/rows to large
    IF(.NOT.IDFREAD(IDF(5),IDFPLOT(ID_IDF(II))%FNAME,0))EXIT
    !## template idf will become idf(1) based upon original idf(5)
    IF(IMOD3D_DRAWIDF_SIZE(IDF(5),IDF(1)))THEN
     IF(.NOT.IDFREADSCALE_GETX(IDF(5),IDF(1),IDFDATA(3),1,0.0D0))EXIT   !## child,mother,blockvalue,percentile
    ELSE
     !## copy idf(5) to idf(1) to become the original
     CALL IDFCOPY(IDF(5),IDF(1)); IDF(1)%IU=IDF(5)%IU
     !## read part of idf(1)
     IF(.NOT.IDFREADPART(IDF(1),BOT%X,BOT%Y,TOP%X,TOP%Y))EXIT
      IF(MAXVAL(IDF(1)%X).EQ.IDF(1)%NODATA.AND.&
         MINVAL(IDF(1)%X).EQ.IDF(1)%NODATA)ND_IDF(1)=0
    ENDIF
   !## second follows template of first, is obliged to make nice cubes
   ELSEIF(II.EQ.2)THEN
    CALL IDFCOPY(IDF(1),IDF(4))
    IF(.NOT.IDFREADSCALE_GETX(IDF(2),IDF(4),IDFDATA(3),1,0.0D0))EXIT   !## child,mother,arithmetic mean,percentile
    IF(MAXVAL(IDF(4)%X).EQ.IDF(4)%NODATA.AND. &
       MINVAL(IDF(4)%X).EQ.IDF(4)%NODATA)ND_IDF(2)=0
   !## third follows template of first
   ELSEIF(II.EQ.3)THEN
    CALL IDFCOPY(IDF(1),IDF(5)); IDF(5)%IXV=IDF(3)%IXV
    IF(.NOT.IDFREADSCALE_GETX(IDF(3),IDF(5),IDFDATA(3),1,0.0D0))EXIT   !## child,mother,arithmetic mean,percentile
    IF(MAXVAL(IDF(5)%X).EQ.IDF(5)%NODATA.AND. &
       MINVAL(IDF(5)%X).EQ.IDF(5)%NODATA)ND_IDF(3)=0
   ENDIF

   IF(IDF(II)%IU.NE.0)CLOSE(IDF(II)%IU)

  ENDDO

  IF(II.GT.JJ.AND.SUM(ND_IDF).EQ.3)THEN

   !## read part of idf and store in idf()x() - create smaller resolution!
   IF(IDFPLOT(I)%ILIST.NE.0)THEN
    ILST=IDFPLOT(I)%ILIST
   ELSE
    ILST=ILST+1
   ENDIF
   
   IF(IMOD3D_CREATE_SXY(IDF(1),I))THEN; ENDIF 

   !## to skip
   IF(IDFPLOT(I)%ICUBE.EQ.0)THEN
    !## not within current view-extent
    IF(IDFLISTINDEX(ILST)%INDEX(1).NE.0)THEN
     N=(IDFLISTINDEX(ILST)%ISLIST-IDFLISTINDEX(ILST)%IELIST)+1
     CALL GLDELETELISTS(IDFLISTINDEX(ILST)%INDEX(1),N)
    ENDIF
    IDFPLOT(ILST)%ILIST=0; IDFPLOT(ILST)%ISEL=0; IDFLISTINDEX(ILST)%ISLIST=0; IDFLISTINDEX(ILST)%IELIST=0

   !## planes or tplanes (applies only for legend files)
   ELSEIF(IDFPLOT(I)%ICUBE.EQ.1.OR.IDFPLOT(I)%ICUBE.EQ.6)THEN

    IF(ID_IDF(1).EQ.ID_IDF(2))THEN
     !## create 3D LAYER for current idf
     CALL IMOD3D_DRAWIDF_PLANES(ILST,LLST,IDFPLOT(I)%ICUBE)
    ELSE
     !## create 3D Solid-LAYER for current idf
     CALL IMOD3D_DRAWIDF_PLANES_DUO(ILST,LLST,IDFPLOT(LLST)%LEG,IDFPLOT(I)%ICUBE)
    ENDIF
    IDFPLOT(ILST)%ILIST=ILST; IDFPLOT(ILST)%ISEL=1

   !## cubes or tcubes (applies only for legend files)
   ELSEIF(IDFPLOT(I)%ICUBE.EQ.2.OR.IDFPLOT(I)%ICUBE.EQ.7)THEN
    
    IF(ID_IDF(1).EQ.ID_IDF(2))THEN
     !## create 3D CUBE for current idf
     CALL IMOD3D_DRAWIDF_CUBE(ILST,LLST,IDFPLOT(I)%ICUBE)
    ELSE
     CALL IMOD3D_DRAWIDF_CUBE_DUO(ILST,LLST,IDFPLOT(LLST)%LEG,IDFPLOT(I)%ICUBE)
    ENDIF
    IDFPLOT(ILST)%ILIST=ILST; IDFPLOT(ILST)%ISEL=1

   !## voxel or tvoxels
   ELSEIF(IDFPLOT(I)%ICUBE.EQ.3.OR.IDFPLOT(I)%ICUBE.EQ.8)THEN

    !## create 3D VOXEL for current idf
    CALL IMOD3D_DRAWIDF_VOXEL(ILST,IDFPLOT(I)%ICUBE)
    IDFPLOT(ILST)%ILIST=ILST; IDFPLOT(ILST)%ISEL=1

   !## vector
   ELSEIF(IDFPLOT(I)%ICUBE.EQ.4)THEN

    !## create 3D VECTOR for current idf
    CALL IMOD3D_DRAWIDF_VECTOR(ILST,KLST,LLST) 
    IDFPLOT(ILST)%ILIST=ILST; IDFPLOT(ILST)%ISEL=1

   ENDIF
   BOT%Z=MIN(BOT%Z,IDFPLOT(ILST)%ZMIN)
   TOP%Z=MAX(TOP%Z,IDFPLOT(ILST)%ZMAX)
  ELSE
   !## not within current view-extent
   ILST=ILST+1; IDFPLOT(ILST)%ILIST=0; IDFPLOT(ILST)%ISEL=0
  ENDIF
  CALL IDFDEALLOCATE(IDF,SIZE(IDF))
 ENDDO
 
 !## generate time-variant data
 IF(IMODE.EQ.0)THEN
  ILST=0; DO I=1,SIZE(IDFPLOT) 

   !## skip processing of vectors the first loop
   IF(IDFPLOT(I)%ICUBE.LE.5.OR.IDFPLOT(I)%ISEL.EQ.0)CYCLE
  
   !## use always column of legend
   IU=UTL_GETUNIT(); OPEN(IU,FILE=TRIM(PREFVAL(1))//'\TMP\TVAR_IDF_COLOUR_F'//TRIM(ITOS(I))//'.4DV',FORM='UNFORMATTED',STATUS='UNKNOWN',ACTION='WRITE')
   ALLOCATE(IDFPLOT(I)%ICLR(IDF(1)%NROW*IDF(1)%NCOL))
!   ALLOCATE(IDFPLOT(I)%ICLR(IDF(1)%NROW*IDF(1)%NCOL,3))
   ALLOCATE(IDFPLOT(I)%IACT(IDF(1)%NROW*IDF(1)%NCOL)); IDFPLOT(I)%IACT=INT(1,1)
   WRITE(IU) IDF(1)%NROW*IDF(1)%NCOL,SIZE(IDFPLOT(I)%TFILES)
   
   DO II=1,SIZE(IDFPLOT(I)%TFILES)
    
    CALL WMESSAGEPEEK(ITYPE,MESSAGE)
    
    F=DBLE(II)*100.0D0/DBLE(SIZE(IDFPLOT(I)%TFILES))
    CALL WINDOWOUTSTATUSBAR(2,'Processing '//TRIM(IDFPLOT(I)%TFILES(II))//'('//TRIM(RTOS(F,'F',2))//'%)')

    !## create mother if number of columns/rows to large
    IF(.NOT.IDFREAD(IDF(5),IDFPLOT(I)%TFILES(II),0))EXIT
    !## template idf will become idf(1) based upon original idf(5)
    IF(IMOD3D_DRAWIDF_SIZE(IDF(5),IDF(1)))THEN
     IF(.NOT.IDFREADSCALE_GETX(IDF(5),IDF(1),IDFDATA(3),1,0.0D0))EXIT   !## child,mother,blockvalue,percentile
    ELSE
     !## copy idf(5) to idf(1) to become the original
     CALL IDFCOPY(IDF(5),IDF(1)); IDF(1)%IU=IDF(5)%IU
     !## read part of idf(1)
     IF(.NOT.IDFREADPART(IDF(1),BOT%X,BOT%Y,TOP%X,TOP%Y))EXIT
    ENDIF
    
    WRITE(IU) IDF(5)%JD,IDF(5)%IYR,IDF(5)%IMH,IDF(5)%IDY,IDF(5)%IHR,IDF(5)%IMT,IDF(5)%ISC,IDFPLOT(I)%TFILES(II)
    WRITE(IDFPLOT(I)%CDATES(II),'(5(I2.2,A1),I4.4)') IDF(5)%IHR,':',IDF(5)%IMT,':',IDF(5)%ISC,' ',IDF(5)%IDY,'/',IDF(5)%IMH,'/',IDF(5)%IYR
    
    !## set correct legend idf
    IPLOT=IDFPLOT(IDFPLOT(I)%IDFLEGEND)%IPLOT
    !## save legend-colours per timestep in file
    JJ=0; DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
     JJ=JJ+1
!     IRGB=UTL_IDFGETCLASS(MP(IPLOT)%LEG,IDF(1)%X(ICOL,IROW))
     IDFPLOT(I)%ICLR(JJ)=UTL_IDFGETCLASS(MP(IPLOT)%LEG,IDF(1)%X(ICOL,IROW))
!     IF(IRGB.EQ.WRGB(255,255,255))THEN
!      IDFPLOT(I)%ICLR(JJ,1)=INT(-1,2)
!      IDFPLOT(I)%ICLR(JJ,2)=INT(-1,2)
!      IDFPLOT(I)%ICLR(JJ,3)=INT(-1,2)
!     ELSE
!      CALL WRGBSPLIT(IRGB,IR,IG,IB)
!      IDFPLOT(I)%ICLR(JJ,1)=INT(IR,2)
!      IDFPLOT(I)%ICLR(JJ,2)=INT(IG,2)
!      IDFPLOT(I)%ICLR(JJ,3)=INT(IB,2)
!     ENDIF
    ENDDO; ENDDO
   
!    JJ=0; DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
!     JJ=JJ+1; IRGB=INT(IDF(1)%X(ICOL,IROW))
!     CALL WRGBSPLIT(IRGB,IR,IG,IB)
!     IDFPLOT(I)%ICLR(JJ,1)=IR
!     IDFPLOT(I)%ICLR(JJ,2)=IG
!     IDFPLOT(I)%ICLR(JJ,3)=IB
!    ENDDO
    
    !## save colours
!    WRITE(IU) ((IDFPLOT(I)%ICLR(JJ,JJJ),JJJ=1,3),JJ=1,IDF(1)%NROW*IDF(1)%NCOL)
    WRITE(IU) (IDFPLOT(I)%ICLR(JJ),JJ=1,IDF(1)%NROW*IDF(1)%NCOL)

    CALL IDFDEALLOCATE(IDF,SIZE(IDF))

   ENDDO
   CLOSE(IU) 
   !## start with first time interval
   IDFPLOT(I)%D4ITIME=1
   !## last is stored initially
   IDFPLOT(I)%D4JTIME=SIZE(IDFPLOT(I)%TFILES)
   
  ENDDO
  
 ENDIF
 
 IF(ALLOCATED(IDF))THEN; CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF); ENDIF

 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB1)
 CALL WINDOWOUTSTATUSBAR(2,'')
 
 IMOD3D_REDRAWIDF=.TRUE.
! call UTL_LISTOPENFILES()
 
 CALL IMOD3D_ERROR('IMOD3D_REDRAWIDF')

 END FUNCTION IMOD3D_REDRAWIDF

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_PLANES(ILST,LLST,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST,ICUBE
 REAL(KIND=GLDOUBLE),DIMENSION(4) :: X,Y,Z
 INTEGER :: IROW,ICOL,I

 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_PLANES_BEGIN')

 !## generate drawinglist(s)
 CALL IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)

 IDFPLOT(ILST)%ZMIN= 10.0D10; IDFPLOT(ILST)%ZMAX=-10.0D10 

 IF(IMOD3D_BLANKOUT(IDF(1)))THEN; ENDIF
 
 !## blank nodata (color white) in case legend is used
 IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
  DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
   I=UTL_IDFGETCLASS(IDFPLOT(ILST)%LEG,IDF(1)%X(ICOL,IROW))
   IF(ICUBE.NE.6)THEN
    IF(I.EQ.WRGB(255,255,255))IDF(1)%X(ICOL,IROW)=IDF(1)%NODATA
   ENDIF
  ENDDO; ENDDO
 ENDIF

 DO IROW=1,IDF(1)%NROW-1    !## translate current position to view=position
  
  I=0
  DO ICOL=1,IDF(1)%NCOL

   !## skip nodata points
   IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND.     &
      IDF(1)%X(ICOL,IROW+1).NE.IDF(1)%NODATA)THEN
    !## get x/y-coordinate
    X(3)=IDF(1)%SX(ICOL); Y(3)=IDF(1)%SY(IROW); Z(3)=IDF(1)%X(ICOL,IROW)
    !## get x/y-coordinate
    X(4)=IDF(1)%SX(ICOL); Y(4)=IDF(1)%SY(IROW+1); Z(4)=IDF(1)%X(ICOL,IROW+1)
    I=I+1
   ELSE
    IF(I.GT.1)CALL GLEND(); I=0
   ENDIF

   !## begin strip
   IF(I.EQ.2)CALL GLBEGIN(GL_QUAD_STRIP)
   IF(I.GE.2)THEN

    IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
     !## get color for z-mean between two segments
     IF(ILST.EQ.LLST)THEN
      CALL IMOD3D_IDF_COLOUR(REAL(SUM(Z)/4.0D0,8),ILST)
     !## get color from legend other idf(5)
     ELSE
      CALL IMOD3D_IDF_COLOUR(IDF(5)%X(ICOL,IROW),LLST)
     ENDIF
    ENDIF
    
    CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
    DO I=1,4; CALL GLVERTEX3D(X(I),Y(I),Z(I)); ENDDO
    IDFPLOT(ILST)%ZMIN=MIN(IDFPLOT(ILST)%ZMIN,MINVAL(Z))
    IDFPLOT(ILST)%ZMAX=MAX(IDFPLOT(ILST)%ZMAX,MAXVAL(Z))
   ENDIF
   X(1)=X(3); Y(1)=Y(3); Z(1)=Z(3); X(2)=X(4); Y(2)=Y(4); Z(2)=Z(4)

  ENDDO
  IF(I.GT.1)CALL GLEND()
 ENDDO

 CALL GLDISABLE(GL_COLOR_MATERIAL)

 CALL GLENDLIST()
 
 END SUBROUTINE IMOD3D_DRAWIDF_PLANES

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_PLANES_DUO(ILST,LLST,LEG,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 TYPE(LEGENDOBJ),INTENT(IN) :: LEG
 INTEGER,INTENT(IN) :: ILST,LLST,ICUBE
 REAL(KIND=GLDOUBLE),DIMENSION(4) :: X,Y,Z
 INTEGER :: IROW,ICOL,I,II,N
  
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_PLANES_BEGIN')

 !## generate drawinglist(s)
 CALL IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)

 IDFPLOT(ILST)%ZMIN= 10.0D10; IDFPLOT(ILST)%ZMAX=-10.0D10 

 IF(IMOD3D_BLANKOUT(IDF(1)))THEN; ENDIF
 IF(IMOD3D_BLANKOUT(IDF(4)))THEN; ENDIF
 CALL IMOD3D_THICKNESS(ILST,LLST,LEG,ICUBE)

 IF(ICUBE.EQ.1)THEN
 
  !## top/bottom
  DO II=1,4,3

   DO IROW=1,IDF(1)%NROW-1    !## translate current position to view=position
    I=0
    DO ICOL=1,IDF(1)%NCOL

     !## skip nodata points, and thickness<=0.0D0
     IF(IDF(II)%X(ICOL,IROW)  .NE.IDF(II)%NODATA.AND.   &
        IDF(II)%X(ICOL,IROW+1).NE.IDF(II)%NODATA)THEN
      !## get x/y-coordinate
      X(3)=IDF(1)%SX(ICOL); Y(3)=IDF(1)%SY(IROW  ); Z(3)=IDF(II)%X(ICOL,IROW)
      !## get x/y-coordinate
      X(4)=IDF(1)%SX(ICOL); Y(4)=IDF(1)%SY(IROW+1); Z(4)=IDF(II)%X(ICOL,IROW+1)
      I=I+1
     ELSE
      IF(I.GT.1)CALL GLEND(); I=0
     ENDIF

     !## begin strip
     IF(I.EQ.2)CALL GLBEGIN(GL_QUAD_STRIP)
     IF(I.GE.2)THEN

      IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
       !## get color for z-mean between two segments
       IF(ILST.EQ.LLST)THEN
        CALL IMOD3D_IDF_COLOUR(REAL(SUM(Z)/4.0D0,8),ILST)
       !## get color from legend other idf(5)
       ELSE
        CALL IMOD3D_IDF_COLOUR(IDF(5)%X(ICOL,IROW),LLST)
       ENDIF
      ENDIF

      CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
      DO I=1,4; CALL GLVERTEX3D(X(I),Y(I),Z(I)); ENDDO
      IDFPLOT(ILST)%ZMIN=MIN(IDFPLOT(ILST)%ZMIN,MINVAL(Z))
      IDFPLOT(ILST)%ZMAX=MAX(IDFPLOT(ILST)%ZMAX,MAXVAL(Z))
     ENDIF
     X(1)=X(3); Y(1)=Y(3); Z(1)=Z(3); X(2)=X(4); Y(2)=Y(4); Z(2)=Z(4)

    ENDDO
    IF(I.GT.1)CALL GLEND()
   ENDDO
 
  ENDDO

  !## draw all vertical planes
  CALL IMOD3D_DRAWIDF_EDGE_PLANE(ILST,LLST)
 
 !## start time variant planes
 ELSE

  N=0; DO IROW=1,IDF(1)%NROW    !## translate current position to view=postition
   Y(1)=IDF(1)%SY(IROW); Y(2)=IDF(1)%SY(IROW-1) 
   DO ICOL=1,IDF(1)%NCOL
    N=N+1
    IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE
    !## get x/y/z-coordinate
    X(1)=IDF(1)%SX(ICOL-1);   X(2)=IDF(1)%SX(ICOL)  
    Z(1)=IDF(1)%X(ICOL,IROW); Z(2)=IDF(4)%X(ICOL,IROW)

    !## start new drawing list
    CALL GLNEWLIST(IDFLISTINDEX(ILST)%INDEX(N),GL_COMPILE)
    CALL IMOD3D_VOXEL(X,Y,Z,(/1,1,1,1/))
    CALL GLENDLIST()

    IDFPLOT(ILST)%ZMIN=MIN(IDFPLOT(ILST)%ZMIN,MINVAL(Z)); IDFPLOT(ILST)%ZMAX=MAX(IDFPLOT(ILST)%ZMAX,MAXVAL(Z))
    
   ENDDO
  ENDDO
 
 ENDIF

 IF(ICUBE.EQ.1)THEN; CALL GLDISABLE(GL_COLOR_MATERIAL); CALL GLENDLIST(); ENDIF

 END SUBROUTINE IMOD3D_DRAWIDF_PLANES_DUO

 !###======================================================================
 SUBROUTINE IMOD3D_THICKNESS(ILST,LLST,LEG,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST,ICUBE
 TYPE(LEGENDOBJ),INTENT(IN) :: LEG
 INTEGER :: IROW,ICOL,ICLR

 !## make thicknesses
 DO IROW=1,IDF(1)%NROW 
  DO ICOL=1,IDF(1)%NCOL 
   
   !## skip this for temporarily-planes
   IF(ICUBE.LE.5)THEN
    !## apply exclude value whenever value outside legend
    IF(ILST.NE.LLST)THEN
     ICLR=UTL_IDFGETCLASS(LEG,IDF(5)%X(ICOL,IROW))
     !## outside legend class
     IF(ICLR.EQ.WRGB(255,255,255))THEN 
      IDF(1)%X(ICOL,IROW)=IDF(1)%NODATA
      IDF(4)%X(ICOL,IROW)=IDF(4)%NODATA
     ENDIF
    ENDIF
   ENDIF
   
   IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA.OR.   &
      IDF(4)%X(ICOL,IROW).EQ.IDF(4)%NODATA.OR.   &
      IDF(1)%X(ICOL,IROW).LE.IDF(4)%X(ICOL,IROW))THEN
    IDF(1)%X(ICOL,IROW)=IDF(1)%NODATA
    IDF(4)%X(ICOL,IROW)=IDF(4)%NODATA
   ENDIF
  ENDDO
 ENDDO
 
 END SUBROUTINE IMOD3D_THICKNESS

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_EDGE_PLANE(ILST,LLST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST
 REAL(KIND=GLDOUBLE),DIMENSION(4) :: X,Y,Z
 REAL(KIND=DP_KIND) :: C
 INTEGER :: IROW,ICOL
 LOGICAL :: LEDGE
 
 CALL GLBEGIN(GL_QUADS)

 !## sides
 DO IROW=1,IDF(1)%NROW-1   
  DO ICOL=1,IDF(1)%NCOL-1

   !## active cell
   IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
      IDF(1)%X(ICOL,IROW+1).NE.IDF(1)%NODATA)THEN
     
    LEDGE=.FALSE.  
    !## west
    IF(ICOL.GT.1)THEN
     IF(IDF(1)%X(ICOL-1,IROW)  .EQ.IDF(1)%NODATA.OR. &
        IDF(1)%X(ICOL-1,IROW+1).EQ.IDF(1)%NODATA)THEN
      LEDGE=.TRUE.
     ENDIF       
    ENDIF
    !## east 
    IF(IDF(1)%X(ICOL+1,IROW)  .EQ.IDF(1)%NODATA.OR. &
       IDF(1)%X(ICOL+1,IROW+1).EQ.IDF(1)%NODATA)THEN
     LEDGE=.TRUE.
    ENDIF 
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(ICOL); Y(1)=IDF(1)%SY(IROW)  ; Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IROW+1); Z(2)=IDF(1)%X(ICOL,IROW+1)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW+1)
     X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
     IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL,IROW+1))/2.0
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

   ENDIF
   
   !## active cell
   IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
      IDF(1)%X(ICOL+1,IROW).NE.IDF(1)%NODATA)THEN
     
    LEDGE=.FALSE.
    
    !## north
    IF(IROW.GT.1)THEN
     IF(IDF(1)%X(ICOL,IROW-1)  .EQ.IDF(1)%NODATA.OR. &
        IDF(1)%X(ICOL+1,IROW-1).EQ.IDF(1)%NODATA)THEN
      LEDGE=.TRUE.
     ENDIF       
    ENDIF
    
    !## south
    IF(IDF(1)%X(ICOL,IROW+1)  .EQ.IDF(1)%NODATA.OR. &
       IDF(1)%X(ICOL+1,IROW+1).EQ.IDF(1)%NODATA)THEN
     LEDGE=.TRUE.
    ENDIF
    
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(ICOL);   Y(1)=IDF(1)%SY(IROW); Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=IDF(1)%SX(ICOL+1); Y(2)=IDF(1)%SY(IROW); Z(2)=IDF(1)%X(ICOL+1,IROW)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL+1,IROW)
     X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
     IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL+1,IROW))/2.0
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

   ENDIF

  ENDDO
 ENDDO
 
 !## outer bounds
 ICOL=1; DO IROW=1,IDF(1)%NROW-1   
  !## active cell
  IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
     IDF(1)%X(ICOL,IROW+1).NE.IDF(1)%NODATA)THEN
   X(1)=IDF(1)%SX(ICOL); Y(1)=IDF(1)%SY(IROW)  ; Z(1)=IDF(1)%X(ICOL,IROW)
   X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IROW+1); Z(2)=IDF(1)%X(ICOL,IROW+1)
   X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW+1)
   X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
   IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL,IROW+1))/2.0
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
   CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
  ENDIF
 ENDDO
 
 ICOL=IDF(1)%NCOL; DO IROW=1,IDF(1)%NROW-1  
  !## active cell
  IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
     IDF(1)%X(ICOL,IROW+1).NE.IDF(1)%NODATA)THEN
   X(1)=IDF(1)%SX(ICOL); Y(1)=IDF(1)%SY(IROW)  ; Z(1)=IDF(1)%X(ICOL,IROW)
   X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IROW+1); Z(2)=IDF(1)%X(ICOL,IROW+1)
   X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW+1)
   X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
   IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL,IROW+1))/2.0
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
   CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
  ENDIF
 ENDDO

 IROW=1; DO ICOL=1,IDF(1)%NCOL-1 !2
  !## active cell
  IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
     IDF(1)%X(ICOL+1,IROW).NE.IDF(1)%NODATA)THEN
   X(1)=IDF(1)%SX(ICOL);   Y(1)=IDF(1)%SY(IROW); Z(1)=IDF(1)%X(ICOL,IROW)
   X(2)=IDF(1)%SX(ICOL+1); Y(2)=IDF(1)%SY(IROW); Z(2)=IDF(1)%X(ICOL+1,IROW)
   X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL+1,IROW)
   X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
   IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL+1,IROW))/2.0
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
   CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
  ENDIF
 ENDDO

 IROW=IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL-1 !2   
  !## active cell
  IF(IDF(1)%X(ICOL,IROW)  .NE.IDF(1)%NODATA.AND. &
     IDF(1)%X(ICOL+1,IROW).NE.IDF(1)%NODATA)THEN
   X(1)=IDF(1)%SX(ICOL);   Y(1)=IDF(1)%SY(IROW); Z(1)=IDF(1)%X(ICOL,IROW)
   X(2)=IDF(1)%SX(ICOL+1); Y(2)=IDF(1)%SY(IROW); Z(2)=IDF(1)%X(ICOL+1,IROW)
   X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL+1,IROW)
   X(4)=X(1); Y(4)=Y(1); Z(4)=IDF(4)%X(ICOL,IROW)
   IF(ILST.NE.LLST)C=(IDF(5)%X(ICOL,IROW)+IDF(5)%X(ICOL+1,IROW))/2.0
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
   CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
  ENDIF
 ENDDO

 CALL GLEND()
 
 END SUBROUTINE IMOD3D_DRAWIDF_EDGE_PLANE
 
 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_EDGE_CUBE(ILST,LLST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST
 REAL(KIND=GLDOUBLE),DIMENSION(4) :: X,Y,Z
 REAL(KIND=DP_KIND) :: C
 INTEGER :: IROW,ICOL,IC1,IC2,IR1,IR2
 LOGICAL :: LEDGE
 
 CALL GLBEGIN(GL_QUADS)

 !## sides
 DO IROW=1,IDF(1)%NROW   
  DO ICOL=1,IDF(1)%NCOL

   !## active cell
   IF(IDF(1)%X(ICOL,IROW).NE.IDF(1)%NODATA)THEN
     
    IC1=ICOL-1; IC2=ICOL+1; IR1=IROW-1; IR2=IROW+1

    !## west
    LEDGE=.FALSE.
    IF(ICOL.GT.1)THEN
     IF(IDF(1)%X(IC1,IROW).EQ.IDF(1)%NODATA)LEDGE=.TRUE.
    ELSE
     LEDGE=.TRUE.
    ENDIF
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(IC1); Y(1)=IDF(1)%SY(IR1); Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=X(1); Y(2)=IDF(1)%SY(IROW); Z(2)=Z(1)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW)
     X(4)=X(1); Y(4)=Y(1); Z(4)=Z(3)
     IF(ILST.NE.LLST)C=IDF(5)%X(ICOL,IROW)
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

    !## east 
    LEDGE=.FALSE.
    IF(ICOL.LT.IDF(1)%NCOL)THEN
     IF(IDF(1)%X(IC2,IROW).EQ.IDF(1)%NODATA)LEDGE=.TRUE.
    ELSE
     LEDGE=.TRUE.
    ENDIF
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(ICOL); Y(1)=IDF(1)%SY(IR1); Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=X(1); Y(2)=IDF(1)%SY(IROW); Z(2)=Z(1)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW)
     X(4)=X(1); Y(4)=Y(1); Z(4)=Z(3)
     IF(ILST.NE.LLST)C=IDF(5)%X(ICOL,IROW)
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

    !## north
    LEDGE=.FALSE.
    IF(IROW.GT.1)THEN
     IF(IDF(1)%X(ICOL,IR1).EQ.IDF(1)%NODATA)LEDGE=.TRUE.
    ELSE
     LEDGE=.TRUE.
    ENDIF
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(IC1); Y(1)=IDF(1)%SY(IR1); Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=IDF(1)%SX(ICOL); Y(2)=Y(1); Z(2)=Z(1)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW)
     X(4)=X(1); Y(4)=Y(1); Z(4)=Z(3)
     IF(ILST.NE.LLST)C=IDF(5)%X(ICOL,IROW)
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

    !## south
    LEDGE=.FALSE.
    IF(IROW.LT.IDF(1)%NROW)THEN
     IF(IDF(1)%X(ICOL,IR2).EQ.IDF(1)%NODATA)LEDGE=.TRUE.
    ELSE
     LEDGE=.TRUE.
    ENDIF
    IF(LEDGE)THEN
     X(1)=IDF(1)%SX(IC1) ; Y(1)=IDF(1)%SY(IROW); Z(1)=IDF(1)%X(ICOL,IROW)
     X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IROW); Z(2)=Z(1)
     X(3)=X(2); Y(3)=Y(2); Z(3)=IDF(4)%X(ICOL,IROW)
     X(4)=X(1); Y(4)=Y(1); Z(4)=Z(3)
     IF(ILST.NE.LLST)C=IDF(5)%X(ICOL,IROW)
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
    ENDIF

   ENDIF

  ENDDO
 ENDDO
 
 CALL GLEND()
 
 END SUBROUTINE IMOD3D_DRAWIDF_EDGE_CUBE

 !###======================================================================
 SUBROUTINE IMOD3D_IDF_COLOUR(V,ILST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST
 REAL(KIND=DP_KIND),INTENT(IN) :: V
 INTEGER :: ICLR

 CALL IMOD3D_ERROR('IMOD3D_IDF_COLOUR BEGIN')

 ICLR=UTL_IDFGETCLASS(IDFPLOT(ILST)%LEG,V)
 CALL IMOD3D_SETCOLOR(ICLR)
 
 CALL IMOD3D_ERROR('IMOD3D_IDF_COLOUR END')
 
 END SUBROUTINE IMOD3D_IDF_COLOUR

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_CUBE(ILST,LLST,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST,ICUBE
 REAL(KIND=GLDOUBLE),DIMENSION(2) :: X,Y
 REAL(KIND=GLDOUBLE),DIMENSION(0:4) :: Z
 INTEGER :: IROW,ICOL,I,IC1,IC2,IR1,IR2
 INTEGER,DIMENSION(4) :: IB
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_CUBE BEGIN')

 IF(IMOD3D_BLANKOUT(IDF(1)))THEN; ENDIF
 
 !## blank nodata (color white) in case legend is used
 IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
  DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
   I=UTL_IDFGETCLASS(IDFPLOT(ILST)%LEG,IDF(1)%X(ICOL,IROW))
   IF(ICUBE.NE.7)THEN
    IF(I.EQ.WRGB(255,255,255))IDF(1)%X(ICOL,IROW)=IDF(1)%NODATA
   ENDIF
  ENDDO; ENDDO
 ENDIF

 !## generate drawinglist(s)
 CALL IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)

 IDFPLOT(ILST)%ZMIN= 10.0D10; IDFPLOT(ILST)%ZMAX=-10.0D10

 CALL GLCOLORMATERIAL(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE)
 CALL GLENABLE(GL_COLOR_MATERIAL)

 DO IROW=1,IDF(1)%NROW    !## translate current position to view=postition
  DO ICOL=1,IDF(1)%NCOL

   IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE

   IC1=ICOL-1; IC2=ICOL+1; IR1=IROW-1; IR2=IROW+1

   !## value of raster cell
   Z(0)= IDF(1)%X(ICOL,IROW)
   IB=0 !## draw none of the side
   IF(ICOL.GT.1)THEN
    IF(IDF(1)%X(IC1,IROW).NE.IDF(1)%NODATA.AND.IDF(1)%X(IC1,IROW).LT.Z(0))THEN
     IB(1)=1; Z(1) =IDF(1)%X(IC1,IROW)
    ENDIF
   ENDIF
   IF(IROW.GT.1)THEN
    IF(IDF(1)%X(ICOL,IR1).NE.IDF(1)%NODATA.AND.IDF(1)%X(ICOL,IR1).LT.Z(0))THEN
     IB(2)=1; Z(2) =IDF(1)%X(ICOL,IR1)
    ENDIF
   ENDIF
   IF(ICOL.LT.IDF(1)%NCOL)THEN
    IF(IDF(1)%X(IC2,IROW).NE.IDF(1)%NODATA.AND.IDF(1)%X(IC2,IROW).LT.Z(0))THEN
     IB(3)=1; Z(3) =IDF(1)%X(IC2,IROW)
    ENDIF
   ENDIF
   IF(IROW.LT.IDF(1)%NROW)THEN
    IF(IDF(1)%X(ICOL,IR2).NE.IDF(1)%NODATA.AND.IDF(1)%X(ICOL,IR2).LT.Z(0))THEN
     IB(4)=1; Z(4) =IDF(1)%X(ICOL,IR2)
    ENDIF
   ENDIF

   !## get x/y/z-coordinate
   X(1)=IDF(1)%SX(IC1);  Y(1)=IDF(1)%SY(IROW) 
   !## get x/y/z-coordinate
   X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IR1)

   IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
    IF(ILST.EQ.LLST)THEN
     !## get color for z-mean between two segments
     CALL IMOD3D_IDF_COLOUR(REAL(Z(0),8),ILST)
    ELSE
     CALL IMOD3D_IDF_COLOUR(IDF(5)%X(ICOL,IROW),LLST)
    ENDIF
   ENDIF
   
   CALL IMOD3D_CUBE(X,Y,Z,IB)

   IDFPLOT(ILST)%ZMIN=MIN(IDFPLOT(ILST)%ZMIN,REAL(Z(0),8))
   IDFPLOT(ILST)%ZMAX=MAX(IDFPLOT(ILST)%ZMAX,REAL(Z(0),8))

  ENDDO
 ENDDO

 CALL GLDISABLE(GL_COLOR_MATERIAL)

 CALL GLENDLIST()

 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_CUBE END')

 END SUBROUTINE IMOD3D_DRAWIDF_CUBE

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_CUBE_DUO(ILST,LLST,LEG,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,LLST,ICUBE
 TYPE(LEGENDOBJ),INTENT(IN) :: LEG
 REAL(KIND=GLDOUBLE),DIMENSION(2) :: X,Y
 REAL(KIND=GLDOUBLE),DIMENSION(0:4) :: Z
 INTEGER :: IROW,ICOL,II,IC1,IC2,IR1,IR2
 INTEGER,DIMENSION(4) :: IB
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_CUBE BEGIN')

 IF(IMOD3D_BLANKOUT(IDF(1)))THEN; ENDIF
 IF(IMOD3D_BLANKOUT(IDF(4)))THEN; ENDIF
 CALL IMOD3D_THICKNESS(ILST,LLST,LEG,ICUBE)

 !## generate drawinglist(s)
 CALL IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)

 IDFPLOT(ILST)%ZMIN= 10.0D10; IDFPLOT(ILST)%ZMAX=-10.0D10

 !## top/bottom
 DO II=1,4,3

  DO IROW=1,IDF(1)%NROW    !## translate current position to view=postition
   DO ICOL=1,IDF(1)%NCOL

    IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE

    IC1=ICOL-1; IC2=ICOL+1; IR1=IROW-1; IR2=IROW+1
    
    !## value of raster cell
    Z(0)= IDF(II)%X(ICOL,IROW)
    IB=0 !## draw none of the side
    IF(ICOL.GT.1)THEN
     IF(IDF(II)%X(IC1,IROW).NE.IDF(1)%NODATA.AND.IDF(II)%X(IC1,IROW).LT.Z(0))THEN
      IB(1)=1; Z(1) =IDF(II)%X(IC1,IROW)
     ENDIF
    ENDIF
    IF(IROW.GT.1)THEN
     IF(IDF(II)%X(ICOL,IR1).NE.IDF(1)%NODATA.AND.IDF(II)%X(ICOL,IR1).LT.Z(0))THEN
      IB(2)=1; Z(2) =IDF(II)%X(ICOL,IR1)
     ENDIF
    ENDIF
    IF(ICOL.LT.IDF(1)%NCOL)THEN
     IF(IDF(II)%X(IC2,IROW).NE.IDF(1)%NODATA.AND.IDF(II)%X(IC2,IROW).LT.Z(0))THEN
      IB(3)=1; Z(3) =IDF(II)%X(IC2,IROW)
     ENDIF
    ENDIF
    IF(IROW.LT.IDF(1)%NROW)THEN
     IF(IDF(II)%X(ICOL,IR2).NE.IDF(1)%NODATA.AND.IDF(II)%X(ICOL,IR2).LT.Z(0))THEN
      IB(4)=1; Z(4) =IDF(II)%X(ICOL,IR2)
     ENDIF
    ENDIF

    !## get x/y/z-coordinate
    X(1)=IDF(1)%SX(IC1);  Y(1)=IDF(1)%SY(IROW) 
    !## get x/y/z-coordinate
    X(2)=IDF(1)%SX(ICOL); Y(2)=IDF(1)%SY(IR1)

    IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
     IF(ILST.EQ.LLST)THEN
      !## get color for z-mean between two segments
      CALL IMOD3D_IDF_COLOUR(REAL(Z(0),8),ILST)
     ELSE
      CALL IMOD3D_IDF_COLOUR(IDF(5)%X(ICOL,IROW),LLST)
     ENDIF
    ENDIF

    CALL IMOD3D_CUBE(X,Y,Z,IB)

    IDFPLOT(ILST)%ZMIN=MIN(IDFPLOT(ILST)%ZMIN,REAL(Z(0),8))
    IDFPLOT(ILST)%ZMAX=MAX(IDFPLOT(ILST)%ZMAX,REAL(Z(0),8))

   ENDDO
  ENDDO
 ENDDO

 CALL IMOD3D_DRAWIDF_EDGE_CUBE(ILST,LLST)

 CALL GLDISABLE(GL_COLOR_MATERIAL)

 CALL GLENDLIST()

 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_CUBE END')

 END SUBROUTINE IMOD3D_DRAWIDF_CUBE_DUO

 !###======================================================================
 SUBROUTINE IMOD3D_CUBE(X,Y,Z,IB)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),DIMENSION(4) :: IB
 REAL(KIND=GLDOUBLE),DIMENSION(2),INTENT(IN) :: X,Y
 REAL(KIND=GLDOUBLE),DIMENSION(0:4),INTENT(IN) :: Z

 !## top
 CALL GLBEGIN(GL_QUADS)
  CALL IMOD3D_SETNORMALVECTOR(X(1),Y(2),Z(0),X(2),Y(2),Z(0),X(2),Y(1),Z(0))
  CALL GLVERTEX3D(X(1),Y(2),Z(0))
  CALL GLVERTEX3D(X(2),Y(2),Z(0))
  CALL GLVERTEX3D(X(2),Y(1),Z(0))
  CALL GLVERTEX3D(X(1),Y(1),Z(0))  
 CALL GLEND()

 IF(SUM(IB).EQ.0)RETURN

 CALL GLBEGIN(GL_QUADS)

 IF(IB(1).EQ.1)THEN
  !## west-rib
  CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(1),Y(1),Z(0),X(1),Y(2),Z(0))  !## left
  CALL GLVERTEX3D(X(1),Y(1),Z(1))
  CALL GLVERTEX3D(X(1),Y(1),Z(0))
  CALL GLVERTEX3D(X(1),Y(2),Z(0))
  CALL GLVERTEX3D(X(1),Y(2),Z(1))
 ENDIF
  
 IF(IB(2).EQ.1)THEN
  !## north-rib
  CALL IMOD3D_SETNORMALVECTOR(X(1),Y(2),Z(2),X(1),Y(2),Z(0),X(2),Y(2),Z(0))  !## back
  CALL GLVERTEX3D(X(1),Y(2),Z(2))
  CALL GLVERTEX3D(X(1),Y(2),Z(0))
  CALL GLVERTEX3D(X(2),Y(2),Z(0))
  CALL GLVERTEX3D(X(2),Y(2),Z(2))
 ENDIF
  
 IF(IB(3).EQ.1)THEN
  !## eastrib
  CALL IMOD3D_SETNORMALVECTOR(X(2),Y(2),Z(3),X(2),Y(2),Z(0),X(2),Y(1),Z(0))  !## back
  CALL GLVERTEX3D(X(2),Y(2),Z(3))
  CALL GLVERTEX3D(X(2),Y(2),Z(0))
  CALL GLVERTEX3D(X(2),Y(1),Z(0))
  CALL GLVERTEX3D(X(2),Y(1),Z(3))
 ENDIF
  
 IF(IB(4).EQ.1)THEN
  !## frontrib
  CALL IMOD3D_SETNORMALVECTOR(X(2),Y(1),Z(4),X(2),Y(1),Z(0),X(1),Y(1),Z(4))  !## right
  CALL GLVERTEX3D(X(2),Y(1),Z(4))
  CALL GLVERTEX3D(X(2),Y(1),Z(0))
  CALL GLVERTEX3D(X(1),Y(1),Z(0))
  CALL GLVERTEX3D(X(1),Y(1),Z(4)) 
 ENDIF

 CALL GLEND()
 
 END SUBROUTINE IMOD3D_CUBE

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,ICUBE
 INTEGER :: I,N
 
 !## destroy current display list index
 IF(ASSOCIATED(IDFLISTINDEX(ILST)%INDEX))THEN
  DO I=1,SIZE(IDFLISTINDEX(ILST)%INDEX)
   IF(IDFLISTINDEX(ILST)%INDEX(I).NE.0)CALL GLDELETELISTS(IDFLISTINDEX(ILST)%INDEX(I),1_GLSIZEI)
  ENDDO
  DEALLOCATE(IDFLISTINDEX(ILST)%INDEX)
 ENDIF

 !## list index for entire grid (normal voxel)
 SELECT CASE (ICUBE)
  CASE (1,2,3)
   !## allocate drawing list
   ALLOCATE(IDFLISTINDEX(ILST)%INDEX(1))
   IDFLISTINDEX(ILST)%ISLIST=GLGENLISTS(1); IDFLISTINDEX(ILST)%IELIST=IDFLISTINDEX(ILST)%ISLIST; IDFLISTINDEX(ILST)%INDEX(1)=IDFLISTINDEX(ILST)%ISLIST
   !## start new drawing list
   CALL GLNEWLIST(IDFLISTINDEX(ILST)%INDEX(1),GL_COMPILE)
   CALL GLCOLORMATERIAL(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE)
   CALL GLENABLE(GL_COLOR_MATERIAL)
  CASE (6,7,8)
   N=IDF(1)%NROW*IDF(1)%NCOL; ALLOCATE(IDFLISTINDEX(ILST)%INDEX(N))
   !## generate displaylists
   IDFLISTINDEX(ILST)%ISLIST=GLGENLISTS(N); IDFLISTINDEX(ILST)%IELIST=IDFLISTINDEX(ILST)%ISLIST-1
   DO I=1,N; IDFLISTINDEX(ILST)%IELIST=IDFLISTINDEX(ILST)%IELIST+1; IDFLISTINDEX(ILST)%INDEX(I)=IDFLISTINDEX(ILST)%IELIST; ENDDO
 END SELECT
 
 END SUBROUTINE IMOD3D_DRAWIDF_GETDRAWINGLISTS
 
 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_VOXEL(ILST,ICUBE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,ICUBE
 REAL(KIND=GLDOUBLE),DIMENSION(2) :: X,Y,Z
 INTEGER :: IROW,ICOL,ICLR,N
 INTEGER,DIMENSION(4) :: IB
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_VOXEL BEGIN')

 IF(IMOD3D_BLANKOUT(IDF(1)))THEN; ENDIF
 
 !## blank nodata (color white) in case legend is used
 IF(IDFPLOT(ILST)%ILEG.EQ.2.AND.ICUBE.EQ.3)THEN
  DO IROW=1,IDF(1)%NROW; DO ICOL=1,IDF(1)%NCOL
   ICLR=UTL_IDFGETCLASS(IDFPLOT(ILST)%LEG,IDF(1)%X(ICOL,IROW))
   IF(ICLR.EQ.WRGB(255,255,255))IDF(1)%X(ICOL,IROW)=IDF(1)%NODATA
  ENDDO; ENDDO
 ENDIF

 !## generate drawinglist(s)
 CALL IMOD3D_DRAWIDF_GETDRAWINGLISTS(ILST,ICUBE)
 
 !## not voxel, asume one
 IF(IDF(1)%ITB.EQ.0)THEN
  Z(1)=-1.0D0*REAL(ILST-1); Z(2)=Z(1)-1.0D0
 !## true voxel
 ELSE
  Z(1)=IDF(1)%TOP; Z(2)=IDF(1)%BOT
 ENDIF

 IB=1; N=0; DO IROW=1,IDF(1)%NROW    !## translate current position to view=postition

  Y(1)=IDF(1)%SY(IROW); Y(2)=IDF(1)%SY(IROW-1) 

  DO ICOL=1,IDF(1)%NCOL

   !## skip nodata cells
   IF(ICUBE.EQ.3)THEN
    IF(IDF(1)%X(ICOL,IROW).EQ.IDF(1)%NODATA)CYCLE
   ENDIF

   !## get x/y/z-coordinate
   X(1)=IDF(1)%SX(ICOL-1); X(2)=IDF(1)%SX(ICOL)  

   !## regular voxel
   IF(ICUBE.EQ.3)THEN
   
    IB=0 !## draw none
    IB(1)=0; IF(ICOL.EQ.1)          IB(1)=1
    IB(3)=0; IF(ICOL.EQ.IDF(1)%NCOL)IB(3)=1
    IB(2)=0; IF(IROW.EQ.1)          IB(2)=1
    IB(4)=0; IF(IROW.EQ.IDF(1)%NROW)IB(4)=1

    IF(ICOL.GT.1)THEN;           IF(IDF(1)%X(ICOL-1,IROW).EQ.IDF(1)%NODATA)IB(1)=1; ENDIF
    IF(IROW.GT.1)THEN;           IF(IDF(1)%X(ICOL,IROW-1).EQ.IDF(1)%NODATA)IB(2)=1; ENDIF
    IF(ICOL.LT.IDF(1)%NCOL)THEN; IF(IDF(1)%X(ICOL+1,IROW).EQ.IDF(1)%NODATA)IB(3)=1; ENDIF
    IF(IROW.LT.IDF(1)%NROW)THEN; IF(IDF(1)%X(ICOL,IROW+1).EQ.IDF(1)%NODATA)IB(4)=1; ENDIF

    !## get color for z-mean between two segments
    IF(IDFPLOT(ILST)%ILEG.EQ.2)CALL IMOD3D_IDF_COLOUR(IDF(1)%X(ICOL,IROW),ILST)

   !## time variant voxel
   ELSE

    !## start new drawing list
    N=N+1; CALL GLNEWLIST(IDFLISTINDEX(ILST)%INDEX(N),GL_COMPILE)

   ENDIF

   CALL IMOD3D_VOXEL(X,Y,Z,IB)
   
   IF(ICUBE.NE.3)CALL GLENDLIST()
   
  ENDDO
 ENDDO

 IDFPLOT(ILST)%ZMIN=Z(2); IDFPLOT(ILST)%ZMAX=Z(1) 
 
 IF(ICUBE.EQ.3)THEN; CALL GLDISABLE(GL_COLOR_MATERIAL); CALL GLENDLIST(); ENDIF
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_VOXEL END')

 END SUBROUTINE IMOD3D_DRAWIDF_VOXEL

 !###======================================================================
 SUBROUTINE IMOD3D_VOXEL(X,Y,Z,IB)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),DIMENSION(4) :: IB
 REAL(KIND=GLDOUBLE),DIMENSION(2),INTENT(IN) :: X,Y,Z

 !## top
 CALL GLBEGIN(GL_QUADS)
  CALL IMOD3D_SETNORMALVECTOR(X(1),Y(2),Z(1),X(2),Y(2),Z(1),X(2),Y(1),Z(1))
  CALL GLVERTEX3D(X(1),Y(2),Z(1))
  CALL GLVERTEX3D(X(2),Y(2),Z(1))
  CALL GLVERTEX3D(X(2),Y(1),Z(1))
  CALL GLVERTEX3D(X(1),Y(1),Z(1))  
 CALL GLEND()

 IF(Z(1).EQ.Z(2))RETURN

 IF(SUM(IB).NE.0)THEN

  CALL GLBEGIN(GL_QUADS)

  IF(IB(1).EQ.1)THEN
   !## west-rib
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(2),X(1),Y(1),Z(1),X(1),Y(2),Z(1))  !## left
   CALL GLVERTEX3D(X(1),Y(1),Z(2))
   CALL GLVERTEX3D(X(1),Y(1),Z(1))
   CALL GLVERTEX3D(X(1),Y(2),Z(1))
   CALL GLVERTEX3D(X(1),Y(2),Z(2))
  ENDIF
  
  IF(IB(2).EQ.1)THEN
   !## north-rib
   CALL IMOD3D_SETNORMALVECTOR(X(1),Y(2),Z(2),X(1),Y(2),Z(1),X(2),Y(2),Z(1))  !## back
   CALL GLVERTEX3D(X(1),Y(2),Z(2))
   CALL GLVERTEX3D(X(1),Y(2),Z(1))
   CALL GLVERTEX3D(X(2),Y(2),Z(1))
   CALL GLVERTEX3D(X(2),Y(2),Z(2))
  ENDIF
  
  IF(IB(3).EQ.1)THEN
   !## eastrib
   CALL IMOD3D_SETNORMALVECTOR(X(2),Y(2),Z(2),X(2),Y(2),Z(1),X(2),Y(1),Z(1))  !## back
   CALL GLVERTEX3D(X(2),Y(2),Z(2))
   CALL GLVERTEX3D(X(2),Y(2),Z(1))
   CALL GLVERTEX3D(X(2),Y(1),Z(1))
   CALL GLVERTEX3D(X(2),Y(1),Z(2))
  ENDIF
  
  IF(IB(4).EQ.1)THEN
   !## frontrib
   CALL IMOD3D_SETNORMALVECTOR(X(2),Y(1),Z(1),X(2),Y(1),Z(1),X(1),Y(1),Z(2))  !## right
   CALL GLVERTEX3D(X(2),Y(1),Z(2))
   CALL GLVERTEX3D(X(2),Y(1),Z(1))
   CALL GLVERTEX3D(X(1),Y(1),Z(1))
   CALL GLVERTEX3D(X(1),Y(1),Z(2)) 
  ENDIF
 
  CALL GLEND()
 
 ENDIF
 
 !## bottom
 CALL GLBEGIN(GL_QUADS)
  CALL IMOD3D_SETNORMALVECTOR(X(1),Y(2),Z(2),X(2),Y(2),Z(2),X(2),Y(1),Z(2))
  CALL GLVERTEX3D(X(1),Y(2),Z(2))
  CALL GLVERTEX3D(X(2),Y(2),Z(2))
  CALL GLVERTEX3D(X(2),Y(1),Z(2))
  CALL GLVERTEX3D(X(1),Y(1),Z(2))  
 CALL GLEND()

 END SUBROUTINE IMOD3D_VOXEL

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIDF_VECTOR(ILST,KLST,LLST)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILST,KLST,LLST
 REAL(KIND=GLDOUBLE) :: X,Y,Z,RADIUS
 REAL(KIND=DP_KIND) :: F,FF,VL,MINZ,MAXZ,DZDX,DZDY,DZDZ
 INTEGER :: IROW,ICOL,IIDF
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_VECTOR BEGIN')

 !## destroy current display list index
 IF(IDFLISTINDEX(ILST)%INDEX(1).NE.0)CALL GLDELETELISTS(IDFLISTINDEX(ILST)%INDEX(1),1_GLSIZEI)
 !## list index for
 IDFLISTINDEX(ILST)%INDEX(1)=GLGENLISTS(1)
 !## start new drawing list
 CALL GLNEWLIST(IDFLISTINDEX(ILST)%INDEX(1),GL_COMPILE)

 FF=(TOP%X-BOT%X)/100.0_GLDOUBLE
 RADIUS=REAL(0.05_GLDOUBLE,8)*FF !## width of arrow
 
 IIDF=1; IF(ILST.NE.LLST)IIDF=5
  
 MINZ=10.0D10; MAXZ=-10.0D10
 
 CALL GLCOLORMATERIAL(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE)
 CALL GLENABLE(GL_COLOR_MATERIAL)
 
 DO IROW=1,IDF(1)%NROW    !## translate current position to view=postition
  Y=(IDF(1)%SY(IROW)+IDF(1)%SY(IROW-1))/2.0
  DO ICOL=1,IDF(1)%NCOL

   !## normal IDF
   DZDZ=0.0D0
!   IF(IDF(1)%IVF.EQ.0)
   CALL SOF_COMPUTE_GRAD(IDF(1),ICOL,IROW,DZDX,DZDY)
!   !## 3IDF
!   IF(IDF(1)%IVF.EQ.1)CALL SOF_COMPUTE_GRAD_3D(IDF(1),ICOL,IROW,DZDX,DZDY,DZDZ)

   F=DZDX**2.0D0+DZDY**2.0D0; IF(F.NE.0.0D0)F=SQRT(F)

   IF(F.NE.IDF(1)%NODATA)THEN
    !## get color for velocity
    IF(IDFPLOT(ILST)%ILEG.EQ.2)CALL IMOD3D_IDF_COLOUR(VL,LLST)

    !## get x/y/z-coordinate
    X=(IDF(1)%SX(ICOL-1)+IDF(1)%SX(ICOL))/2.0

!    IF(IDF(1)%IVF.EQ.0)THEN
    IF(ILST.NE.LLST)THEN
     Z=IDF(1)%X(ICOL,IROW)
     IF(ILST.NE.KLST)Z=(Z+IDF(4)%X(ICOL,IROW))/2.0_GLDOUBLE
    ELSE
     IF(TOP%Z.LT.BOT%Z)THEN
      Z=0.0_GLDOUBLE
     ELSE
      Z=(TOP%Z+BOT%Z)/2.0_GLDOUBLE
     ENDIF
    ENDIF
!    ELSEIF(IDF(1)%IVF.EQ.1)THEN
!     Z=(IDF(1)%XV(ICOL,IROW,1)+IDF(1)%XV(ICOL,IROW,2))/2.0
!    ENDIF

    MINZ=MIN(MINZ,Z); MAXZ=MAX(MAXZ,Z)  

    CALL IMOD3D_VECTOR(X,Y,Z,-DZDX,DZDY,-DZDZ,6,RADIUS,F,.TRUE.)

   ENDIF  
  ENDDO
 ENDDO

 IDFPLOT(ILST)%ZMIN=MINZ
 IDFPLOT(ILST)%ZMAX=MAXZ

 CALL GLDISABLE(GL_COLOR_MATERIAL)
 CALL GLENDLIST()

 CALL IMOD3D_ERROR('IMOD3D_DRAWIDF_VECTOR END')

 END SUBROUTINE IMOD3D_DRAWIDF_VECTOR

 !###======================================================================
 SUBROUTINE IMOD3D_TUBE(NPNT,NINT,IMODE,ISHADE,IB,ZTOLERANCE)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: ZTOLERANCE
 INTEGER,INTENT(IN) :: NINT,IMODE,ISHADE,IB,NPNT
 REAL(KIND=GLDOUBLE) :: AD,AX,AY,DX,DY,DZ
 REAL(KIND=GLDOUBLE),DIMENSION(:,:),ALLOCATABLE :: XPOS,YPOS,ZPOS
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: ZDIST,XDIST
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: GCODE
 INTEGER :: I,J,N,NP,ICLR,IFAN,ISTRP,ISKIP
 TYPE KPOBJ
  REAL(KIND=GLDOUBLE) :: X,Y,Z,W,AX,AY
  INTEGER :: C
 END TYPE KPOBJ
 TYPE(KPOBJ),ALLOCATABLE,DIMENSION(:) :: KP
  
 !## stepsize angle radials
 AD=2.0D0*PI_OPENGL/REAL(NINT) 

 !## allocate memory for storage of points on previous- and next cicle
 ALLOCATE(XPOS(0:NINT,2),YPOS(0:NINT,2),ZPOS(0:NINT,2))

 CALL GLPUSHMATRIX()

 !## to ensure appropriate scaling of vector
 CALL GLSCALED(1.0_GLDOUBLE/XSCALE_FACTOR,1.0_GLDOUBLE/YSCALE_FACTOR,1.0_GLDOUBLE/ZSCALE_FACTOR)
 
 IF(ZTOLERANCE.GT.0.0D0)THEN
 
  !## compute line-simplication in three directions
  ALLOCATE(ZDIST(NPNT),XDIST(NPNT),GCODE(NPNT,4)); GCODE=0.0D0
  DO J=1,NPNT; XDIST(J)=REAL(J); ENDDO
  DO I=1,3
   IF(I.EQ.1)THEN; DO J=1,NPNT; ZDIST(J)=XBH(J); ENDDO; ENDIF
   IF(I.EQ.2)THEN; DO J=1,NPNT; ZDIST(J)=YBH(J); ENDDO; ENDIF
   IF(I.EQ.3)THEN; DO J=1,NPNT; ZDIST(J)=ZBH(J); ENDDO; ENDIF
   !## process line
   CALL PEUCKER_SIMPLIFYLINE(XDIST,ZDIST,GCODE(:,I),NPNT)
  ENDDO
 
  !## see what point is in and what point is out
  GCODE(1   ,4)=1.0D0
  GCODE(NPNT,4)=1.0D0
  DO I=2,NPNT-1 

   N=0
   IF(GCODE(I,1).GT.ZTOLERANCE)N=N+1
   IF(GCODE(I,2).GT.ZTOLERANCE)N=N+1
   IF(GCODE(I,3).GT.ZTOLERANCE)N=N+1
   !## if other class, always keep point
   IF(CBH(I).NE.CBH(I-1))N=N+2
   !## point need to be kept
   IF(N.GE.2)GCODE(I,4)=1.0D0
  ENDDO
  NP=1; DO I=2,NPNT
   IF(GCODE(I,4).EQ.1.0D0)THEN
    NP     =NP+1
    XBH(NP)=XBH(I)
    YBH(NP)=YBH(I)
    ZBH(NP)=ZBH(I)
    RBH(NP)=RBH(I)
    CBH(NP)=CBH(I)
   ENDIF
  ENDDO 
 
 ELSE
 
  NP=NPNT
  
 ENDIF
 
 !## allocate all points
 ALLOCATE(KP(2*NP))

 !## correct points (except first and last) and add knickpoints
 N=0; DO I=1,NP 

  IF(I.LT.NP)THEN
  
   !## get angles from tube
   DX=XBH(I+1)-XBH(I)
   DY=YBH(I+1)-YBH(I)
   DZ=ZBH(I+1)-ZBH(I)
   
   AX=-ATAN2(DZ,DX)
   !## depending on sign
   AY= ATAN2(DY,SQRT(DX**2.0D0+DZ**2.0D0))  
   !## correct for direction
   IF(DX.LT.0.0D0)AY=-1.0D0*AY

  ENDIF
 
  !## add previous point, always as dimensions changes
  IF(I.GT.1)THEN
   N=N+1
   KP(N)%X =XBH(I)
   KP(N)%Y =YBH(I)
   KP(N)%Z =ZBH(I)
   KP(N)%W =KP(N-1)%W
   KP(N)%AX=KP(N-1)%AX
   KP(N)%AY=KP(N-1)%AY
   KP(N)%C =KP(N-1)%C
  ENDIF
  
  !## add next point
  IF(I.LT.NP)THEN
   N=N+1
   KP(N)%X =XBH(I)
   KP(N)%Y =YBH(I)
   KP(N)%Z =ZBH(I)
   KP(N)%W =RBH(I)
   KP(N)%AX=AX
   KP(N)%AY=AY
   KP(N)%C =CBH(I)
  ENDIF
       
 ENDDO
  
 !## plot tube
 ISKIP=0
 DO I=1,N
  
  !## set flag to draw fan
  IFAN=0;  IF(I.EQ.1.OR.I.EQ.N)IFAN =1
  ISTRP=0; IF(I.GT.1)          ISTRP=1
  
  !## what colour
  ICLR=KP(I)%C
  IF(ICLR.GE.0)THEN
   !## tubed skipped for drawing, start with fan
   IF(ISKIP.EQ.1)THEN; IFAN=1; ISTRP=0; ENDIF; ISKIP=0
   IF(IMODE.EQ.1)THEN
    IF(I.GT.1)THEN
     IF(KP(I-1)%W.GT.KP(I)%W)ICLR=KP(I-1)%C
    ENDIF
    CALL IMOD3D_SETCOLOR(ICLR) 
    !## show shaded surface
    IF(ISHADE.EQ.1)THEN     
     CALL IMOD3D_RETURNCOLOR(ICLR,AMBIENT) 
     CALL GLMATERIALFV(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE,AMBIENT) 
    ENDIF
   ELSEIF(IMODE.EQ.2)THEN
    CALL IMOD3D_SETCOLOR(IB)
   ENDIF
  ELSE
   !## draw final fan
   IF(ISKIP.EQ.0)ISTRP=1
  ENDIF
   
  !## skip this part
  IF(ISKIP.EQ.1)CYCLE
  
  !## get coordinates - on circle and projected for ax,ay,ad
  CALL IMOD3D_TUBE_COORDINATES(NINT,XPOS(0,1),YPOS(0,1),ZPOS(0,1), &
            KP(I)%AX,KP(I)%AY,AD,KP(I)%X,KP(I)%Y,KP(I)%Z,KP(I)%W)

  !## draw fan of tube on first/last segment
  IF(IFAN.EQ.1)THEN 

   !## draw triangle fan
   CALL GLBEGIN(GL_TRIANGLE_FAN) 
    CALL IMOD3D_SETNORMALVECTOR(XPOS(0,1),YPOS(0,1),ZPOS(0,1), &
                                XPOS(1,1),YPOS(1,1),ZPOS(1,1), &
                                KP(I)%X  ,KP(I)%Y  ,KP(I)%Z )
    CALL GLVERTEX3D(KP(I)%X,KP(I)%Y,KP(I)%Z)
    DO J=NINT,0,-1; CALL GLVERTEX3D(XPOS(J,1),YPOS(J,1),ZPOS(J,1)); ENDDO
   CALL GLEND()

  ENDIF

  IF(ISTRP.EQ.1)THEN 

   !## side of tube
   CALL GLBEGIN(GL_QUAD_STRIP)
   DO J=0,NINT 
    IF(J.NE.NINT)THEN
     CALL IMOD3D_SETNORMALVECTOR(XPOS(J,1)  ,YPOS(J,1)  ,ZPOS(J,1)  , &
                                 XPOS(J,2)  ,YPOS(J,2)  ,ZPOS(J,2)  , &
                                 XPOS(J+1,2),YPOS(J+1,2),ZPOS(J+1,2))
    ENDIF
    CALL GLVERTEX3D(XPOS(J,1),YPOS(J,1),ZPOS(J,1))
    CALL GLVERTEX3D(XPOS(J,2),YPOS(J,2),ZPOS(J,2))
   ENDDO
   CALL GLEND()
  
  ENDIF
  
  DO J=0,NINT
   XPOS(J,2)=XPOS(J,1)
   YPOS(J,2)=YPOS(J,1)
   ZPOS(J,2)=ZPOS(J,1)
  ENDDO

  IF(ICLR.LT.0)ISKIP=1

 ENDDO 

 CALL GLPOPMATRIX() 
 
 !## deallocate memory
 IF(ZTOLERANCE.GT.0.0D0)DEALLOCATE(ZDIST,XDIST,GCODE)
 DEALLOCATE(KP,XPOS,YPOS,ZPOS)
 
 END SUBROUTINE IMOD3D_TUBE
 
 !###======================================================================
 SUBROUTINE IMOD3D_TUBE_COORDINATES(NINT,XPOS,YPOS,ZPOS,AX,AY,AD,XBH,YBH,ZBH,RBH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: NINT
 REAL(KIND=GLDOUBLE),INTENT(IN) :: AX,AY,AD
 REAL(KIND=GLDOUBLE),INTENT(OUT),DIMENSION(0:NINT) :: XPOS,YPOS,ZPOS
 REAL(KIND=GLDOUBLE) :: AR
 REAL(KIND=DP_KIND),INTENT(IN) :: XBH,YBH,ZBH,RBH
 INTEGER :: J
   
 !## top or bottom - compute coordinates
 AR=0.0_GLDOUBLE
 DO J=0,NINT
  XPOS(J)=RBH
  YPOS(J)=0.0_GLDOUBLE 
  ZPOS(J)=0.0_GLDOUBLE
  !## rotate appropriately in 3D
  CALL UTL_ROTATE_XYZ(XPOS(J),YPOS(J),ZPOS(J),           AX,          AY,AR )
  CALL UTL_ROTATE_XYZ(XPOS(J),YPOS(J),ZPOS(J),          0.0D0,REAL(0.5D0*PI_OPENGL,8),0.0D0)
  CALL UTL_ROTATE_XYZ(XPOS(J),YPOS(J),ZPOS(J),-REAL(0.5D0*PI_OPENGL,8),         0.0D0,0.0D0)
  !## transform
  XPOS(J)=XPOS(J)+XBH 
  YPOS(J)=YPOS(J)+YBH 
  ZPOS(J)=ZPOS(J)+ZBH 
  AR=AR+AD
 ENDDO

 END SUBROUTINE IMOD3D_TUBE_COORDINATES

 !###======================================================================
 SUBROUTINE IMOD3D_VECTOR(X,Y,Z,DX,DY,DZ,NINT,RADIUS,VL,LARROW)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE),INTENT(IN) :: X,Y,Z,DX,DY,DZ,RADIUS
 LOGICAL,INTENT(IN) :: LARROW
 INTEGER,INTENT(IN) :: NINT 
 REAL(KIND=DP_KIND),INTENT(IN) :: VL
 REAL(KIND=GLDOUBLE) :: DGRAD,FGRAD,X1,Y1,Z1,Z2,XPOS,YPOS,ZF,XGRAD,DXY,R
 INTEGER :: J
 
 DGRAD=2.0*PI_OPENGL/REAL(NINT) !## stepsize angle radials
 
 CALL GLPUSHMATRIX()

 !## to ensure appropriate scaling of vector
 CALL GLSCALED(1.0_GLDOUBLE/XSCALE_FACTOR,1.0_GLDOUBLE/YSCALE_FACTOR,1.0_GLDOUBLE/ZSCALE_FACTOR)

 !## translate
 CALL GLTRANSLATED(X,Y,Z)

 !## rotate 
 CALL GLROTATED(-90.0D0,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE) !## put them flat in xy plane
 CALL GLROTATED( 90.0D0,0.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE) !## rotate them to east
 
 XGRAD=ATAN2(DY,DX)*(360.0D0/(2.0*PI_OPENGL))
 CALL GLROTATED(-XGRAD,0.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE)!## turn vector in xy plane

 DXY=SQRT(DX**2.0D0+DY**2.0D0)
 XGRAD=ATAN2(DZ,DXY)*(360.0D0/(2.0*PI_OPENGL))

 CALL GLROTATED(XGRAD,1.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE) !## z-axes

 !## local coordinates before rotating and transfering
 X1=0.0_GLDOUBLE; Y1=0.0_GLDOUBLE; Z1=0.0_GLDOUBLE

 !## top of tube
 Z2=Z1+VL
 !## start of arrow
 IF(LARROW)THEN
  ZF=Z1+0.75_GLDOUBLE*VL     !## start of arrow-cap 
 ELSE
  ZF=Z1+VL
 ENDIF
 
 !## bottom triangle fan
 FGRAD=0.0_GLDOUBLE
 CALL GLBEGIN(GL_TRIANGLE_FAN)
 CALL GLNORMAL3D(0.0_GLDOUBLE,0.0_GLDOUBLE,-1.0_GLDOUBLE)
 CALL GLVERTEX3D(X1,Y1,Z1)
 DO J=NINT,0,-1
  XPOS=X1+COS(FGRAD)*RADIUS; YPOS=Y1+SIN(FGRAD)*RADIUS 
  CALL GLVERTEX3D(XPOS,YPOS,Z1); FGRAD=FGRAD+DGRAD
 ENDDO
 CALL GLEND()

 !## side of tube
 CALL GLBEGIN(GL_QUAD_STRIP)
 FGRAD=0.0_GLDOUBLE
 DO J=0,NINT 
  XPOS=X1+COS(FGRAD)*RADIUS; YPOS=Y1+SIN(FGRAD)*RADIUS
  CALL GLNORMAL3D(COS(FGRAD),SIN(FGRAD),0.0_GLDOUBLE)
  CALL GLVERTEX3D(XPOS,YPOS,Z1); CALL GLVERTEX3D(XPOS,YPOS,ZF)
  FGRAD=FGRAD+DGRAD
 ENDDO
 CALL GLEND() 
  
 !## increase radius in case of arrows
 R=RADIUS; IF(LARROW)R=RADIUS*2.0_GLDOUBLE

 !## top triangle fan
 FGRAD=0.0_GLDOUBLE
 CALL GLBEGIN(GL_TRIANGLE_FAN)
 CALL GLNORMAL3D(0.0_GLDOUBLE,0.0_GLDOUBLE,-1.0_GLDOUBLE)
 CALL GLVERTEX3D(X1,Y1,Z1+ZF)
 DO J=NINT,0,-1
  XPOS=X1+COS(FGRAD)*R; YPOS=Y1+SIN(FGRAD)*R
  CALL GLVERTEX3D(XPOS,YPOS,ZF); FGRAD=FGRAD+DGRAD
 ENDDO
 CALL GLEND()

 !## add arrow cap
 IF(LARROW)THEN
  FGRAD=0.0_GLDOUBLE
  CALL GLBEGIN(GL_TRIANGLE_FAN)
  CALL GLVERTEX3D(X1,Y1,Z2)
  DO J=0,NINT 
   XPOS=X1+COS(FGRAD)*RADIUS
   YPOS=Y1+SIN(FGRAD)*RADIUS 
   CALL GLNORMAL3D(-COS(FGRAD),-SIN(FGRAD),0.0_GLDOUBLE)
   CALL GLVERTEX3D(XPOS,YPOS,ZF)
   FGRAD=FGRAD+DGRAD
  ENDDO
  CALL GLEND()
 ENDIF

 CALL GLPOPMATRIX()

 END SUBROUTINE IMOD3D_VECTOR

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IPF_INIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IIPF,IPLOT
  
 IMOD3D_IPF_INIT=.FALSE.
 
 !## allocate memory for ipf-plotting, they will be read in memory and drawn from that
 CALL IPFINIT()

 IF(ALLOCATED(IPFPLOT))DEALLOCATE(IPFPLOT); ALLOCATE(IPFPLOT(NIPF))

 !## read ipf
 IIPF=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.2)THEN
   IIPF=IIPF+1
   IPFPLOT(IIPF)%IPLOT=IPLOT
   IPFPLOT(IIPF)%FNAME='('//TRIM(ITOS(IIPF))//') '//MP(IPLOT)%ALIAS
   IPFPLOT(IIPF)%IFILL  =1  !## coloured 
   IPFPLOT(IIPF)%ISEL   =1
   IPFPLOT(IIPF)%ICLIP  =1
   !## initially use the fancy mode - this will be changed if more than 250 boreholes are considered
   IPFPLOT(IIPF)%IFANCY =1
   IPFPLOT(IIPF)%ISHADE =1
   IPFPLOT(IIPF)%RADIUS =1.0D0  !scale
   IPFPLOT(IIPF)%SIMPLIFY=1.0D0 !simplification (meter)
   IPFPLOT(IIPF)%ISUB   =12
   IPFPLOT(IIPF)%ISTYLE =4
   IPFPLOT(IIPF)%ASSCOL1=MP(IPLOT)%ASSCOL1
   IPFPLOT(IIPF)%ASSCOL2=MP(IPLOT)%ASSCOL2
   IPFPLOT(IIPF)%IPLOTACOL=0
   IPFPLOT(IIPF)%ISELECT=0
   IPFPLOT(IIPF)%RSELECT=0
   IPFPLOT(IIPF)%IEXCLUDE=1
   IPFPLOT(IIPF)%IPLOTLABELS=0
   IPFPLOT(IIPF)%IPLOTLEGEND=0 !## plot legend
   IPFPLOT(IIPF)%ILEGDLF=MP(IPLOT)%ILEGDLF
   IPFPLOT(IIPF)%NQUERY=0
   IPFPLOT(IIPF)%IEXCLUDE=0                   !## 0=exclude all 1=exclude part
   IPFPLOT(IIPF)%EXCLCOLOUR=WRGB(255,255,255) !## excludecolour
   IPFPLOT(IIPF)%IEXCLCOLOUR=0                !## usage of excludecolour
  ENDIF
 ENDDO
 
 IF(.NOT.IMOD3D_IPF(0,1))RETURN
 
 IMOD3D_IPF_INIT=.TRUE.
 
 END FUNCTION IMOD3D_IPF_INIT
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IPF(IGL,IOVERRULE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IGL !## igl=0 do not include drawing lists for OpenGL
 INTEGER,INTENT(IN) :: IOVERRULE
 INTEGER :: IIPF,I,J,IPLOT,IU,IRAT,IRAT1,N
 REAL(KIND=GLDOUBLE) :: X,Y,Z,Z2,MXW
 CHARACTER(LEN=256) :: FNAME,DIR
 LOGICAL :: LEX
 INTEGER :: ICLR,ACOL,IPLUS
 REAL(KIND=DP_KIND) :: XVAL,S

 IMOD3D_IPF=.FALSE.

 !## width scaling
 S  =SQRT((TOP%Y-BOT%Y)**2.0D0+(TOP%X-BOT%X)**2.0D0)/500.0D0
 MXW=MAXVAL(BH%LITHOWIDTH)

 !## allocate memory for ipf-plotting, they will be read in memory and drawn from that
 CALL IPFINIT()

 !## nothing to do - no drills or ipf's files found
 IF(NIPF.LE.0)THEN; IMOD3D_IPF=.TRUE.; RETURN; ENDIF

 !## read ipf
 IIPF=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.2)THEN
   IIPF=IIPF+1

   CALL WINDOWSELECT(IWIN3D)

   !## read always from disc
   CALL WINDOWOUTSTATUSBAR(2,'RF Disc ...'//TRIM(MP(IPLOT)%IDFNAME))
   IF(.NOT.IPFREAD(IPLOT,IIPF))THEN
    CALL IPFDEALLOCATE()
    CALL WINDOWOUTSTATUSBAR(2,'')
    RETURN
   ENDIF

  ENDIF
 ENDDO

 !## get number of points inside current view-frame
 !## number of drawing lists
 NIPFLIST=0
 !## number of picking lists
 NASSLIST=0
 
 DO IIPF=1,NIPF

  CALL WINDOWOUTSTATUSBAR(2,'Get selection for '//TRIM(IPF(IIPF)%FNAME)//' ...')

  !## initialise ipos
  IPF(IIPF)%IPOS=INT(0,1)

  ACOL=IPF(IIPF)%ACOL; IF(ACOL.LT.0.OR.ACOL.GT.IPF(IIPF)%NCOL)ACOL=0
  
  IF(IOVERRULE.EQ.1)THEN
   IF(ACOL.EQ.0)IPFPLOT(IIPF)%RADIUS=5.0D0
   IF(ACOL.NE.0)IPFPLOT(IIPF)%RADIUS=2.0D0
  ENDIF
  
  !## create separate drawinglists for boreholes not for non-connected points
  IPLUS=0; IF(ACOL.NE.0)IPLUS=1
  !## create new drawinglist position
  IF(IPLUS.EQ.0)NIPFLIST=NIPFLIST+1
    
  N=0
  DO I=1,IPF(IIPF)%NROW
   X=IPF(IIPF)%XYZ(1,I); Y=IPF(IIPF)%XYZ(2,I)
   IF(X.GE.BOT%X   .AND.X.LE.TOP%X   .AND.Y.GE.BOT%Y   .AND.Y.LE.TOP%Y)THEN

    IF(IMOD3D_BLANKOUT_XY(X,Y))THEN  
     IPF(IIPF)%IPOS(I)=INT(1,1)
     IF(IPLUS.NE.0)THEN
      NIPFLIST=NIPFLIST+IPLUS 
      NASSLIST=NASSLIST+IPLUS 
     ENDIF
     N=N+1
     
    ENDIF
    
   ENDIF
  ENDDO

  !## change to non-fancy mode in case many boreholes are considered in active window
  IF(N.GT.MXROWFORFANCY.AND.IOVERRULE.EQ.1)IPFPLOT(IIPF)%IFANCY=0
 
 ENDDO

 !## get display-list pointers
 IF(ALLOCATED(IPFLISTINDEX))THEN
  CALL WINDOWOUTSTATUSBAR(2,'Releasing Memory ...')
  DO I=1,SIZE(IPFLISTINDEX,1); DO J=1,SIZE(IPFLISTINDEX,2)
   IF(IPFLISTINDEX(I,J).NE.0)CALL GLDELETELISTS(IPFLISTINDEX(I,J),1_GLSIZEI)
  ENDDO; ENDDO
  DEALLOCATE(IPFLISTINDEX)
 ENDIF
 !## allocate memory for drawinglists
 ALLOCATE(IPFLISTINDEX(NIPFLIST,3)); IPFLISTINDEX=0

 !## storage of ipf specific information used for selection purposes
 IF(ALLOCATED(IPFDLIST))DEALLOCATE(IPFDLIST); ALLOCATE(IPFDLIST(3,NIPFLIST)); IPFDLIST=0
 
 !## plot associated files
 CALL IPFINITASSFILE()

 !## store each drill in memory for picking purposes
 IF(NASSLIST.GT.0)CALL IPFASSFILEALLOCATE(NASSLIST)

 NIPFLIST=0; NASSLIST=0; IRAT=0; IRAT1=IRAT
 DO IIPF=1,NIPF

  !## reset acol since it can be altered
  ACOL=IPF(IIPF)%ACOL; IF(ACOL.LT.0.OR.ACOL.GT.IPF(IIPF)%NCOL)ACOL=0

  !## allocated number of idfs available
  N=IMOD3D_IPF_QUERY_NUMBEROFIDFS(IPFPLOT(IIPF)%NQUERY)
  !## read idfs
  IF(.NOT.IMOD3D_IPF_QUERY_EVALUATE_READIDF(IIPF))RETURN
  
  !## overrule acol from the dialog
  IF(IPFPLOT(IIPF)%IPLOTACOL.EQ.1)ACOL=0
   
  !## create separate drawinglists for boreholes not for non-connected points
  IPLUS=0; IF(ACOL.NE.0)IPLUS=1
  !## create new drawinglist position
  IF(IPLUS.EQ.0)NIPFLIST=NIPFLIST+1
  
  !## all point in a single drawing list
  IF(ACOL.EQ.0.AND.IGL.EQ.1)THEN

   !## create sphere-object
   IF(IPFPLOT(IIPF)%IFANCY.EQ.1)CALL IMOD3D_IPF_CREATEBALL(IPFPLOT(IIPF)%ISUB,IPFPLOT(IIPF)%ISTYLE,S*IPFPLOT(IIPF)%RADIUS)

   IPFLISTINDEX(NIPFLIST,1)=GLGENLISTS(1)
   !## start new drawing list for current object
   CALL GLNEWLIST(IPFLISTINDEX(NIPFLIST,1),GL_COMPILE)

  ENDIF

  CALL WINDOWOUTSTATUSBAR(2,'Reading '//TRIM(ITOS(IPF(IIPF)%NROW))//' points from '//TRIM(IPF(IIPF)%FNAME))

  IPLOT=IPFPLOT(IIPF)%IPLOT

  I  =INDEX(IPF(IIPF)%FNAME,'\',.TRUE.)
  DIR=IPF(IIPF)%FNAME(1:I-1)
  DO I=1,IPF(IIPF)%NROW

!   !## cancel operation
!   CALL WMESSAGEPEEK(ITYPE,MESSAGE)
!   IF(ITYPE.EQ.KEYDOWN.AND.MESSAGE%VALUE1.EQ.KEYESCAPE)EXIT
   
   IF(IPF(IIPF)%IPOS(I).EQ.INT(1,1))THEN
    X =IPF(IIPF)%XYZ(1,I); Y=IPF(IIPF)%XYZ(2,I); Z=IPF(IIPF)%XYZ(3,I); Z2=IPF(IIPF)%XYZ(4,I)

    !## add another drawing list for this entry
    IF(IPLUS.NE.0)NIPFLIST=NIPFLIST+IPLUS    

    LEX=.FALSE.  
    
    IF(ACOL.NE.0)THEN
    
     FNAME=TRIM(DIR)//'\'//TRIM(IPF(IIPF)%INFO(IPF(IIPF)%ACOL,I))//'.'//TRIM(ADJUSTL(IPF(IIPF)%FEXT))
     NASSLIST=NASSLIST+1
     !## read dimensions of associated file
     IF(IPFOPENASSFILE(IU,NASSLIST,FNAME))THEN
      !## drill found (1D and 3D)
      IF(ASSF(NASSLIST)%ITOPIC.EQ.2.OR.ASSF(NASSLIST)%ITOPIC.EQ.4)THEN
       IF(IPFREADASSFILELABEL(IU,NASSLIST,FNAME).AND.  &
          IPFREADASSFILE(IU,NASSLIST,FNAME))THEN
        IF(ASSF(NASSLIST)%NRASS.GT.0)THEN
         !## write message on window
         CALL UTL_WAITMESSAGE(IRAT,IRAT1,I,IPF(IIPF)%NROW,'Get boreholes for '//TRIM(IPF(IIPF)%FNAME),IBOX=2)

         ASSF(NASSLIST)%IROW=I
         ASSF(NASSLIST)%ASSCOL1=IPFPLOT(IIPF)%ASSCOL1 !## column used with dlf
         ASSF(NASSLIST)%ASSCOL2=IPFPLOT(IIPF)%ASSCOL2 !## on default not used --- border rings
         ASSF(NASSLIST)%ILEGDLF=IPFPLOT(IIPF)%ILEGDLF !## legend for colouring
         !## only use to determine dimensions
         IF(IGL.EQ.0)THEN
          CALL IMOD3D_DRAWIPF(X,Y,Z,Z2,ASSF(NASSLIST)%ITOPIC,(/2/)  ,ICLR,IIPF,IGL,S,MXW) !## get min/max
         ELSE
          CALL IMOD3D_DRAWIPF(X,Y,Z,Z2,ASSF(NASSLIST)%ITOPIC,(/1,2/),ICLR,IIPF,IGL,S,MXW) !## plot fore- and background
         ENDIF
         !## put label at bottom
         IF(ASSF(NASSLIST)%ITOPIC.EQ.4)THEN
          IPF(IIPF)%XYZ(1,I)=IPF(IIPF)%XYZ(1,I)+ASSF(NASSLIST)%DX(ASSF(NASSLIST)%NRASS)
          IPF(IIPF)%XYZ(2,I)=IPF(IIPF)%XYZ(2,I)+ASSF(NASSLIST)%DY(ASSF(NASSLIST)%NRASS)
         ENDIF
         IPF(IIPF)%XYZ(3,I)=ASSF(NASSLIST)%Z(ASSF(NASSLIST)%NRASS) !## forces label on bottom
         LEX=.TRUE.
        ENDIF
       ELSE
        CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONYES,'There might be an error in the following file:'// &
             CHAR(13)//TRIM(FNAME)//CHAR(13)// &
             'Do you want to continue (yes) or quit reading the file (no)','Error')
        IF(WINFODIALOG(4).NE.1)THEN; CLOSE(IU); EXIT; ENDIF
       ENDIF
      ENDIF
      CLOSE(IU)
     ENDIF
     IF(.NOT.LEX)THEN; NASSLIST=MAX(0,NASSLIST-1); NIPFLIST=MAX(0,NIPFLIST-1); ENDIF

     IF(NIPFLIST.GT.0)THEN
      !## store information for selection purposes
      IPFDLIST(1,NIPFLIST)=IIPF  !## number of ipf
      IPFDLIST(2,NIPFLIST)=I     !## number of row in ipf
      IPFDLIST(3,NIPFLIST)=1
     ENDIF

    !## no associated additional files
    ELSE

!     !## write message on window
!     CALL UTL_WAITMESSAGE(IRAT,IRAT1,I,IPF(IIPF)%NROW,'Get points for '//TRIM(IPF(IIPF)%FNAME),IBOX=2)

     IF(IGL.EQ.1)THEN

      !## current ipf single-coloured?
      IF(MP(IPLOT)%ILEG.EQ.0)THEN
       ICLR=MP(IPLOT)%SCOLOR
      ELSEIF(MP(IPLOT)%ILEG.EQ.1)THEN
       J=INFOERROR(1)
       CALL ISTRINGTODOUBLE(IPF(IIPF)%INFO(MP(IPLOT)%IATTRIB,I),XVAL)
       ICLR=WRGB(200,200,200)
       IF(INFOERROR(1).EQ.0)THEN; ICLR=UTL_IDFGETCLASS(MP(IPLOT)%LEG,XVAL); ENDIF
      ENDIF

     ENDIF

     !## draw position only - no drill found
     CALL IMOD3D_DRAWIPF(X,Y,Z,Z2,0,(/1/),ICLR,IIPF,IGL,S,MXW)  !## actual drills

    ENDIF
    
   ENDIF
  ENDDO

  IF(ACOL.EQ.0.AND.NIPFLIST.GT.0)THEN
   !## store information for selection purposes
   IPFDLIST(1,NIPFLIST)=IIPF  !## number of ipf
   IPFDLIST(2,NIPFLIST)=0     !## number of row in ipf
   IPFDLIST(3,NIPFLIST)=1
  ENDIF
  
  !## all point in a single drawing list
  IF(ACOL.EQ.0.AND.IGL.EQ.1)CALL GLENDLIST()

 ENDDO

 IF(ASSOCIATED(XBH))DEALLOCATE(XBH,YBH,ZBH,RBH,CBH)
 IF(ASSOCIATED(LBH))DEALLOCATE(LBH)
 CALL IMOD3D_IPF_QUERY_DEALLOCATE()
 
! !## nothing found to be plotted
! IF(NIPFLIST.EQ.0)NIPF=0

 CALL WINDOWOUTSTATUSBAR(1,''); CALL WINDOWOUTSTATUSBAR(2,'')

 IMOD3D_IPF=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_IPF')

 END FUNCTION IMOD3D_IPF
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IPF_EXPORTIPF(IIPF)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIPF
 INTEGER :: I,J,II,JJ,IROW,N,IU,KU
 CHARACTER(LEN=256) :: FNAME,DIR,IPFNAME
 
 IMOD3D_IPF_EXPORTIPF=.FALSE.
 
 IF(.NOT.UTL_WSELECTFILE('iMOD Point Map (*.ipf)|*.ipf;|',&
          SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Point Map (*.ipf)'))RETURN

 DIR=FNAME(:INDEX(FNAME,'\',.TRUE.)-1)

 IU=UTL_GETUNIT(); OPEN(IU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
 IPFNAME=FNAME
   
 !## associated file drawn
 DO JJ=1,2
  N=0
  DO II=1,NIPFLIST

   !## skip those not equal to the current selected ipf file
   IF(IPFDLIST(1,II).NE.IIPF)CYCLE
   !## skip this well
   IF(IPFDLIST(3,II).EQ.0)CYCLE
   !## skip this one - no associated file attached to it
   IROW=IPFDLIST(2,II); IF(IROW.LE.0)CYCLE   
  
   N=N+1
   IF(JJ.EQ.2)WRITE(IU,'(99A)') (TRIM(IPF(IIPF)%INFO(I,IROW))//',',I=1,IPF(IIPF)%NCOL-1),TRIM(IPF(IIPF)%INFO(IPF(IIPF)%NCOL,IROW))

   IF(ALLOCATED(ASSF))THEN
    IF(ASSOCIATED(ASSF(II)%Z))THEN
     FNAME=TRIM(DIR)//'\'//TRIM(IPF(IIPF)%INFO(IPF(IIPF)%ACOL,IROW))//'.'//TRIM(IPF(IIPF)%FEXT)
     CALL UTL_CREATEDIR(FNAME(:INDEX(FNAME,'\',.TRUE.)-1))
     KU=UTL_GETUNIT(); OPEN(KU,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
     WRITE(KU,*) ASSF(II)%NRASS
     WRITE(KU,*) ASSF(II)%NCASS,ASSF(II)%ITOPIC
     DO I=1,ASSF(II)%NCASS
      WRITE(KU,'(A)') TRIM(ASSF(II)%ATTRIB(I))//','//TRIM(RTOS(ASSF(II)%NODATA(I),'F',3))
     ENDDO
     SELECT CASE (ASSF(II)%ITOPIC)
      CASE (1)
      !## 2D boreholes
      CASE (2)
       DO I=1,ASSF(II)%NRASS
        WRITE(KU,'(2A)') TRIM(RTOS(ASSF(II)%Z(I),'F',3)),(','//TRIM(ASSF(II)%L(J,I)),J=1,ASSF(II)%NCASS-1)
       ENDDO
      CASE (3)
      !## 3D boreholes
      CASE (4)
       DO I=1,ASSF(II)%NRASS
        WRITE(KU,'(2A)') TRIM(RTOS(ASSF(II)%DX(I),'F',3))//','//TRIM(RTOS(ASSF(II)%DY(I),'F',3))//','// &
           TRIM(RTOS(ASSF(II)%Z(I),'F',3)),(','//TRIM(ASSF(II)%L(J,I)),J=1,ASSF(II)%NCASS-3)
       ENDDO
     END SELECT
     CLOSE(KU)
    ENDIF
   ENDIF
  ENDDO
  
  IF(JJ.EQ.1)THEN
   WRITE(IU,*) N
   WRITE(IU,*) IPF(IIPF)%NCOL
   DO I=1,IPF(IIPF)%NCOL; WRITE(IU,'(A)') TRIM(IPF(IIPF)%ATTRIB(I)); ENDDO
   WRITE(IU,'(A)') TRIM(ITOS(IPF(IIPF)%ACOL))//','//TRIM(IPF(IIPF)%FEXT)
  ENDIF
     
 ENDDO
 CLOSE(IU)
 
 CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Successfully saved:'//CHAR(13)//TRIM(IPFNAME),'Information')
 
 IMOD3D_IPF_EXPORTIPF=.TRUE.

 END FUNCTION IMOD3D_IPF_EXPORTIPF
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IPF_SELECTION(IIPF)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIPF
 INTEGER :: I,J,II,IROW,N,IPLOTTYPE
 REAL(KIND=DP_KIND) :: Z,DZ,X,Y
 
 IMOD3D_IPF_SELECTION=.FALSE.
 
 IF(IPFPLOT(IIPF)%NQUERY.GT.0)THEN
  N=IMOD3D_IPF_QUERY_NUMBEROFIDFS(IPFPLOT(IIPF)%NQUERY)
  IF(.NOT.IMOD3D_IPF_QUERY_EVALUATE_READIDF(IIPF))RETURN
 ENDIF
 
 !## read in polygon
 IF(IPFPLOT(IIPF)%ISELECT(4).EQ.1)THEN
  CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,IPFPLOT(IIPF)%GENFNAME,'GEN')
  !## polygon not read
  IF(SHP%NPOL.LE.0)RETURN
 ENDIF
  
 !## associated file drawn
 DO II=1,NIPFLIST

  !## skip those not equal to the current selected ipf file
  IF(IPFDLIST(1,II).NE.IIPF)CYCLE

  !## current row in IPF
  IROW=IPFDLIST(2,II)
  !## skip this one - no associated file attached to it
  IF(IROW.LE.0)CYCLE
  
  X=IPF(IIPF)%XYZ(1,IROW)
  Y=IPF(IIPF)%XYZ(2,IROW)

  !## well found okay initially
  IPFDLIST(3,II)=1

  !## inside polygon
  IF(IPFPLOT(IIPF)%ISELECT(4).EQ.1)THEN
   !## no, until proven to be inside
   IPFDLIST(3,II)=0
   DO I=1,SHP%NPOL
    IF(X.GE.SHP%POL(I)%XMIN.AND.X.LE.SHP%POL(I)%XMAX.AND. &
       Y.GE.SHP%POL(I)%YMIN.AND.Y.LE.SHP%POL(I)%YMAX)THEN
     IF(DBL_IGRINSIDESHAPE(X,Y,SHP%POL(I)).EQ.1)IPFDLIST(3,II)=1
!     IF(SHP%POL(I)%ITYPE.EQ.ID_POLYGON)THEN
!      IF(DBL_IGRINSIDEPOLYGON(X,Y,SHP%POL(I)%X,SHP%POL(I)%Y,SHP%POL(I)%N).EQ.1)IPFDLIST(3,II)=1
!     ELSEIF(SHP%POL(I)%ITYPE.EQ.ID_CIRCLE)THEN
!      IF(DBL_IGRINSIDECIRCLE(X,Y,SHP%POL(I)%X,SHP%POL(I)%Y,SHP%POL(I)%N).EQ.1)IPFDLIST(3,II)=1
!     ELSEIF(SHP%POL(I)%ITYPE.EQ.ID_RECTANGLE)THEN
!      IPFDLIST(3,II)=1
!     ENDIF
     IF(IPFDLIST(3,II).EQ.1)EXIT
    ENDIF
   ENDDO
  ENDIF
  
  !## inside buffer of active cross-sections
  IF(IPFPLOT(IIPF)%ISELECT(3).EQ.1)THEN
   IPFDLIST(3,II)=0
   Z=IPFPLOT(IIPF)%RSELECT(3)
SOLLOOP: DO I=1,NSOLLIST
    IF(SOLPLOT(I)%ISEL.NE.1)CYCLE
    DO J=2,SPF(I)%NXY
     DZ=DBL_IGRDISTANCELINE(SPF(I)%X(J-1),SPF(I)%Y(J-1),SPF(I)%X(J),SPF(I)%Y(J),X,Y,0)
     IF(DZ.LE.Z)THEN; IPFDLIST(3,II)=1; EXIT SOLLOOP; ENDIF
    ENDDO
   ENDDO SOLLOOP
  ENDIF
  
  IF(IPFPLOT(IIPF)%ISELECT(1).EQ.1.OR.IPFPLOT(IIPF)%ISELECT(2).EQ.1)THEN
   IF(ALLOCATED(ASSF))THEN
    IF(ASSOCIATED(ASSF(II)%Z))THEN
     Z=ASSF(II)%Z(1)-ASSF(II)%Z(ASSF(II)%NRASS)
     !## less than 
     IF(IPFPLOT(IIPF)%ISELECT(1).EQ.1.AND.Z.LT.IPFPLOT(IIPF)%RSELECT(1))IPFDLIST(3,II)=0
     !## greater than 
     IF(IPFPLOT(IIPF)%ISELECT(2).EQ.1.AND.Z.GT.IPFPLOT(IIPF)%RSELECT(2))IPFDLIST(3,II)=0
    ENDIF
   ENDIF
  ENDIF
   
  IF(IPFPLOT(IIPF)%NQUERY.GT.0)THEN
   !## only evaluate here to exclude the entire well
   IF(IPFPLOT(IIPF)%IEXCLUDE.EQ.1)THEN
    !## still active
    IF(IPFDLIST(3,II).EQ.1)THEN
     IPLOTTYPE=ASSF(II)%ITOPIC
     N=ASSF(II)%NRASS
     IF(ASSOCIATED(XBH))THEN; IF(N.GT.SIZE(XBH))DEALLOCATE(XBH,YBH,ZBH); ENDIF 
     IF(.NOT.ASSOCIATED(XBH))ALLOCATE(XBH(N),YBH(N),ZBH(N)) 
     !## read in complete borehole
     DO I=1,ASSF(II)%NRASS
      !## 1D borehole
      IF(IPLOTTYPE.EQ.2)THEN
       XBH(I)=X; YBH(I)=Y
      ELSEIF(IPLOTTYPE.EQ.4)THEN
       XBH(I)=X+ASSF(II)%DX(I); YBH(I)=Y+ASSF(II)%DY(I)
      ENDIF
      ZBH(I)=ASSF(II)%Z(I)
     ENDDO
     IPFDLIST(3,II)=IMOD3D_IPF_QUERY_EVALUATE(N,1,IIPF,II)
    ENDIF
   ENDIF
  ENDIF
  
 ENDDO

 IF(ASSOCIATED(XBH))DEALLOCATE(XBH,YBH,ZBH)
 CALL IMOD3D_IPF_QUERY_DEALLOCATE()
 CALL POLYGON1CLOSE()
 
 IMOD3D_IPF_SELECTION=.TRUE.

 END FUNCTION IMOD3D_IPF_SELECTION

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIPF(X,Y,Z,ZZ,IPLOTTYPE,IMODE,ICLR,IIPF,IGL,S,MXW) 
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOTTYPE,ICLR,IIPF,IGL
 INTEGER,DIMENSION(:),INTENT(IN) :: IMODE
 REAL(KIND=DP_KIND),INTENT(IN) :: S
 REAL(KIND=GLDOUBLE),INTENT(IN) :: X,Y,Z,ZZ,MXW
 REAL(KIND=GLDOUBLE) :: X1,Y1,Z1,BSIZE,FRAC
 INTEGER :: I,II,J,JJ,K,JCLR,N,IM,IMM
 REAL(KIND=DP_KIND) :: IWIDTH,R,ZTOL

 BSIZE=IPFPLOT(IIPF)%RADIUS 

 !## imode=1: drawing list
 !## imode=2: selection drawing list to be drawn in background only
 
 !## draw 1D (=2) or 3D (=4) borehole
 IF(IPLOTTYPE.EQ.2.OR.IPLOTTYPE.EQ.4)THEN

  !## nothing to draw
  IF(ASSF(NASSLIST)%NRASS.LE.0)RETURN

  ZTOL=IPFPLOT(IIPF)%SIMPLIFY; IF(IPLOTTYPE.EQ.2)ZTOL=0.0D0
  
  !## not plotting
  IF(IGL.EQ.0)THEN
   N=2; IF(IPLOTTYPE.EQ.4)N=ASSF(NASSLIST)%NRASS; N=MIN(N,ASSF(NASSLIST)%NRASS)
  ELSE
   N=ASSF(NASSLIST)%NRASS
  ENDIF
  IF(ASSOCIATED(XBH))THEN; IF(N.GT.SIZE(XBH))DEALLOCATE(XBH,YBH,ZBH,RBH,CBH); ENDIF
  IF(.NOT.ASSOCIATED(XBH))ALLOCATE(XBH(N),YBH(N),ZBH(N),RBH(N),CBH(N))
  IF(IPFPLOT(IIPF)%IEXCLUDE.EQ.2)THEN
   IF(ASSOCIATED(LBH))THEN; IF(N.GT.SIZE(LBH))DEALLOCATE(LBH); ENDIF
   IF(.NOT.ASSOCIATED(LBH))ALLOCATE(LBH(N))
  ENDIF
  R=IPFPLOT(IIPF)%RADIUS

  !## read in complete borehole - skip nodata in z-column
  I=0; II=0; DO
  
   !## counter for all intervals
   II=II+1; IF(II.GT.N)EXIT

   !## skip for nodata in z-values
   IF(IGL.NE.0)THEN
    IF(ASSF(NASSLIST)%Z(II).EQ.ASSF(NASSLIST)%NODATA(1))CYCLE
   ENDIF
   
   !## active intervals   
   I=I+1
   
   IF(IGL.EQ.1)THEN
    CALL IPFDRAWITOPIC2_ICLR(II,NASSLIST,JCLR,IWIDTH)
    !## normalize according to other sizes
    FRAC=IWIDTH/MXW
    CBH(I)=JCLR
    !## scale to percentage of graphical dimensions
    RBH(I)=FRAC*(S*R)
   ELSE
    !## default colour for min/max computation including selections
    CBH(I)=1
   ENDIF
    
   !## 1D borehole
   IF(IPLOTTYPE.EQ.2)THEN
    XBH(I)=X
    YBH(I)=Y
    IF(IGL.EQ.0)THEN
     IF(I.EQ.1)THEN
      !## look for first active interval
      DO JJ=1,ASSF(NASSLIST)%NRASS
       IF(ASSF(NASSLIST)%Z(JJ).NE.ASSF(NASSLIST)%NODATA(1))EXIT
      ENDDO
      ZBH(I)=ASSF(NASSLIST)%Z(JJ) 
     ELSE
      !## look for first active interval
      DO JJ=ASSF(NASSLIST)%NRASS,1,-1
       IF(ASSF(NASSLIST)%Z(JJ).NE.ASSF(NASSLIST)%NODATA(1))EXIT
      ENDDO
      ZBH(I)=ASSF(NASSLIST)%Z(JJ) 
     ENDIF
    ELSE
     ZBH(I)=ASSF(NASSLIST)%Z(II)
    ENDIF
   ELSEIF(IPLOTTYPE.EQ.4)THEN
    XBH(I)=X+ASSF(NASSLIST)%DX(II)
    YBH(I)=Y+ASSF(NASSLIST)%DY(II)
    ZBH(I)=  ASSF(NASSLIST)%Z (II)
   ENDIF

   IF(IPFPLOT(IIPF)%IEXCLUDE.EQ.2)THEN
    !## store labels
    DO J=1,IPFPLOT(IIPF)%NQUERY
     IF(ASSF(NASSLIST)%ITOPIC.EQ.2)THEN
      !## read z-coordinate
      IF(IPFPLOT(IIPF)%QUERY(J)%IFIELD.EQ.1)THEN
       WRITE(LBH(I),*) ASSF(NASSLIST)%Z(II)
      ELSE
       K=IPFPLOT(IIPF)%QUERY(J)%IFIELD-1
       LBH(I)=UTL_CAP(ASSF(NASSLIST)%L(K,II),'U')
      ENDIF
     ELSEIF(ASSF(NASSLIST)%ITOPIC.EQ.4)THEN      
      !## read dx-coordinate
      IF(IPFPLOT(IIPF)%QUERY(J)%IFIELD.EQ.1)THEN
       WRITE(LBH(I),*) ASSF(NASSLIST)%DX(II)
      ELSEIF(IPFPLOT(IIPF)%QUERY(J)%IFIELD.EQ.2)THEN
       WRITE(LBH(I),*) ASSF(NASSLIST)%DY(II)
      ELSEIF(IPFPLOT(IIPF)%QUERY(J)%IFIELD.EQ.3)THEN
       WRITE(LBH(I),*) ASSF(NASSLIST)%Z(II)
      ELSE
       K=IPFPLOT(IIPF)%QUERY(J)%IFIELD-3
       LBH(I)=UTL_CAP(ASSF(NASSLIST)%L(K,II),'U')
      ENDIF
     ENDIF
    ENDDO
   ENDIF
   
  ENDDO

  !## number of active intervals
  N=MIN(I,N)
!  DO I=1,N
!   WRITE(*,*) i,XBH(I),YBH(I),ZBH(I),CBH(I)
!  ENDDO
  
  !## apply query if needed --- set white --- blank out colour ... also correct z-values if needed ...
  IF(IPFPLOT(IIPF)%NQUERY.GT.0)THEN
   IF(.NOT.IMOD3D_IPF_QUERY_EVALUATE(N,IPFPLOT(IIPF)%IEXCLUDE,IIPF,NASSLIST))THEN 
   ENDIF
  ENDIF

  IF(MAXVAL(CBH(1:N)).GE.0)THEN
  
   IF(IGL.EQ.0)THEN
    TOP%X=MAX(TOP%X,MAXVAL(XBH(1:N))); BOT%X=MIN(BOT%X,MINVAL(XBH(1:N)))
    TOP%Y=MAX(TOP%Y,MAXVAL(YBH(1:N))); BOT%Y=MIN(BOT%Y,MINVAL(YBH(1:N)))
    TOP%Z=MAX(TOP%Z,MAXVAL(ZBH(1:N))); BOT%Z=MIN(BOT%Z,MINVAL(ZBH(1:N)))
   ENDIF

   !## apply scaling
   IF(IPFPLOT(IIPF)%IFANCY.EQ.1)ZBH(1:N)=ZBH(1:N)*ZSCALE_FACTOR

   DO IM=1,SIZE(IMODE)
    IMM=IMODE(IM)
    
    IF(IGL.EQ.1)THEN
     IPFLISTINDEX(NIPFLIST,IMM)=GLGENLISTS(1)
     !## start new drawing list for current object
     CALL GLNEWLIST(IPFLISTINDEX(NIPFLIST,IMM),GL_COMPILE)
    ENDIF

    !## simple lines
    IF(IPFPLOT(IIPF)%IFANCY.EQ.0)THEN
     IF(IGL.EQ.1)THEN
      CALL GLBEGIN(GL_LINES)
      DO I=1,N-1
       !## skip zero thicknesses
       IF(ZBH(I).EQ.ZBH(I+1))CYCLE
       !## skip de-coloured ones
       IF(CBH(I).LT.0)CYCLE
       IF(IMM.EQ.1)THEN
        CALL IMOD3D_SETCOLOR(CBH(I))
       ELSEIF(IMM.EQ.2)THEN
        CALL IMOD3D_SETCOLOR(NASSLIST)
       ENDIF
       !## from location
       X1=XBH(I);   Y1=YBH(I);   Z1=ZBH(I);   CALL GLVERTEX3D(X1,Y1,Z1)
       !## to location
       X1=XBH(I+1); Y1=YBH(I+1); Z1=ZBH(I+1); CALL GLVERTEX3D(X1,Y1,Z1)
      ENDDO
      CALL GLEND()
     ENDIF

    !## 3d boreholes
    ELSE

     IF(IGL.EQ.1)CALL IMOD3D_TUBE(N,IPFPLOT(IIPF)%ISUB,IMM,IPFPLOT(IIPF)%ISHADE,NASSLIST,ZTOL)
    ENDIF

    IF(IGL.EQ.1)CALL GLENDLIST()

   ENDDO
  ENDIF
  
 !## points only
 ELSEIF(IPLOTTYPE.EQ.0)THEN
      
  IF(IGL.EQ.1)THEN

   CALL IMOD3D_SETCOLOR(ICLR)
   IF(IPFPLOT(IIPF)%IFANCY.EQ.1)THEN
    CALL IMOD3D_RETURNCOLOR(ICLR,AMBIENT) 
    CALL GLMATERIALFV(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE,AMBIENT) 
   ENDIF

   !## draw point if z equals z2
   IF(Z.EQ.ZZ)THEN
 
    IF(IPFPLOT(IIPF)%IFANCY.EQ.1)THEN
     CALL GLPUSHMATRIX()
     CALL GLTRANSLATED(X,Y,Z) 
     CALL GLCALLLIST(SPHEREINDEX)  ! RENDER SPHERE DISPLAY LIST
     CALL GLPOPMATRIX()
    ELSE
     !## draw point of drill/ipf
     CALL GLBEGIN(GL_POINTS); CALL GLVERTEX3D(X,Y,Z); CALL GLEND()
    ENDIF
   
   !## draw line between top and bottom
   ELSE
   
    IF(IPFPLOT(IIPF)%IFANCY.EQ.0)THEN

     CALL GLBEGIN(GL_LINES); CALL GLVERTEX3D(X,Y,Z); CALL GLVERTEX3D(X,Y,ZZ); CALL GLEND()

    ELSEIF(IPFPLOT(IIPF)%IFANCY.EQ.1)THEN
     CALL IMOD3D_IPF_FANCY((/X,X/),(/Y,Y/),(/Z,ZZ/),IPFPLOT(IIPF)%ISUB,BSIZE*S,(/1,1,1,IPFPLOT(IIPF)%ISHADE/))

    ENDIF
   
   ENDIF
  
  ENDIF
  
  TOP%Z=MAX(TOP%Z,Z,ZZ); BOT%Z=MIN(BOT%Z,Z,ZZ)

 ENDIF
 
 CALL IMOD3D_ERROR('IMOD3D_DRAWIPF')

 END SUBROUTINE IMOD3D_DRAWIPF

 !###======================================================================
 SUBROUTINE IMOD3D_IPF_CREATEBALL(ISUB,ISTYLE,R)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISUB,ISTYLE
 REAL(KIND=DP_KIND),INTENT(IN) :: R
 REAL(GLDOUBLE) :: RD
 TYPE(GLUQUADRICOBJ), POINTER :: QUADOBJ
  
 !## Create the sphere display list
 IF(SPHEREINDEX.NE.0)CALL GLDELETELISTS(SPHEREINDEX,1_GLSIZEI); SPHEREINDEX=0
 SPHEREINDEX=GLGENLISTS(1)
 CALL GLNEWLIST(SPHEREINDEX,GL_COMPILE)

 CALL GLPUSHMATRIX()

 !## to ensure appropriate scaling of vector
 CALL GLSCALED(1.0_GLDOUBLE/XSCALE_FACTOR,1.0_GLDOUBLE/YSCALE_FACTOR,1.0_GLDOUBLE/ZSCALE_FACTOR)

 QUADOBJ=>GLUNEWQUADRIC()
 SELECT CASE (ISTYLE)
  CASE (1); CALL GLUQUADRICDRAWSTYLE(QUADOBJ, GLU_POINT)
  CASE (2); CALL GLUQUADRICDRAWSTYLE(QUADOBJ, GLU_LINE)
  CASE (3); CALL GLUQUADRICDRAWSTYLE(QUADOBJ, GLU_SILHOUETTE)
  CASE (4); CALL GLUQUADRICDRAWSTYLE(QUADOBJ, GLU_FILL)
 END SELECT
 CALL GLUQUADRICNORMALS(QUADOBJ, GLU_SMOOTH)
 RD=R
 CALL GLUSPHERE(QUADOBJ,RD,ISUB,ISUB)

 CALL GLPOPMATRIX()

 CALL GLENDLIST()
 
 END SUBROUTINE IMOD3D_IPF_CREATEBALL
 
 !###======================================================================
 SUBROUTINE IMOD3D_IPF_FANCY(XMID,YMID,ZMID,NINT,RADIUS,IPLT) 
 !###======================================================================
 IMPLICIT NONE 
 REAL(KIND=GLDOUBLE),INTENT(IN),DIMENSION(:) :: XMID,YMID,ZMID
 REAL(KIND=GLDOUBLE),INTENT(IN) :: RADIUS
 REAL(KIND=GLDOUBLE) :: DGRAD,FGRAD,XPOS,YPOS,ZPOS
 INTEGER,INTENT(IN) :: NINT
 INTEGER,INTENT(IN),DIMENSION(:) :: IPLT
 INTEGER :: I,J

 DGRAD=2.0D0*PI_OPENGL/DBLE(NINT) !## stepsize angle radials
 
 !## generate triangle_fan for the top/bottom of current interval
 DO I=1,2
  IF(IPLT(I).EQ.0)CYCLE
  FGRAD=0.0_GLDOUBLE
  CALL GLBEGIN(GL_TRIANGLE_FAN)
  !## add shades
  IF(IPLT(4).EQ.1)CALL GLNORMAL3D(0.0_GLDOUBLE,0.0_GLDOUBLE,-1.0_GLDOUBLE)
  CALL GLVERTEX3D(XMID(I),YMID(I),ZMID(I))
  DO J=1,NINT+1
   XPOS=COS(FGRAD)*RADIUS
   YPOS=SIN(FGRAD)*RADIUS 
   ZPOS=0.0_GLDOUBLE
   CALL GLVERTEX3D(XMID(I)+XPOS,YMID(I)+YPOS,ZMID(I)+ZPOS)
   FGRAD=FGRAD+DGRAD
  ENDDO
  CALL GLEND()
 ENDDO
 
 !## generate side of the triangle_fan
 IF(IPLT(3).EQ.1)THEN
  CALL GLBEGIN(GL_QUAD_STRIP)
  FGRAD=0.0_GLDOUBLE
  DO J=1,NINT+1
   XPOS=COS(FGRAD)*RADIUS
   YPOS=SIN(FGRAD)*RADIUS
   ZPOS=0.0_GLDOUBLE
   !## add shades
   IF(IPLT(4).EQ.1)CALL GLNORMAL3D(-COS(FGRAD),-SIN(FGRAD),0.0_GLDOUBLE)
   CALL GLVERTEX3D(XMID(1)+XPOS,YMID(1)+YPOS,ZMID(1)+ZPOS)
   CALL GLVERTEX3D(XMID(2)+XPOS,YMID(2)+YPOS,ZMID(2)+ZPOS)
   FGRAD=FGRAD+DGRAD
  ENDDO
  CALL GLEND() 
 ENDIF
  
 END SUBROUTINE IMOD3D_IPF_FANCY
 
 !###======================================================================
 SUBROUTINE IMOD3D_IPF_LABELS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IIPF,I,J,K,IPLOT,N,ACOL
 REAL(KIND=GLDOUBLE) :: X,Y,Z,BSIZE
 CHARACTER(LEN=256) :: LINE,TLINE
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ILIST
 REAL(KIND=GLDOUBLE),PARAMETER :: TS= 10.0D0 !## textsize
 REAL(KIND=GLDOUBLE) :: TSIZE

 IF(NIPF.EQ.0)RETURN

 !## get labels
 N=0
 DO IIPF=1,NIPF

  BSIZE=IPFPLOT(IIPF)%RADIUS
  
  IPLOT=IPFPLOT(IIPF)%IPLOT
  ALLOCATE(ILIST(IPF(IIPF)%NCOL))
  !## get selected labels for printing
  CALL UTL_FILLARRAY(ILIST,IPF(IIPF)%NCOL,ABS(MP(IPLOT)%IEQ))

  TSIZE=MP(IPLOT)%TSIZE*TS
  ACOL=IPF(IIPF)%ACOL; IF(ACOL.LT.0.OR.ACOL.GT.IPF(IIPF)%NCOL)ACOL=0
  IF(ACOL.EQ.0)THEN
   !## start drawing list
   N=N+1; IF(IPFLISTINDEX(N,3).NE.0)CALL GLDELETELISTS(IPFLISTINDEX(N,3),1_GLSIZEI)
   IPFLISTINDEX(N,3)=GLGENLISTS(1)
   !## start new drawing list for current object
   CALL GLNEWLIST(IPFLISTINDEX(N,3),GL_COMPILE)
   !## underneath borehole
   CALL WGLTEXTORIENTATION(ALIGNRIGHT)
  ENDIF
  
  DO I=1,IPF(IIPF)%NROW
   
   IF(IPF(IIPF)%IPOS(I).EQ.INT(1,1))THEN

    !## label-drawing list
    IF(ACOL.NE.0)THEN
     !## start drawing list
     N=N+1; IF(IPFLISTINDEX(N,3).NE.0)CALL GLDELETELISTS(IPFLISTINDEX(N,3),1_GLSIZEI)
     IPFLISTINDEX(N,3)=GLGENLISTS(1)
     !## start new drawing list for current object
     CALL GLNEWLIST(IPFLISTINDEX(N,3),GL_COMPILE)
     !## underneath borehole
     CALL WGLTEXTORIENTATION(ALIGNRIGHT)
    ENDIF
  
    X =IPF(IIPF)%XYZ(1,I)
    Y =IPF(IIPF)%XYZ(2,I)
    Z =IPF(IIPF)%XYZ(3,I)

!    X=X-BSIZE

    !## copy temporary the modelmatrix
    CALL GLPUSHMATRIX()

    !## make sure z is within top%z,bot%z (in case wrong kolom is used or column is missing)
    IF(Z.LT.BOT%Z.OR.Z.GT.TOP%Z)Z=TOP%Z

    !## go to the location of point
    CALL GLTRANSLATED(X,Y,Z)
    CALL GLSCALED(1.0_GLDOUBLE/XSCALE_FACTOR,1.0_GLDOUBLE/YSCALE_FACTOR,1.0_GLDOUBLE/ZSCALE_FACTOR)
    CALL GLSCALED(TSIZE,TSIZE,TSIZE)
    CALL GLROTATED( 90.0_GLDOUBLE,0.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE)
    CALL GLROTATED(-90.0_GLDOUBLE,0.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE)

    IF(SUM(ILIST).EQ.0)THEN
     LINE='no label'
    ELSE
     LINE=''
     DO J=1,IPF(IIPF)%NCOL
      IF(ILIST(J).EQ.1)THEN
       TLINE=IPF(IIPF)%INFO(J,I)
       K=0
       IF(IBACKSLASH.EQ.1)THEN
        K=INDEX(TLINE,'\',.TRUE.)
        IF(K.GT.0)K=K+1
       ENDIF
       K=MAX(1,K)
       IF(ILABELNAME.EQ.0)THEN
        LINE=TRIM(LINE)//TRIM(TLINE(K:))//';'
       ELSE
        LINE=TRIM(LINE)//TRIM(IPF(IIPF)%ATTRIB(J))//'='//TRIM(TLINE(K:))//';'
       ENDIF
      ENDIF
     END DO
     J=INDEX(LINE,';',.TRUE.)
     IF(J.NE.0)LINE(J:J)=' '
    ENDIF

    CALL WGLTEXTSTRING(TRIM(LINE)//'  ')

    !## get previous modelmatrix again
    CALL GLPOPMATRIX()

    !## end ipflabellist
    IF(ACOL.NE.0)CALL GLENDLIST()

   ENDIF
  ENDDO

  !## end ipflabellist
  IF(ACOL.EQ.0)CALL GLENDLIST()

  DEALLOCATE(ILIST)
 ENDDO

 CALL IMOD3D_ERROR('IMOD3D_IPF_LABELS')

 END SUBROUTINE IMOD3D_IPF_LABELS

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_IFF()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I,J,K,NINIFF

 IMOD3D_IFF=.FALSE.

 NIFFLIST=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.3)NIFFLIST=NIFFLIST+1
 ENDDO

 !## nothing to do - no drills or ipf's files found
 IF(NIFFLIST.LE.0)THEN; IMOD3D_IFF=.TRUE.; RETURN; ENDIF

 !## get display-list pointers
 ALLOCATE(IFFLISTINDEX(NIFFLIST),IFFPLOT(NIFFLIST)); IFFLISTINDEX=0

 NIFFLIST=0; NINIFF  =0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.3)THEN
   J=NIFFLIST; J=J+1; NIFFLIST=J
   IFFPLOT(NIFFLIST)%ISEL=1
   IFFPLOT(NIFFLIST)%ITHICKNESS=1
   IFFPLOT(NIFFLIST)%ICLIP=1
   IFFPLOT(NIFFLIST)%IPLOT=IPLOT
   IFFPLOT(NIFFLIST)%IPLOTLEGEND=0
   J=INDEX(MP(IPLOT)%IDFNAME,'\',.TRUE.)+1
   K=LEN_TRIM(MP(IPLOT)%IDFNAME)
   IFFPLOT(NIFFLIST)%FNAME='('//TRIM(ITOS(NIFFLIST))//') '//MP(IPLOT)%IDFNAME(J:K)
   CALL IMOD3D_DRAWIFF(IPLOT,NINIFF) 
  ENDIF
 ENDDO

 !## nothing to be seen of the selected iff's
 IF(NINIFF.LE.0)THEN
  DO I=1,NIFFLIST
   !## destroy current display list index - solid
   CALL GLDELETELISTS(IFFLISTINDEX(I),1_GLSIZEI)
  END DO
  NIFFLIST=0
 ENDIF

 IMOD3D_IFF=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_IFF')

 END FUNCTION IMOD3D_IFF

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_REDRAWIFF()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,NINIFF

 IMOD3D_REDRAWIFF=.FALSE.

 NIFFLIST=0; NINIFF=0
 DO IPLOT=1,MXMPLOT
  IF(MP(IPLOT)%ISEL.AND.MP(IPLOT)%IPLOT.EQ.3)THEN
   NIFFLIST=NIFFLIST+1

   !## destroy current display list index
   CALL GLDELETELISTS(IFFLISTINDEX(NIFFLIST),1_GLSIZEI)
   CALL IMOD3D_DRAWIFF(IPLOT,NINIFF)  !VIEWDX,VIEWDY,

  ENDIF
 ENDDO

 IMOD3D_REDRAWIFF=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_REDRAWIFF')

 END FUNCTION IMOD3D_REDRAWIFF

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWIFF(IPLOT,NINIFF)  
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(INOUT) :: NINIFF
 INTEGER,INTENT(IN) :: IPLOT
 INTEGER :: I,J,N,IOS,IU,ICLR
 REAL(KIND=GLDOUBLE),DIMENSION(2) :: XCOR,YCOR,ZCOR
 REAL(KIND=DP_KIND) :: XVAL

 CALL WINDOWSELECT(IWIN3D); CALL WINDOWOUTSTATUSBAR(2,'Reading '//TRIM(MP(IPLOT)%IDFNAME)//'...')

 !## open iff-file
 IU=IFFGETUNIT(MP(IPLOT)%IDFNAME,'OLD'); IF(IU.LE.0)RETURN

 CALL WINDOWSELECT(IWIN3D)

 !## list index for
 IFFLISTINDEX(NIFFLIST)=GLGENLISTS(1)
 !## start new drawing list
 CALL GLNEWLIST(IFFLISTINDEX(NIFFLIST),GL_COMPILE)

 CALL GLBEGIN(GL_LINES)

 READ(IU,*) N
 DO I=1,N; READ(IU,*) ; END DO
 
 ALLOCATE(IFF(2)); N=N-5
 DO I=1,SIZE(IFF); NULLIFY(IFF(I)%XVAL); ALLOCATE(IFF(I)%XVAL(N)); ENDDO

 IFF(2)%IPART=0
 DO
  READ(IU,*,IOSTAT=IOS) IFF(1)%IPART,IFF(1)%IL,IFF(1)%X,IFF(1)%Y,IFF(1)%Z,(IFF(1)%XVAL(J),J=1,N)
  IF(IOS.NE.0)EXIT

  !## same particle
  IF(IFF(1)%IPART.EQ.IFF(2)%IPART)THEN

   !## current point insize viewable extent
   IF(IFF(1)%X.LT.TOP%X.AND.IFF(1)%X.GE.BOT%X.AND. &
      IFF(1)%Y.LT.TOP%Y.AND.IFF(1)%Y.GE.BOT%Y)THEN

    !## length line is zero!
    IF(IFF(1)%X-IFF(2)%X.NE.0.0D0.OR.IFF(1)%Y-IFF(2)%Y.NE.0.0D0.OR. &
       IFF(1)%Z-IFF(2)%Z.NE.0.0D0)THEN

     !## use of line-colouring
     IF(MP(IPLOT)%ILEG.EQ.1)THEN 
      CALL IFFPLOT_GETIFFVAL(MP(IPLOT)%IATTRIB,XVAL)
      ICLR=UTL_IDFGETCLASS(MP(IPLOT)%LEG,XVAL)
      CALL IMOD3D_SETCOLOR(ICLR) 
     ENDIF

     NINIFF =NINIFF+1

     XCOR(1)=IFF(1)%X 
     YCOR(1)=IFF(1)%Y 
     XCOR(2)=IFF(2)%X 
     YCOR(2)=IFF(2)%Y 
     ZCOR(1)=IFF(1)%Z
     ZCOR(2)=IFF(2)%Z
     CALL IMOD3D_LINE(XCOR,YCOR,ZCOR)
    ENDIF

   ENDIF
  ENDIF

  IFF(2)%IPART=IFF(1)%IPART
  IFF(2)%IL   =IFF(1)%IL
  IFF(2)%X    =IFF(1)%X
  IFF(2)%Y    =IFF(1)%Y
  IFF(2)%Z    =IFF(1)%Z
  DO J=1,N; IFF(2)%XVAL(J)=IFF(1)%XVAL(J); ENDDO

 ENDDO
 CLOSE(IU)
 DO I=1,SIZE(IFF); DEALLOCATE(IFF(I)%XVAL); ENDDO; DEALLOCATE(IFF)

 CALL GLEND()
 CALL GLENDLIST()

 CALL WINDOWOUTSTATUSBAR(2,'')

 CALL IMOD3D_ERROR('IMOD3D_DRAWIFF')

 END SUBROUTINE IMOD3D_DRAWIFF

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_CREATECOOKIECUTTERS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,N,NIDF_CC
 LOGICAL :: LEX
  
 IMOD3D_CREATECOOKIECUTTERS=.TRUE.
 
 IF(ALLOCATED(IDF_CC))RETURN
 N=0; DO I=1,SIZE(MP); IF(MP(I)%ISEL.AND.MP(I)%IPLOT.EQ.6)N=N+1; ENDDO; IF(N.EQ.0)RETURN 
 
 IF(ALLOCATED(IDF))THEN
  CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF) 
 ENDIF
 ALLOCATE(IDF(NIDFLIST)); DO I=1,NIDFLIST; CALL IDFNULLIFY(IDF(I)); ENDDO
 DO I=1,NIDFLIST; IF(.NOT.IDFREAD(IDF(I),IDFPLOT(I)%FNAME,0))EXIT; ENDDO

 IMOD3D_CREATECOOKIECUTTERS=.FALSE.
 ALLOCATE(IDF_CC(1)); CALL IDFNULLIFY(IDF_CC(1))
 !## copy settings - maximal extent
 IF(.NOT.IDF_EXTENT(SIZE(IDF),IDF,IDF_CC(1),1))RETURN
 IF(.NOT.IDFALLOCATEX(IDF_CC(1)))THEN; ENDIF; IDF_CC(1)%X=0.0D0; IDF_CC(1)%NODATA=0.0D0

 CALL POLYGON1INIT()
 NIDF_CC=0; DO I=1,SIZE(MP) 
  IF(MP(I)%IACT.AND.MP(I)%ISEL.AND.MP(I)%IPLOT.EQ.6)THEN
   INQUIRE(FILE=MP(I)%IDFNAME,EXIST=LEX)
   IF(LEX)THEN
    CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,MP(I)%IDFNAME,'GEN')
    IF(IMOD3D_CREATECOOKIECUTTERS_FILL(NIDF_CC))THEN; ENDIF
   ENDIF
  ENDIF
 ENDDO
 CALL POLYGON1CLOSE() 
 IF(NIDF_CC.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'No active cells found in current GEN-files','Warning')

 CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF) 
 
 IMOD3D_CREATECOOKIECUTTERS=.TRUE.
 
 END FUNCTION IMOD3D_CREATECOOKIECUTTERS

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_CREATECOOKIECUTTERS_FILL(M)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(INOUT) :: M
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2,XVAL,YVAL
 INTEGER :: IC1,IR1,IC2,IR2,IROW,ICOL,I
 
 IMOD3D_CREATECOOKIECUTTERS_FILL=.FALSE.
 
 DO I=1,SHP%NPOL
  IF(SHP%POL(I)%N.GT.0)THEN
   X1=MINVAL(SHP%POL(I)%X(1:SHP%POL(I)%N)); X2=MAXVAL(SHP%POL(I)%X(1:SHP%POL(I)%N))
   Y1=MINVAL(SHP%POL(I)%Y(1:SHP%POL(I)%N)); Y2=MAXVAL(SHP%POL(I)%Y(1:SHP%POL(I)%N))

   !## get ofset from xmin/ymin in the number of cells
   !## increase them in case of frf en fff computation
   CALL IDFIROWICOL(IDF_CC(1),IR1,IC1,X1,Y2)
   CALL IDFIROWICOL(IDF_CC(1),IR2,IC2,X2,Y1) 
   IF(IC2.EQ.0)IC2=IDF_CC(1)%NCOL
   IF(IR2.EQ.0)IR2=IDF_CC(1)%NROW   
   IC1=MAX(1,IC1); IC2=MIN(IC2,IDF_CC(1)%NCOL)
   IR1=MAX(1,IR1); IR2=MIN(IR2,IDF_CC(1)%NROW)

   DO IROW=IR1,IR2; DO ICOL=IC1,IC2
    CALL IDFGETLOC(IDF_CC(1),IROW,ICOL,XVAL,YVAL)
    IF(DBL_IGRINSIDESHAPE(XVAL,YVAL,SHP%POL(I)).EQ.1)THEN
!    IF(DBL_IGRINSIDEPOLYGON(XVAL,YVAL,SHP%POL(I)%X,SHP%POL(I)%Y,SHP%POL(I)%N).EQ.1)THEN
     IDF_CC(1)%X(ICOL,IROW)=REAL(I); M=M+1
    ENDIF
   ENDDO; ENDDO
  ENDIF
 ENDDO

 IMOD3D_CREATECOOKIECUTTERS_FILL=.TRUE.
 
 END FUNCTION IMOD3D_CREATECOOKIECUTTERS_FILL
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_GEN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,NINGEN
 LOGICAL :: LEX

! IF(ALLOCATED(GENLISTINDEX))THEN
!  K=NGENLIST; NGENLIST=0
!  DO I=1,K
!   NINGEN=0; NGENLIST=NGENLIST+1; CALL IMOD3D_DRAWGEN(GENPLOT(I)%GENFNAME,GENPLOT(I)%L3D,NINGEN) 
!  ENDDO
!  IMOD3D_GEN=.TRUE.; RETURN
! ENDIF
 
 IMOD3D_GEN=.FALSE.

 NGENLIST=0
 DO I=1,MXGEN
  IF(GEN(I)%IACT.AND.GEN(I)%ISEL.AND.ABS(GEN(I)%ITYPE).EQ.1)NGENLIST=NGENLIST+1
 ENDDO
 IF(NGENLIST.EQ.0)RETURN

 !## get display-list pointers
 IF(ALLOCATED(GENLISTINDEX))DEALLOCATE(GENLISTINDEX)
 IF(ALLOCATED(GENPLOT))DEALLOCATE(GENPLOT)
 ALLOCATE(GENLISTINDEX(NGENLIST),GENPLOT(NGENLIST))
 GENLISTINDEX=0

 !## read gen
 NGENLIST=0
 DO I=1,MXGEN
  NINGEN=0
  IF(GEN(I)%IACT.AND.GEN(I)%ISEL.AND.ABS(GEN(I)%ITYPE).EQ.1)THEN
   INQUIRE(FILE=GEN(I)%GENFNAME,EXIST=LEX)
   IF(LEX)THEN
    NGENLIST=NGENLIST+1
    GENPLOT(NGENLIST)%GENFNAME=GEN(I)%GENFNAME
    GENPLOT(NGENLIST)%ISEL=1
    GENPLOT(NGENLIST)%ICLIP=1
    GENPLOT(NGENLIST)%ITHICKNESS=1
    GENPLOT(NGENLIST)%ICOLOR=WRGB(0,0,0)
    GENPLOT(NGENLIST)%L3D=.FALSE.
    GENPLOT(NGENLIST)%ISHADE=1
    GENPLOT(NGENLIST)%ITRANSPARANCY=50
    J=INDEX(GEN(I)%GENFNAME,'\',.TRUE.)+1; K=LEN_TRIM(GEN(I)%GENFNAME)
    GENPLOT(NGENLIST)%FNAME='('//TRIM(ITOS(NGENLIST))//') '//GEN(I)%GENFNAME(J:K)
    CALL IMOD3D_DRAWGEN(GENPLOT(NGENLIST)%GENFNAME,GENPLOT(NGENLIST)%L3D,NINGEN)
    IF(NINGEN.LE.0)THEN
     CALL GLDELETELISTS(GENLISTINDEX(NGENLIST),1_GLSIZEI); GENLISTINDEX(NGENLIST)=0
     NGENLIST=NGENLIST-1
    ENDIF
   ENDIF
  ENDIF
 ENDDO

 CALL WINDOWOUTSTATUSBAR(2,'')

 IMOD3D_GEN=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_GEN')

 END FUNCTION IMOD3D_GEN

 !###======================================================================
 SUBROUTINE IMOD3D_DRAWGEN(FNAME,L3D,NINGEN)  
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(INOUT) :: NINGEN
 LOGICAL,INTENT(OUT) :: L3D
 LOGICAL :: LS3D,LEX
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 CHARACTER(LEN=256) :: LINE
 INTEGER :: IU,IOS,I,J,NX,IFORMAT,ITYPE,MAXPOL,MAXCOL
 REAL(KIND=GLDOUBLE) :: XMIN,YMIN,XMAX,YMAX,XP,YP,L,A
 REAL(KIND=GLDOUBLE),DIMENSION(:),POINTER :: X,Y,Z,X_DUM,Y_DUM,Z_DUM

! !## no need to reread 3d-gen file
! IF(L3D)RETURN
 
 IF(.NOT.POLYGON_UTL_OPENGEN(FNAME,IFORMAT,IU))RETURN

 CALL WINDOWSELECT(IWIN3D); CALL WINDOWOUTSTATUSBAR(2,'Reading '//TRIM(FNAME)//'...')

 !## list index for
 GENLISTINDEX(NGENLIST)=GLGENLISTS(1)
 !## start new drawing list
 CALL GLNEWLIST(GENLISTINDEX(NGENLIST),GL_COMPILE)

 CALL GLCOLORMATERIAL(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE)
 CALL GLENABLE(GL_COLOR_MATERIAL)

 !## 3d gen?
 L3D=.TRUE.
 !## 3d gen used for scaling
 LS3D=.FALSE.
 NX=100; ALLOCATE(X(NX),Y(NX),Z(NX))

 !## read header in case of binary GEN file
 IF(IFORMAT.EQ.0)THEN
  !## read overall extent of polygons
  READ(IU) XMIN,YMIN,XMAX,YMAX
  IF(XMAX.GE.BOT%X.AND.XMIN.LE.TOP%X.AND.YMAX.GE.BOT%Y.AND.YMIN.LE.TOP%Y)THEN
   READ(IU) MAXPOL,MAXCOL
   !## labels available
   IF(MAXCOL.GT.0)THEN
    READ(IU) !(COLWIDTH(I),I=1,MAXCOL)
    !## read column names
    READ(IU) !(COLNAMES(I),I=1,MAXCOL)
   ENDIF
  ELSE
   !## nothing to draw
   CLOSE(IU); RETURN
  ENDIF
  L3D=.FALSE.; LS3D=.FALSE. 
 ENDIF
 
 DO

  IF(IFORMAT.EQ.0.AND.NINGEN.GE.MAXPOL)EXIT

  !## ascii format - no labeling possible
  IF(IFORMAT.EQ.1)THEN
 
   !## read id
   READ(IU,*,IOSTAT=IOS); IF(IOS.NE.0)EXIT
   I=0; LS3D=.TRUE.
   DO
    !## read coordinates
    READ(IU,'(A256)',IOSTAT=IOS) LINE; IF(IOS.NE.0)EXIT
    I=I+1; IF(I.GT.NX)THEN
     ALLOCATE(X_DUM(NX+100),Y_DUM(NX+100),Z_DUM(NX+100))
     DO J=1,NX; X_DUM(J)=X(J); Y_DUM(J)=Y(J); Z_DUM(J)=Z(J); ENDDO
     DEALLOCATE(X,Y,Z); X=>X_DUM; Y=>Y_DUM; Z=>Z_DUM; NX=NX+100
    ENDIF
    !## try to read 3d info
    READ(LINE,*,IOSTAT=IOS) X(I),Y(I),Z(I)
    IF(IOS.NE.0)THEN
     !## read 2d info
     READ(LINE,*,IOSTAT=IOS) X(I),Y(I); IF(IOS.NE.0)EXIT 
     L3D=.FALSE.; LS3D=.FALSE.; Z(I)=0.0D0
    ENDIF
   ENDDO
  
   NX=I-1; IF(NX.LT.2)CYCLE
   !## default lines
   ITYPE=ID_LINE
   
  ELSE

   READ(IU) NX,ITYPE
   !## read labels
   IF(MAXCOL.GT.0)READ(IU) !(LBL(I)%STRING,I=1,MAXCOL)
   IF(ASSOCIATED(X))THEN; IF(NX.GT.SIZE(X))DEALLOCATE(X,Y,Z); ENDIF
   IF(.NOT.ASSOCIATED(X))ALLOCATE(X(NX),Y(NX),Z(NX))

   READ(IU) XMIN,YMIN,XMAX,YMAX

   LEX=.FALSE.
   IF(XMAX.GE.BOT%X.AND.XMIN.LE.TOP%X.AND.YMAX.GE.BOT%Y.AND.YMIN.LE.TOP%Y)LEX=.TRUE.
 
   READ(IU) (X(I),Y(I),I=1,NX)
   Z=0.0D0

   NINGEN =NINGEN+1

   !## skip this polygon as it is outside current zoom-domain
   IF(.NOT.LEX)CYCLE
   
  ENDIF

  !## determine polygon - all coordinates are equal (xyz) between first and last mentioned and NXY equals 5
  IF(L3D.AND.NX.EQ.5.AND. &
     UTL_EQUALS_REAL(X(NX),X(1)).AND. &
     UTL_EQUALS_REAL(Y(NX),Y(1)).AND. &
     UTL_EQUALS_REAL(Z(NX),Z(1)))THEN

   IF((X(1).GT.BOT%X.OR.X(2).GT.BOT%X).AND.(X(1).LT.TOP%X.OR.X(2).LT.TOP%X).AND. &
      (Y(1).GT.BOT%Y.OR.Y(2).GT.BOT%Y).AND.(Y(1).LT.TOP%Y.OR.Y(2).LT.TOP%Y))THEN
    NINGEN =NINGEN+1

    !## top
    CALL GLBEGIN(GL_QUADS)
     CALL IMOD3D_SETNORMALVECTOR(X(1),Y(1),Z(1),X(2),Y(2),Z(2),X(3),Y(3),Z(3))
     CALL GLVERTEX3D(X(1),Y(1),Z(1))
     CALL GLVERTEX3D(X(2),Y(2),Z(2))
     CALL GLVERTEX3D(X(3),Y(3),Z(3))
     CALL GLVERTEX3D(X(4),Y(4),Z(4))  
    CALL GLEND()

    IF(LS3D)THEN
     TOP%Z=MAX(TOP%Z,Z(1),Z(3)) 
     BOT%Z=MIN(BOT%Z,Z(1),Z(3)) 
    ENDIF
    
   ENDIF
   
  ELSE
  
   IF(ITYPE.EQ.ID_POLYGON)THEN

    !## draw polygon
    CALL GLBEGIN(GL_LINES) 
     DO I=1,NX
      CALL GLVERTEX3D(X(I),Y(I),Z(I))
     ENDDO
    CALL GLEND()

   ELSEIF(ITYPE.EQ.ID_LINE)THEN

    !## 2d-lines
    CALL GLBEGIN(GL_LINES)
     DO I=1,NX-1
      IF((X(I).GT.BOT%X.OR.X(I+1).GT.BOT%X).AND.(X(I).LT.TOP%X.OR.X(I+1).LT.TOP%X).AND. &
         (Y(I).GT.BOT%Y.OR.Y(I+1).GT.BOT%Y).AND.(Y(I).LT.TOP%Y.OR.Y(I+1).LT.TOP%Y))THEN
       IF(IFORMAT.EQ.1)NINGEN =NINGEN+1
       CALL GLVERTEX3D(X(I)  ,Y(I),  Z(I))
       CALL GLVERTEX3D(X(I+1),Y(I+1),Z(I+1))
      ENDIF
     ENDDO
    CALL GLEND()

   ELSEIF(ITYPE.EQ.ID_POINT)THEN

    !## 2d-lines
    CALL GLBEGIN(GL_POINTS)
     DO I=1,NX-1
      IF((X(I).GT.BOT%X.OR.X(I+1).GT.BOT%X).AND.(X(I).LT.TOP%X.OR.X(I+1).LT.TOP%X).AND. &
         (Y(I).GT.BOT%Y.OR.Y(I+1).GT.BOT%Y).AND.(Y(I).LT.TOP%Y.OR.Y(I+1).LT.TOP%Y))THEN
       CALL GLVERTEX3D(X(I),Y(I),Z(I))
      ENDIF
     ENDDO
    CALL GLEND()

   ELSEIF(ITYPE.EQ.ID_RECTANGLE)THEN

    !## draw rectangle
    CALL GLBEGIN(GL_LINES) 
     CALL GLVERTEX3D(X(1),Y(1),Z(1)); CALL GLVERTEX3D(X(1),Y(2),Z(1))
     CALL GLVERTEX3D(X(1),Y(2),Z(1)); CALL GLVERTEX3D(X(2),Y(2),Z(1))
     CALL GLVERTEX3D(X(2),Y(2),Z(1)); CALL GLVERTEX3D(X(2),Y(1),Z(1))
     CALL GLVERTEX3D(X(2),Y(1),Z(1)); CALL GLVERTEX3D(X(1),Y(1),Z(1))
    CALL GLEND()

   ELSEIF(ITYPE.EQ.ID_CIRCLE)THEN

    CALL GLBEGIN(GL_LINE_LOOP)
    L=UTL_DIST(X(1),Y(1),X(2),Y(2))
    DO I=0,100
     A=(2.0D0*PI*REAL(I,8))/100.0D0
     XP=X(1)+COS(A)*L
     YP=Y(1)+SIN(A)*L
     CALL GLVERTEX3D(XP,YP,Z(1))
    ENDDO
    CALL GLEND()

   ENDIF

  ENDIF

 ENDDO

 DEALLOCATE(X,Y,Z); CLOSE(IU)

 CALL GLDISABLE(GL_COLOR_MATERIAL)
 CALL GLENDLIST()

 CALL WINDOWOUTSTATUSBAR(2,'')

 CALL IMOD3D_ERROR('IMOD3D_DRAWGEN')

 END SUBROUTINE IMOD3D_DRAWGEN

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SOL_ADD() 
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,II
 REAL(KIND=DP_KIND) :: XTOL
 CHARACTER(LEN=52) :: CDATE,FN
 INTEGER,DIMENSION(:,:),POINTER :: ICOMBINE
 INTEGER,DIMENSION(:),ALLOCATABLE :: TMPINT
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 
 IMOD3D_SOL_ADD=.FALSE.

 !## vertical tolerance (from menu)
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB6)
 CALL WDIALOGGETDOUBLE(IDF_REAL1,XTOL)
 IF(XTOL.LE.0.0D0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'It is not allowed to enter a Tolerance of '//TRIM(RTOS(XTOL,'G',5)),'Error')
  RETURN
 ENDIF

 !## maximum sample points for a fench-diagram (from menu)
 MXSAMPLING=1000

 !## not synchronizing of fench-diagram necessary
 ICCOL=0
 
 !## copy dimensions for profile-tool
 MXNIDF=NIDFLIST
        
 !## all idf in new-list storing idf-configuration
 ALLOCATE(PROFIDF(MXNIDF)); DO I=1,SIZE(PROFIDF); CALL IDFNULLIFY(PROFIDF(I)%IDF); ENDDO
 DO I=1,NIDFLIST
  IF(.NOT.IDFREAD(PROFIDF(I)%IDF,IDFPLOT(I)%FNAME,0))EXIT
  PROFIDF(I)%PRFTYPE=1
 ENDDO
      
 ALLOCATE(SERIE(MXNIDF))
 DO I=1,MXNIDF
  NULLIFY(SERIE(I)%X); NULLIFY(SERIE(I)%Y)
  ALLOCATE(SERIE(I)%X(MXSERIE),SERIE(I)%Y(MXSERIE))
 END DO

 !## start drawing a cross-section without those extra lines
 ALLOCATE(IEXIST(MXNIDF+1)  ,ICLEAN(MXNIDF+1)  ,IACT(MXNIDF+1), &
          XEXCLUDE(MXNIDF+1),ISEL_IDF(MXNIDF+1),DTOL(MXNIDF+1))
 
 !## common settings
 DTOL=XTOL; IEXIST=1; IACT=1; ICLEAN=1
 DO I=1,MXNIDF; XEXCLUDE(I+1)=PROFIDF(I)%IDF%NODATA; ENDDO
 DO I=1,MXNIDF; ISEL_IDF(I+1)=I; ENDDO

 !## set colour - equal to the colour assigned to the IDF files ...
 IF(.NOT.ALLOCATED(SLD))THEN
  CALL SOLID_INITSLD(1)
  CALL SOLID_INITSLDPOINTER(1,MXNIDF)
  DO I=1,SIZE(SLD); DO J=1,MXNIDF
   SLD(I)%INTCLR(J)=IDFPLOT(J)%ICOLOR
  ENDDO; ENDDO
 ENDIF
 
 !## create drawing list
 NTBSOL=NIDFLIST; ALLOCATE(ICOMBINE(NTBSOL,3)); ICOMBINE=0
 DO J=1,NTBSOL
  !## not to be processed
  IF(IDFPLOT(J)%ICUBE.EQ.5)CYCLE
  !## voxel, use colouring only
  IF(IDFPLOT(J)%ICUBE.EQ.3.OR.IDFPLOT(J)%ICUBE.EQ.8)THEN
   ICOMBINE(J,3)=J
   !## reset xclude value nodata
   XEXCLUDE(J+1)=PROFIDF(J)%IDF%NODATA-1.0D0
  ELSE
   ICOMBINE(J,1)=J
   ICOMBINE(J,2)=IDFPLOT(J)%ICOMBINE
   IF(IDFPLOT(J)%IDFLEGEND.NE.J)ICOMBINE(J,3)=IDFPLOT(J)%IDFLEGEND
  ENDIF
 ENDDO

 DO II=1,SIZE(NXYZCROSS)

  IF(NXYZCROSS(II).LE.1)CYCLE
  
  !## number of coordinates
  NXY=NXYZCROSS(II)
  IF(ASSOCIATED(XY))DEALLOCATE(XY); ALLOCATE(XY(2,NXY)); XY=0.0D0

  !## set coordinates of cross-section
  DO I=1,NXYZCROSS(II)
   XY(1,I)=XYZCROSS(I,II)%X
   XY(2,I)=XYZCROSS(I,II)%Y
  ENDDO

  !## compute profile through idf in 3D
  CALL PROFILE_COMPUTEPLOT()
 
  ISPF=NSOLLIST+1
  NSPF=ISPF

  !## add memory for cross-section
  CALL SOLID_PROFILEADD_SPFMEMORY(1.0D0,-1.0D0)
  !## fill in cross-section - including nodata
  CALL SOLID_PROFILEFITDRILL_CALC()
  
  SPF(ISPF)%ICOMBINE=ICOMBINE
  
  NSOLLIST=ISPF; CALL IMOD3D_SOL_DRAWINGLIST(ISPF,NSOLLIST,ICOMBINE)

  !## add cross-section name - check for duplicates
  WRITE(CDATE,'(I8,A)') UTL_GETCURRENTDATE(),'_'//TRIM(UTL_GETCURRENTTIME())
  !## replace ":"-signs
  DO; IF(INDEX(CDATE,':').GT.0)THEN
    CDATE=UTL_SUBST(CDATE,':','_')
   ELSE; EXIT; ENDIF
  ENDDO
  FN='CS_'//TRIM(CDATE); J=0; DO
   DO I=1,ISPF-1; IF(TRIM(SPF(I)%FNAME).EQ.TRIM(FN))EXIT; ENDDO   
   !## found correct name
   IF(I.GT.ISPF-1)EXIT
   J=J+1; FN='CS_'//TRIM(CDATE)//'['//TRIM(ITOS(J))//']'
  ENDDO
  SPF(ISPF)%FNAME=FN

  !## activate last created
  SOLPLOT(NSPF)%ISEL=1
  SOLPLOT(NSPF)%ICLIP=1

 ENDDO

 !## deallocate memory needed to compute profile
 CALL PROFILE_DEALLOCATE(); DEALLOCATE(ISEL_IDF,IACT,DTOL,ICLEAN,XEXCLUDE,IEXIST)
 IF(ISOLID_3D.NE.1)CALL SOLIDDEALLOCATESLD()

 !## close all files
 CALL UTL_CLOSEUNITS()

 !## add to the existing menu
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB6)
 ALLOCATE(TMPNAME(NSPF),TMPINT(NSPF))
 TMPINT=SOLPLOT%ISEL; TMPNAME=SPF%FNAME
 CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,NSPF,TMPINT)
 DEALLOCATE(TMPNAME,TMPINT)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,SOLPLOT(NSPF)%ICLIP)
 
 IF(NSPF.GE.SIZE(SOLPLOT))THEN
  CALL WDIALOGFIELDSTATE(ID_NEW,2)
  CALL WDIALOGFIELDSTATE(ID_LOAD,2)
 ENDIF
 IF(NSPF.GT.0)THEN
  CALL WDIALOGFIELDSTATE(ID_DELETE,1)
  CALL WDIALOGFIELDSTATE(ID_SAVEAS,1)
 ENDIF
 
 !## remove the drawn cross-section
 NXYZCROSS=0
 
 IMOD3D_SOL_ADD=.TRUE.

 END FUNCTION IMOD3D_SOL_ADD
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SOL_DELETE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,N
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
 
 IMOD3D_SOL_DELETE=.FALSE.

 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB6)
 N=NSPF; IF(.NOT.SOLID_PROFILEDELETE(ID_D3DSETTINGS_TAB6,N,SOLPLOT%ISEL))RETURN

 !## shift drawing list indices
 NSOLLIST=0; DO I=1,N 

  !## remove drawing list
  IF(SOLPLOT(I)%ISEL.EQ.1)THEN
   DO J=1,2
    IF(SOLLISTINDEX(I,J).NE.0)THEN
     IF(GLISLIST(SOLLISTINDEX(I,J)))CALL GLDELETELISTS(SOLLISTINDEX(I,J),1_GLSIZEI)
     SOLLISTINDEX(I,J)=0_GLUINT
    ENDIF
   ENDDO
   CYCLE
  ENDIF

  NSOLLIST=NSOLLIST+1
  
  DO J=1,2; SOLLISTINDEX(NSOLLIST,J)=SOLLISTINDEX(I,J); ENDDO
  SOLPLOT(NSOLLIST)=SOLPLOT(I)
 
 ENDDO
  
 !## add to the existing menu
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB6)

 IF(NSPF.LT.SIZE(SOLPLOT))THEN
  CALL WDIALOGFIELDSTATE(ID_NEW,1)
  CALL WDIALOGFIELDSTATE(ID_LOAD,1)
 ENDIF
 IF(NSPF.GT.0)THEN
  ALLOCATE(TMPNAME(NSPF),TMPINT(NSPF))
  TMPNAME=SPF%FNAME
  TMPINT=SOLPLOT%ISEL
  CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,NSPF,TMPINT)
  DEALLOCATE(TMPNAME,TMPINT)
 ELSE
  CALL WDIALOGCLEARFIELD(IDF_MENU1)
 ENDIF

 CALL WDIALOGFIELDSTATE(ID_DELETE,0)
 CALL WDIALOGFIELDSTATE(ID_SAVEAS,0)

 IMOD3D_SOL_DELETE=.TRUE.

 END FUNCTION IMOD3D_SOL_DELETE
 
 !###======================================================================
 SUBROUTINE IMOD3D_SOL_SAVE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,N
 CHARACTER(LEN=256) :: DIR
 INTEGER,DIMENSION(:,:),POINTER :: ICOMBINE
 
 DIR=TRIM(PREFVAL(1))//'\TMP\'

 DO I=1,SIZE(SOLPLOT)
  IF(SOLPLOT(I)%ISEL.EQ.1)THEN
   !## create drawing list
   N=SIZE(SPF(I)%PROF); ALLOCATE(ICOMBINE(N,3)); ICOMBINE=0
   DO J=1,N
    ICOMBINE(J,1)=SPF(I)%ICOMBINE(J,1)
    ICOMBINE(J,2)=SPF(I)%ICOMBINE(J,2)
    ICOMBINE(J,3)=SPF(I)%ICOMBINE(J,3)
!    !## not to be processed
!    IF(IDFPLOT(J)%ICUBE.EQ.5)CYCLE
!    !## voxel, use colouring only
!    IF(IDFPLOT(J)%ICUBE.EQ.3.OR.IDFPLOT(J)%ICUBE.EQ.8)THEN
!     ICOMBINE(J,3)=J
!    ELSE
!     ICOMBINE(J,1)=J
!     ICOMBINE(J,2)=IDFPLOT(J)%ICOMBINE
!     IF(IDFPLOT(J)%IDFLEGEND.NE.J)ICOMBINE(J,3)=IDFPLOT(J)%IDFLEGEND
!    ENDIF
   ENDDO
   IF(.NOT.SOLIDOPENSPF(I,'W',DIR,ICOMBINE=ICOMBINE))RETURN
   DEALLOCATE(ICOMBINE)
  ENDIF
 ENDDO
 
 CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'The selected fence diagrams are saved in the folder:'//CHAR(13)// &
  TRIM(DIR)//'\*.SPF','Information')
 
 END SUBROUTINE IMOD3D_SOL_SAVE

 !###======================================================================
 SUBROUTINE IMOD3D_SPF_LOAD()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,NF,II,N,M
 CHARACTER(LEN=10000) :: FNAME,FLIST
 CHARACTER(LEN=256),ALLOCATABLE,DIMENSION(:) :: FNAMES
 INTEGER,DIMENSION(:,:),POINTER :: ICOMBINE=>NULL()
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: TMPNAME
 INTEGER,ALLOCATABLE,DIMENSION(:) :: TMPINT
 
 IF(.NOT.UTL_WSELECTFILE('All Known Files (*.spf;*.gen)|*.spf;*.gen|Load iMOD Solid Profile File (*.spf)|*.spf|Load iMOD GEN file (*.gen)|*.gen|',      &
                   LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+MULTIFILE,FNAME,&
                   'Load iMOD Solid Profile File (*.spf,*.gen)'))RETURN
                   
 K=INDEX(FNAME,CHAR(0))
 IF(K.GT.0)THEN
  FLIST=FNAME
  NF=0
  I=K+1
  DO
   J=INDEX(FLIST(I:),CHAR(0))
   NF=NF+1
   IF(J.EQ.0)EXIT
   I=I+J
  END DO
 ELSE
  NF=1
 ENDIF

 ALLOCATE(FNAMES(NF))
 DO II=1,NF
  !## construct new name in multi-file selection mode
  IF(NF.GT.1)THEN
   I=INDEX(FLIST,CHAR(0))+1
   DO K=1,II-1
    J=INDEX(FLIST(I:),CHAR(0))
    I=I+J
   END DO
   J=INDEX(FLIST(I:),CHAR(0))
   K=INDEX(FLIST,CHAR(0))-1
   IF(J.EQ.0)THEN
    FNAMES(II)=FLIST(:K)//'\'//FLIST(I:)
   ELSE
    J=J+I
    FNAMES(II)=FLIST(:K)//'\'//FLIST(I:J-1)
   ENDIF
   J=INDEXNOCASE(FNAMES(II),CHAR(0),.TRUE.)
   IF(J.GT.0)FNAMES(II)=FNAMES(II)(:J-1)
  ELSE
   FNAMES(II)=FNAME
  ENDIF
  FNAMES(II)=UTL_CAP(FNAMES(II),'U')
 ENDDO

 N=SIZE(SPF)
 M=MIN(N,NSPF+NF)
 !## read maximal cross-section which is possible
 J=0
 DO I=NSPF+1,M
  !## read cross-section information
  J=J+1
  SPF(I)%FNAME=FNAMES(J)(:INDEX(FNAMES(J),'.',.TRUE.)-1)
  !## spf-file?
  IF(INDEX(FNAMES(J),'.SPF').GT.0)THEN
   IF(.NOT.SOLIDOPENSPF(I,'R','',ICOMBINE=ICOMBINE))EXIT
   SPF(I)%FNAME=SPF(I)%FNAME(INDEX(SPF(I)%FNAME,'\',.TRUE.)+1:)
   SOLPLOT(I)%ISEL=1
   SOLPLOT(I)%ICLIP=1
   !## create drawing list
   IF(ASSOCIATED(SPF(I)%ICOMBINE))DEALLOCATE(SPF(I)%ICOMBINE)
   ALLOCATE(SPF(I)%ICOMBINE(SIZE(ICOMBINE,1),SIZE(ICOMBINE,2)))
   SPF(I)%ICOMBINE=ICOMBINE
   CALL IMOD3D_SOL_DRAWINGLIST(I,I,ICOMBINE)
   NSPF=NSPF+1
  ELSE
   IF(.NOT.IMOD3D_FENCEADDFROMFILE(FNAMES(J)))EXIT 
  ENDIF
  
 END DO

 DEALLOCATE(FNAMES)
 IF(ASSOCIATED(ICOMBINE))DEALLOCATE(ICOMBINE)

 !## new number of cross-sections
 NSOLLIST=NSPF

 !## read, process and stick bitmaps to cross-sections
 IF(IMOD3D_SOL_BMP())THEN; ENDIF

 !## add to the existing menu
 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB6)
 ALLOCATE(TMPNAME(NSPF),TMPINT(NSPF)); TMPNAME=SPF%FNAME; TMPINT=SOLPLOT%ISEL
 CALL WDIALOGPUTMENU(IDF_MENU1,TMPNAME,NSPF,TMPINT) 
 DEALLOCATE(TMPNAME,TMPINT)
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK4,SOLPLOT(NSPF)%ICLIP)
 
 IF(NSPF.GE.SIZE(SOLPLOT))THEN
  CALL WDIALOGFIELDSTATE(ID_NEW,2)
  CALL WDIALOGFIELDSTATE(ID_LOAD,2)
 ENDIF
 IF(NSPF.GT.0)THEN
  CALL WDIALOGFIELDSTATE(ID_DELETE,1)
  CALL WDIALOGFIELDSTATE(ID_SAVEAS,1)
 ENDIF

 END SUBROUTINE IMOD3D_SPF_LOAD
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_FENCEADDFROMFILE(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER :: I,J,K
 
 IMOD3D_FENCEADDFROMFILE=.FALSE.
 
 CALL POLYGON1INIT()
 CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,FNAME,'GEN') 

 IF(SIZE(XYZCROSS,1).LE.SHP%NPOL.OR. &
    SIZE(XYZCROSS,2).LE.MAXVAL(SHP%POL%N))THEN
  DEALLOCATE(XYZCROSS,NXYZCROSS)
  ALLOCATE(XYZCROSS(SHP%NPOL,MAXVAL(SHP%POL%N)),NXYZCROSS(SHP%NPOL))
 ENDIF
 NXYZCROSS=0
 
 K=0; DO I=1,SHP%NPOL
  SELECT CASE (SHP%POL(I)%ITYPE)
   CASE (ID_LINE)
    K=K+1; NXYZCROSS(K)=0
    DO J=1,SHP%POL(I)%N 
     !## add current point to list of points
     NXYZCROSS(K)=NXYZCROSS(K)+1
     XYZCROSS(J,K)%X=SHP%POL(I)%X(J)
     XYZCROSS(J,K)%Y=SHP%POL(I)%Y(J)
    ENDDO
   CASE (ID_POLYGON)
    K=K+1; NXYZCROSS(K)=0
    DO J=1,SHP%POL(I)%N 
     !## add current point to list of points
     NXYZCROSS(K)=NXYZCROSS(K)+1
     XYZCROSS(J,K)%X=SHP%POL(I)%X(J)
     XYZCROSS(J,K)%Y=SHP%POL(I)%Y(J)
    ENDDO
    NXYZCROSS(K)=NXYZCROSS(K)+1
    XYZCROSS(J,K)%X=SHP%POL(I)%X(1)
    XYZCROSS(J,K)%Y=SHP%POL(I)%Y(1)
   CASE (ID_RECTANGLE)
    K=K+1; NXYZCROSS(K)=0
    NXYZCROSS(K)=5
    XYZCROSS(1,K)%X=SHP%POL(I)%X(1)
    XYZCROSS(1,K)%Y=SHP%POL(I)%Y(1)
    XYZCROSS(2,K)%X=SHP%POL(I)%X(1)
    XYZCROSS(2,K)%Y=SHP%POL(I)%Y(2)
    XYZCROSS(3,K)%X=SHP%POL(I)%X(2)
    XYZCROSS(3,K)%Y=SHP%POL(I)%Y(2)
    XYZCROSS(4,K)%X=SHP%POL(I)%X(2)
    XYZCROSS(4,K)%Y=SHP%POL(I)%Y(1)
    XYZCROSS(5,K)%X=SHP%POL(I)%X(1)
    XYZCROSS(5,K)%Y=SHP%POL(I)%Y(1)
   CASE DEFAULT
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You cannot load in CIRCLE and/or POINTS as fence-diagrams, these will be skipped','Error')
    CYCLE
  END SELECT   
 ENDDO
 
 CALL POLYGON1CLOSE()
 IF(K.GT.0)THEN
  IMOD3D_FENCEADDFROMFILE=IMOD3D_SOL_ADD()
 ENDIF 
 
 END FUNCTION IMOD3D_FENCEADDFROMFILE

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SOL()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,N
 INTEGER,DIMENSION(:,:),POINTER :: ICOMBINE
 
 IMOD3D_SOL=.TRUE.

 !## solid active, although loaded in memory (could be)
 IF(ISOLID_3D.EQ.0)RETURN

 IF(NSOLLIST.EQ.0)RETURN

 IMOD3D_SOL=.FALSE.

 !## get display-list pointers
 SOLLISTINDEX=0

 !## process each spf-(file)
 NSOLLIST=0
 DO I=1,NSPF
  NSOLLIST=NSOLLIST+1
  N=SIZE(SPF(I)%PROF); ALLOCATE(ICOMBINE(N,3)); ICOMBINE=0
  ALLOCATE(SPF(I)%ICOMBINE(N,3))
  DO J=1,N-1
   ICOMBINE(J,1)=J
   ICOMBINE(J,2)=J+1
   ICOMBINE(J,3)=0
   SPF(I)%ICOMBINE(J,1)=ICOMBINE(J,1)
   SPF(I)%ICOMBINE(J,2)=ICOMBINE(J,2)
   SPF(I)%ICOMBINE(J,3)=ICOMBINE(J,3)
  ENDDO
  CALL IMOD3D_SOL_DRAWINGLIST(I,NSOLLIST,ICOMBINE)
  DEALLOCATE(ICOMBINE)
 ENDDO

 CALL WINDOWOUTSTATUSBAR(2,'')

 !## read, process and stick bitmaps to cross-sections
 IMOD3D_SOL=IMOD3D_SOL_BMP()
 !## read background again if this has been updated
 IREADBMP=0
 
 CALL IMOD3D_ERROR('IMOD3D_SOL')

 END FUNCTION IMOD3D_SOL

 !###======================================================================
 SUBROUTINE IMOD3D_SOL_DRAWINGLIST(I,ISOL,ICOMBINE)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=SP_KIND),PARAMETER :: MINT=TINY(1.0)
 INTEGER,INTENT(IN) :: ISOL,I
 INTEGER,INTENT(IN),DIMENSION(:,:),POINTER :: ICOMBINE
 REAL(KIND=GLDOUBLE) :: DXX,DYY,GX,GY,GZ,DXY 
 INTEGER :: J,K,II,JJ,KK,JPROF,IPOS,N,I1,I2,IICLR,IA
 INTEGER,DIMENSION(3) :: IPROF
 REAL(KIND=GLDOUBLE),DIMENSION(4) :: X,Y,XCOR,YCOR,Z
 REAL(KIND=GLDOUBLE),DIMENSION(2) :: TX
 REAL(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: XT
 REAL(KIND=DP_KIND),DIMENSION(:,:),ALLOCATABLE :: ZT,IT
 INTEGER,DIMENSION(:),ALLOCATABLE :: TT
 REAL(KIND=DP_KIND),PARAMETER :: NODATA_Z=-999.99D0
 LOGICAL :: GOFORIT,LSOLID
 
 !## list index for
 SOLLISTINDEX(ISOL,1)=GLGENLISTS(1)
 !## start new drawing list
 CALL GLNEWLIST(SOLLISTINDEX(ISOL,1),GL_COMPILE)

 !## process each cross-section (nidf) --- two-by-two
 DO JPROF=1,SIZE(SPF(I)%PROF) 
 
  !## first interval
  IPROF(1)=ICOMBINE(JPROF,1)
  IF(IPROF(1).NE.0)THEN
   IF(SPF(I)%PROF(IPROF(1))%NPOS.LE.0)IPROF(1)=0
  ENDIF
  
  !## second interval
  IPROF(2)=ICOMBINE(JPROF,2)
  IF(IPROF(2).NE.0)THEN
   IF(SPF(I)%PROF(IPROF(2))%NPOS.LE.0)IPROF(2)=0
  ENDIF
  
  !## use other interface if one of the two is not defined
  IF(IPROF(1).EQ.0)IPROF(1)=IPROF(2)
  IF(IPROF(2).EQ.0)IPROF(2)=IPROF(1)

  !## colouring in intermediate profile
  IPROF(3)=ICOMBINE(JPROF,3)
  IF(IPROF(3).NE.0)THEN
   IF(SPF(I)%PROF(IPROF(3))%NPOS.LE.0)IPROF(3)=0
  ENDIF
  
  !## skip this one
  IF(SUM(IPROF).LE.0)CYCLE

  !## make sure xt has a small offset (except for xt=0.0D0)
  TX(1)=0.0D0
  DO J=2,SPF(I)%NXY
   DXY=UTL_DIST(SPF(I)%X(J),SPF(I)%Y(J),SPF(I)%X(J-1),SPF(I)%Y(J-1))
   TX(1)=TX(1)+DXY
  ENDDO
  !## minimal offset = fraction of total distance
  DXX=TX(1)/1000.0D0

  N=0
  IF(IPROF(1).GT.0)N=N+SPF(I)%PROF(IPROF(1))%NPOS
  IF(IPROF(2).GT.0)N=N+SPF(I)%PROF(IPROF(2))%NPOS
  IF(IPROF(3).GT.0)N=N+SPF(I)%PROF(IPROF(3))%NPOS
  N=N+SPF(I)%NXY-2

  !## allocate enough memory to add intermediate places
  N=N*2
  
  ALLOCATE(XT(N),ZT(N,3),IT(N,3),TT(N))
  
  XT=0.0D0
  IT=-999.0D0
  ZT=NODATA_Z
  IPOS=0
  II  =0
  DO KK=1,3
   II=II+1
   K=IPROF(KK); IF(K.EQ.0)CYCLE
   !## create table with distances and z-values for top/bot of current iprof-layer
   DO J=1,SPF(I)%PROF(K)%NPOS
    IPOS=IPOS+1
    IF(J.EQ.1)THEN
     XT(IPOS)=SPF(I)%PROF(K)%PX(J)
    ELSE
     XT(IPOS)=MAX(XT(IPOS-1)+DXX,SPF(I)%PROF(K)%PX(J))
    ENDIF
    ZT(IPOS,II)=SPF(I)%PROF(K)%PZ(J)
    !## save pointer whether the cross-sections start of stop after or before nodata
    IT(IPOS,II)=REAL(SPF(I)%PROF(K)%IT(J),8)
   ENDDO
  END DO

!  DO J=1,N
!   WRITE(*,'(I10,3F10.1,4F10.2)') J,(IT(J,K),K=1,3),XT(J),(ZT(J,K),K=1,3)
!  ENDDO
!  WRITE(*,*)
  
  !## include knickpoints
  TX(1)=0.0D0
  DO J=2,SPF(I)%NXY-1
   DXY=UTL_DIST(SPF(I)%X(J),SPF(I)%Y(J),SPF(I)%X(J-1),SPF(I)%Y(J-1))
   TX(1)     =TX(1)+DXY
   IPOS      =IPOS+1
   XT(IPOS)  =TX(1)
   DO K=1,3
    IF(IPROF(K).GT.0)THEN
     ZT(IPOS,K)=NODATA_Z !## to be filled in later
    ENDIF
   ENDDO
!   IF(IPROF(1).GT.0)ZT(IPOS,1)=NODATA_Z !## to be filled in later
!   IF(IPROF(2).GT.0)ZT(IPOS,2)=NODATA_Z !## to be filled in later
!   IF(IPROF(3).GT.0)ZT(IPOS,3)=NODATA_Z !## to be filled in later
  ENDDO
  N=IPOS
 
  !## sort distances and z- and pointer values
  CALL QKSORT(N,XT,V2=ZT(:,1),V3=ZT(:,2),V4=ZT(:,3),V5=IT(:,1),V6=IT(:,2),V7=IT(:,3))
    
!  DO J=1,N
!   WRITE(*,'(I10,3F10.1,4F10.2)') J,(IT(J,K),K=1,3),XT(J),(ZT(J,K),K=1,3)
!  ENDDO
!  WRITE(*,*)

  !## fill first and last
  DO K=1,3 
   !## skip missing interfaces
   IF(IPROF(K).EQ.0)CYCLE
   IF(ZT(1,K).EQ.NODATA_Z)THEN
    DO J=2,N
     IF(ZT(J,K).NE.NODATA_Z)THEN
      ZT(1,K)=ZT(J,K)
      EXIT
     ENDIF
    ENDDO
   ENDIF
   IF(ZT(N,K).EQ.NODATA_Z)THEN
    DO J=N-1,1,-1
     IF(ZT(J,K).NE.NODATA_Z)THEN
      ZT(N,K)=ZT(J,K)
      EXIT
     ENDIF
    ENDDO
   ENDIF
  ENDDO
   
  !## interpolate unknown values
  DO J=1,N
   DO K=1,3
   !## skip missing interfaces
    IF(IPROF(K).EQ.0)CYCLE

    IF(ZT(J,K).EQ.NODATA_Z)THEN
     DO I1=J-1,1,-1; IF(ZT(I1,K).NE.NODATA_Z)EXIT; ENDDO
     DO I2=J+1,N;    IF(ZT(I2,K).NE.NODATA_Z)EXIT; ENDDO
     GZ=0.0D0
     IF(XT(I2)-XT(I1).NE.0.0D0)GZ=(ZT(I2,K)-ZT(I1,K))/(XT(I2)-XT(I1))
     ZT(J,K)=ZT(I1,K)+GZ*(XT(J)-XT(I1))
     !## initiate a nodata value for the pointer
     IT(J,K)=-999.0D0
    ENDIF

   END DO
  ENDDO
  
  !## copy for duplicate points the correct pointer value
  DO II=1,3
   IF(IPROF(II).EQ.0)CYCLE
   DO K=1,N
    IF(IT(K,II).NE.-999.0D0)CYCLE
    DO J=1,N
     IF(K.EQ.J)CYCLE
     IF(XT(K).EQ.XT(J))THEN
      IF(IT(J,II).NE.-999.0D0)IT(K,II)=IT(J,II)
     ENDIF
    ENDDO
   ENDDO
  ENDDO
  
  !## remove doubles
  K=1
  DO J=2,N
   IF(XT(K).NE.XT(J))THEN
    K=K+1
    IF(K.NE.J)THEN
     XT(K)=XT(J)
     DO II=1,3
      IF(IPROF(II).GT.0)THEN; ZT(K,II)=ZT(J,II); IT(K,II)=IT(J,II); ENDIF
     ENDDO
    ENDIF
   ENDIF
  END DO
  !## number of unique points in table
  N=K

  !## fill in appropriate after interpolation
  DO K=1,3
   IA=0
   DO J=1,N
    !## turn on
    IF(IT(J,K).EQ.-1.0D0)IA=1
    IF(IA.EQ.1)THEN
     IF(IT(J,K).EQ.-999.0D0)IT(J,K)=0.0D0
    ELSE
     IT(J,K)=-999.0D0
    ENDIF
    !## turn off
    IF(IT(J,K).EQ.1.0D0)IA=0
   ENDDO
  ENDDO
  
!  DO J=1,N
!   WRITE(*,'(I10,3F10.1)') J,(IT(J,K),K=1,3)
!  ENDDO
!  WRITE(*,*) 
  
  !## correct for knickpoints - continue cross-section
  DO J=1,N-2
   DO K=1,3
    IF(IT(J,K).EQ.1.0D0.AND.IT(J+1,K).EQ.-999.0D0.AND.IT(J+2,K).EQ.-1.0D0)THEN
     IT(J,K)=0.0D0
     IT(J+1,K)=0.0D0
     IT(J+2,K)=0.0D0
    ENDIF
   ENDDO
  ENDDO

!  !## remove subsequent entries of 1 and -1
!  DO I=1,3
!   DO J=1,N-1
!    IF(IT(J,I).
!   ENDDO
!  ENDDO
  
  !## define tt as a function of it
  TT=-999
  !## voxel model
  IF(IPROF(1).EQ.0.AND.IPROF(2).EQ.0)THEN
   DO J=1,N
    IF(IPROF(3).NE.0)TT(J)=IT(J,3) !LSOLID=IT(J,3).GT.-900.0D0
   ENDDO
  ELSE
   DO J=1,N
    LSOLID=.FALSE.; IF(IT(J,1).GT.-900.0D0.AND.IT(J,2).GT.-900.0D0)LSOLID=.TRUE.
    IF(IPROF(3).NE.0.AND.LSOLID)LSOLID=IT(J,3).GT.-900.0D0
    IF(LSOLID)THEN
     TT(J)=1 
     IF(IT(J,1).EQ.IT(J,2))TT(J)=IT(J,1)
     IF(IPROF(3).NE.0)THEN
      IF(TT(J).EQ.0)TT(J)=IT(J,3) 
     ENDIF
    ENDIF
   ENDDO
  ENDIF
  
  DO J=1,N
   !## set start
   IF(J.EQ.1)THEN
    IF(TT(J).EQ.1)TT(J)=-1 
   ELSE
    IF(TT(J-1).EQ.-999.AND.TT(J).EQ.1)TT(J)=-1 !## start
   ENDIF
   !## set end
   IF(J.EQ.N)THEN
    IF(TT(J).EQ.1)TT(J)= 2
   ELSE
    IF(TT(J+1).EQ.-999.AND.TT(J).EQ.1)TT(J)= 2 
    IF(TT(J).EQ.1)                    TT(J)= 2 
   ENDIF
  ENDDO
  
!  DO J=1,N
!   WRITE(*,'(2I10,3F10.1,4F10.2)') J,TT(J),(IT(J,K),K=1,3),XT(J),(ZT(J,K),K=1,3)
!  ENDDO
!  WRITE(*,*)

!  !## overrule start
!  XT(1)=0.0D0
!  !## overrule end
!  DXY=0.0D0; DO J=2,SPF(I)%NXY 
!   DXY=DXY+UTL_DIST(SPF(I)%X(J),SPF(I)%Y(J),SPF(I)%X(J-1),SPF(I)%Y(J-1))
!  ENDDO
!  XT(N)=DXY
  
  !## for each (interpolated) coordinate
  GOFORIT=.FALSE.; IF(TT(1).EQ.-1)GOFORIT=.TRUE.
  DO IPOS=2,N

   !## determine whether to display current segment
   IF(.NOT.GOFORIT)THEN
    IF(TT(IPOS).EQ.-1)GOFORIT=.TRUE. 
    CYCLE
   ENDIF
   
   !## next segment is inactive   
   IF(TT(IPOS).EQ.2)GOFORIT=.FALSE.
   
   !## assign coordinate and z-values to knickpoints
   TX=0.0D0
   DO J=2,SPF(I)%NXY 
    DXY=UTL_DIST(SPF(I)%X(J),SPF(I)%Y(J),SPF(I)%X(J-1),SPF(I)%Y(J-1))
    !## segment length is zero, skip it
    IF(DXY.LE.0.0D0)CYCLE

    DXX=SPF(I)%X(J)-SPF(I)%X(J-1); DYY=SPF(I)%Y(J)-SPF(I)%Y(J-1) 
    GX=DXX/DXY; GY=DYY/DXY; TX(2)=TX(1)+DXY

    !## between interval or in last interval
    IF(XT(IPOS).GE.TX(1).AND.XT(IPOS).LE.TX(2).OR. &
       J.EQ.SPF(I)%NXY)THEN

     !## llc
     X(1)=SPF(I)%X(J-1)+GX*(XT(IPOS-1)-TX(1))
     Y(1)=SPF(I)%Y(J-1)+GY*(XT(IPOS-1)-TX(1))
     IF(IPROF(1).NE.0)THEN
      Z(2)=ZT(IPOS-1,1) 
     ELSE
      Z(2)=IDFPLOT(IPROF(3))%ZMAX
     ENDIF
     !## ulc
     X(2)=X(1)
     Y(2)=Y(1)
     IF(IPROF(2).NE.0)THEN
      Z(1)=ZT(IPOS-1,2)
     ELSE
      Z(1)=IDFPLOT(IPROF(3))%ZMIN
     ENDIF

     !## urc
     X(3)=SPF(I)%X(J-1)+GX*(XT(IPOS)-TX(1))
     Y(3)=SPF(I)%Y(J-1)+GY*(XT(IPOS)-TX(1))
     IF(IPROF(1).NE.0)THEN
      Z(3)=ZT(IPOS,1)
     ELSE
      Z(3)=IDFPLOT(IPROF(3))%ZMAX
     ENDIF
     !## lrc
     X(4)=X(3)
     Y(4)=Y(3)
     IF(IPROF(2).NE.0)THEN
      Z(4)=ZT(IPOS,2)
     ELSE
      Z(4)=IDFPLOT(IPROF(3))%ZMIN
     ENDIF
     
     !## if inside current viewable domain, add to OpenGL-statement
     IF((X(1).GT.BOT%X.OR.X(3).GT.BOT%X).AND.(X(1).LT.TOP%X.OR.X(3).LT.TOP%X).AND. &
        (Y(1).GT.BOT%Y.OR.Y(3).GT.BOT%Y).AND.(Y(1).LT.TOP%Y.OR.Y(3).LT.TOP%Y))THEN

      !## correct x/y for current viewable ratios
      XCOR(1)=X(1);    YCOR(1)=Y(1)
      XCOR(2)=XCOR(1); YCOR(2)=YCOR(1)
      XCOR(3)=X(3);    YCOR(3)=Y(3)
      XCOR(4)=XCOR(3); YCOR(4)=YCOR(3)

      !## colour by voxel value
      IF(IPROF(3).GT.0)THEN
       !## this can happen if spf files are read with different icombine that currenlty in 3D Tool
       IF(SIZE(IDFPLOT).LT.IPROF(3))THEN
        IICLR=WRGB(255,0,0)
       ELSE
        IICLR=UTL_IDFGETCLASS(IDFPLOT(IPROF(3))%LEG,ZT(IPOS-1,3))
!        IICLR=UTL_IDFGETCLASS(IDFPLOT(IPROF(3))%LEG,ZT(IPOS,3))
       ENDIF
      ELSE
       !## get color for z-mean between two segments
       IF(ALLOCATED(SLD))THEN
        IF(SIZE(SLD(1)%INTCLR).GE.IPROF(1))THEN
         IICLR=SLD(1)%INTCLR(IPROF(1))
        ELSE
         IICLR=SPF(I)%PROF(JPROF)%ICLR
        ENDIF
       ELSE
        IICLR=SPF(I)%PROF(JPROF)%ICLR
       ENDIF
      ENDIF
      SPF(I)%PROF(JPROF)%ICLR=IICLR
      
      !## skip white ...
      IF(IICLR.NE.WRGB(255,255,255))THEN

       CALL IMOD3D_SETCOLOR(IICLR) !## include alpha
       !## show shaded surface
       CALL IMOD3D_RETURNCOLOR(IICLR,AMBIENT)

       CALL GLMATERIALFV(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE,AMBIENT)

       !## begin OpenGL-Quads       
       CALL GLBEGIN(GL_QUADS)
        CALL IMOD3D_SETNORMALVECTOR(XCOR(1),YCOR(1),Z(1),XCOR(2),YCOR(2),Z(2),XCOR(3),YCOR(3),Z(3))
        DO JJ=1,4; CALL GLVERTEX3D(XCOR(JJ),YCOR(JJ),Z(JJ)); ENDDO
        !## end OpenGL-Quads
       CALL GLEND()

       !## begin OpenGL-LINES
       CALL IMOD3D_SETCOLOR(WRGB(10,10,10))
       CALL GLLINEWIDTH(1.0_GLFLOAT)
       CALL GLBEGIN(GL_LINES)
        CALL GLVERTEX3D(XCOR(2),YCOR(2),Z(2))
        CALL GLVERTEX3D(XCOR(3),YCOR(3),Z(3))
       CALL GLEND()
      
      ENDIF
      
      !## draw bottom (only for the last)
      IF(JPROF.EQ.SIZE(SPF(I)%PROF)-1)THEN

       !## show interfaces
       IF(IPROF(3).GT.0)THEN
        IICLR=UTL_IDFGETCLASS(IDFPLOT(IPROF(3))%LEG,ZT(IPOS-1,3))
!        IICLR=UTL_IDFGETCLASS(IDFPLOT(IPROF(3))%LEG,ZT(IPOS,3))
        SPF(I)%PROF(IPROF(3))%ICLR=IICLR
       ELSE
        IICLR=SPF(I)%PROF(IPROF(2))%ICLR
       ENDIF

       !## skip white ...
       IF(IICLR.NE.WRGB(255,255,255))THEN

        CALL IMOD3D_SETCOLOR(IICLR)

        CALL GLBEGIN(GL_LINES)
        CALL GLVERTEX3D(XCOR(1),YCOR(1),Z(1))
        CALL GLVERTEX3D(XCOR(4),YCOR(4),Z(4))
        CALL GLEND()
       ENDIF
      
      ENDIF
                    
     ENDIF
     TX(1)=TX(2)
     EXIT
    ENDIF
    TX(1)=TX(2)
   ENDDO
  ENDDO     

  DEALLOCATE(XT,ZT,IT,TT)

 ENDDO
  
 !## OpenGL-drawing list
 CALL GLENDLIST()

 END SUBROUTINE IMOD3D_SOL_DRAWINGLIST 
 
 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SOL_BMP() 
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE) :: X1,X2,Y1,Y2,XT1,XT2,YT1,YT2,BZ1,BZ2,BX1,BX2,BDX,BDY,DXX,DYY,DXY,TDX
 INTEGER :: I,J
 
 IMOD3D_SOL_BMP=.FALSE.

 !## fill display current bitmap

 NSOLLIST=0
 DO I=1,NSPF
  NSOLLIST=NSOLLIST+1
  SOLLISTINDEX(NSOLLIST,2)=0
!  SOLLISTINDEX(NSOLLIST,3)=0
  IF(SPF(I)%PBITMAP%IACT.EQ.0)CYCLE
  
!  !## skip whenever interfaces need to be drawn
!  IF(SOLPLOT(NSOLLIST)%IINTERFACE.EQ.1)THEN; SOLPLOT(NSOLLIST)%IBITMAP=0; CYCLE; ENDIF
  
  !## list index for
  SOLLISTINDEX(NSOLLIST,2)=GLGENLISTS(1)
!  SOLLISTINDEX(NSOLLIST,3)=GLGENLISTS(1)
!  IF(SOLLISTINDEX(NSOLLIST,3).NE.0)CALL GLDELETELISTS(SOLLISTINDEX(NSOLLIST,3),1_GLSIZEI)
  IF(SOLLISTINDEX(NSOLLIST,2).NE.0)CALL GLDELETELISTS(SOLLISTINDEX(NSOLLIST,2),1_GLSIZEI)
  !## start new drawing list
!  CALL GLNEWLIST(SOLLISTINDEX(NSOLLIST,3),GL_COMPILE)
  CALL GLNEWLIST(SOLLISTINDEX(NSOLLIST,2),GL_COMPILE)

  !## read in bitmap and bind it to a texture
  IF(.NOT.IMOD3D_SOL_BMP_LOAD(I))EXIT

  !## turns on texturing
  CALL GLENABLE(GL_TEXTURE_2D)
  !## repeating texture in both directions
  CALL GLTEXPARAMETERI(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S, GL_REPEAT)
  CALL GLTEXPARAMETERI(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T, GL_REPEAT)
  !## magnification and minification method
  CALL GLTEXPARAMETERI(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST)
  CALL GLTEXPARAMETERI(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST)
  !## hint to compute perspective correction
  CALL GLHINT(GL_PERSPECTIVE_CORRECTION_HINT,GL_FASTEST)

  BX1=SPF(I)%PBITMAP%GX1 !## minx
  BX2=SPF(I)%PBITMAP%GX2 !## maxx
  BZ1=SPF(I)%PBITMAP%GY1 !## minz
  BZ2=SPF(I)%PBITMAP%GY2 !## maxz
  BDX=BX2-BX1
  BDY=BZ2-BZ1
  
  !## error in image position - skip it
  IF(BDX.LE.0.0D0.OR.BDY.GE.0.0D0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot display '//TRIM(SPF(I)%PBITMAP%FNAME)//CHAR(13)// &
    'Probably you have misplaced the image','Error')
   CYCLE
  ENDIF
      
  TDX=0.0_GLDOUBLE
  DO J=2,SPF(I)%NXY 
   DXX=SPF(I)%X(J)-SPF(I)%X(J-1); DYY=SPF(I)%Y(J)-SPF(I)%Y(J-1)
   DXY=DXX**2.0D0+DYY**2.0D0; IF(DXY.NE.0.0D0)DXY=SQRT(DXY)
   !## skip distances of zero
   IF(DXY.EQ.0.0D0)CYCLE
   
   X1=SPF(I)%X(J-1)
   X2=SPF(I)%X(J)  
   Y1=SPF(I)%Y(J-1)
   Y2=SPF(I)%Y(J)

   !## compute texture fractions
   XT1=(TDX-BX1)/BDX
   TDX= TDX+DXY
   XT2=(TDX-BX1)/BDX

   YT1=0.0_GLDOUBLE
   YT2=1.0_GLDOUBLE
   
   !## connect 2d texture to 3d object (in this case top of cube)
   CALL GLBEGIN(GL_QUADS)
    CALL GLTEXCOORD2D(XT1,YT1); CALL GLVERTEX3D(X1,Y1,BZ2)
    CALL GLTEXCOORD2D(XT1,YT2); CALL GLVERTEX3D(X1,Y1,BZ1)
    CALL GLTEXCOORD2D(XT2,YT2); CALL GLVERTEX3D(X2,Y2,BZ1)
    CALL GLTEXCOORD2D(XT2,YT1); CALL GLVERTEX3D(X2,Y2,BZ2)
   CALL GLEND()
  ENDDO

  CALL GLDISABLE(GL_TEXTURE_2D)
  CALL GLENDLIST()

  SOLPLOT(NSOLLIST)%IBITMAP=1
  
 ENDDO
 
 IMOD3D_SOL_BMP=.TRUE.

 CALL IMOD3D_ERROR('IMOD3D_SOL_BMP')

 END FUNCTION IMOD3D_SOL_BMP

 !###======================================================================
 LOGICAL FUNCTION IMOD3D_SOL_BMP_LOAD(ISPF)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISPF
 INTEGER(GLSIZEI) :: IWIDTH,IHEIGHT
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IBMPDATA
 INTEGER :: I,J,IW,IH,IOS
 REAL(KIND=GLFLOAT),ALLOCATABLE,DIMENSION(:) :: FRGB
 INTEGER,DIMENSION(11) :: INFO
 
 IMOD3D_SOL_BMP_LOAD=.FALSE.

 CALL IGRFILEINFO(SPF(ISPF)%PBITMAP%FNAME,INFO,11)
 SPF(ISPF)%PBITMAP%IW=INFO(2)
 SPF(ISPF)%PBITMAP%IH=INFO(3)
 
 IWIDTH =SPF(ISPF)%PBITMAP%IW 
 IHEIGHT=SPF(ISPF)%PBITMAP%IH 
 ALLOCATE(IBMPDATA(IWIDTH*IHEIGHT),STAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot allocate enough memory IBMPDATA() to store image'//CHAR(13)// &
  TRIM(SPF(ISPF)%PBITMAP%FNAME),'Error'); RETURN
 ENDIF

 ALPHA=0.75_GLDOUBLE
 IALPHA=0

 ALLOCATE(FRGB(IWIDTH*IHEIGHT*(3+IALPHA)),STAT=IOS)
 IF(IOS.NE.0)THEN
  DEALLOCATE(IBMPDATA)
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot allocate enough memory FRGB() to store image'//CHAR(13)// &
  TRIM(SPF(ISPF)%PBITMAP%FNAME),'Error'); RETURN
 ENDIF

 IF(.NOT.UTL_LOADIMAGE(SPF(ISPF)%PBITMAP%FNAME,SIZE(IBMPDATA),IBMPDATA,0))THEN
  DEALLOCATE(IBMPDATA,FRGB); RETURN
 ENDIF
  
 !## draw pixels at the current rasterposition
 J=-2-IALPHA
 DO IH=IHEIGHT,1,-1
  DO IW=1,IWIDTH
   J=J+3+IALPHA
   I=(IH-1)*IWIDTH+IW
   CALL IMOD3D_RETURNCOLOR(IBMPDATA(I),FRGB(J))
   !## mask out white, to be translucent (make pure black=background)
   IF(IALPHA.EQ.1)THEN
    !## white
    IF(FRGB(I).EQ.1.0D0)THEN
     FRGB(J+3)=0.0_GLDOUBLE !ALPHA !## alpha value
    ELSE
     FRGB(J+3)=1.0_GLDOUBLE !ALPHA !## alpha value
    ENDIF
   ENDIF
  ENDDO
 ENDDO

 !## turns on texturing
 CALL GLENABLE(GL_TEXTURE_2D)
 !## sets the drawing mode to GL_DECAL so that the textured
 !## polygons are drawn using the colors from the texture map (rather than taking into account what color the polygons
 !## would have been drawn without the texture)

 IF(IALPHA.EQ.0)THEN
  !## print image over the polygons
  CALL GLTEXENVI(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL) !MODULATE)
 ELSE
  CALL GLTEXENVI(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_BLEND)
  CALL GLTEXENVFV(GL_TEXTURE_ENV,GL_TEXTURE_ENV_COLOR,FRGB) !GL_RGBA)
 ENDIF

!kan weg
! CALL GLCOLOR4D(1.0_GLDOUBLE,1.0_GLDOUBLE,1.0_GLDOUBLE,0.0_GLDOUBLE) !1.0_GLDOUBLE)

 !## it describes how the bitmap data is stored in computer memory
 CALL GLPIXELSTOREI(GL_UNPACK_ALIGNMENT,1)

 !## parameters indicate the size of the image, type of the image, location of the image, and other properties of it
 IF(IALPHA.EQ.0)THEN
  CALL GLTEXIMAGE2D(GL_TEXTURE_2D,0_GLINT,3_GLINT,IWIDTH,IHEIGHT,0_GLINT,GL_RGB ,GL_FLOAT,FRGB)
 ELSE
  CALL GLTEXIMAGE2D(GL_TEXTURE_2D,0_GLINT,GL_RGBA,IWIDTH,IHEIGHT,0_GLINT,GL_RGBA,GL_FLOAT,FRGB)
 ENDIF

 !## free memory
 DEALLOCATE(IBMPDATA,FRGB)
 
 IMOD3D_SOL_BMP_LOAD=.TRUE.
 
 END FUNCTION IMOD3D_SOL_BMP_LOAD
 
 !###======================================================================
 SUBROUTINE IMOD3D_CLP_ADD(X,Y,Z,XPOS,YPOS,ZPOS,CLIPNAME)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE),INTENT(IN) :: X,Y,Z,XPOS,YPOS,ZPOS
 CHARACTER(LEN=*),INTENT(IN) :: CLIPNAME
 INTEGER :: I,N
 
 !## add clipping plane
 NCLPLIST=MAX(1,NCLPLIST+1)
 CLPPLOT(NCLPLIST)%ISEL=0
 CLPPLOT(NCLPLIST)%ITHICKNESS=1
 CLPPLOT(NCLPLIST)%ICOLOR=WRGB(255,0,0)
! IF(LCAP)THEN
!  CLPPLOT(NCLPLIST)%ICAP=1
! ELSE
  CLPPLOT(NCLPLIST)%ICAP=0
! ENDIF
 IF(CLIPNAME.EQ.'')THEN
  CLPPLOT(NCLPLIST)%FNAME='ClippingPlane '//TRIM(ITOS(NCLPLIST))
 ELSE
  CLPPLOT(NCLPLIST)%FNAME=TRIM(CLIPNAME)
 ENDIF
 
 !## search for keyword:
 N=NCLPLIST; DO I=1,N
  IF(TRIM(CLPPLOT(I)%FNAME).EQ.TRIM(CLIPNAME))EXIT
 ENDDO
 CLPPLOT(I)%EQN=(/X,Y,Z,0.0_GLDOUBLE/)
 !## position of the clipping plane
 CLPPLOT(I)%X=XPOS
 CLPPLOT(I)%Y=YPOS
 CLPPLOT(I)%Z=ZPOS

 CLPPLOT(I)%ITHICKNESS=3
 CLPPLOT(I)%ICOLOR=COLOUR_RANDOM()
 CLPPLOT(I)%IPOS=0
 
 IF(I.LT.N)NCLPLIST=MAX(0,NCLPLIST-1)
 
 END SUBROUTINE IMOD3D_CLP_ADD

 !###======================================================================
 SUBROUTINE IMOD3D_QUAD(X,Y,Z,C,ILST,LLST)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE),DIMENSION(4),INTENT(IN) :: X,Y,Z
 REAL(KIND=DP_KIND),INTENT(IN) :: C
 INTEGER,INTENT(IN) :: ILST,LLST
 INTEGER :: I,ICLR
 REAL(KIND=DP_KIND) :: ZM
 
 DO I=1,4

  !## get color for z-mean between two segments
  IF(IDFPLOT(ILST)%ILEG.EQ.2)THEN
   IF(ILST.EQ.LLST)THEN
    IF(I.LT.4)ZM=(Z(I)+Z(I+1))/2.0
    IF(I.EQ.4)ZM=(Z(I)+Z(1))/2.0
    ICLR=UTL_IDFGETCLASS(IDFPLOT(ILST)%LEG,ZM)
   ELSE
    ICLR=UTL_IDFGETCLASS(IDFPLOT(LLST)%LEG,C)
   ENDIF
   CALL IMOD3D_SETCOLOR(ICLR)
  ENDIF

  CALL GLVERTEX3D(X(I),Y(I),Z(I))
 END DO

 CALL IMOD3D_ERROR('IMOD3D_QUAD')

 END SUBROUTINE IMOD3D_QUAD

 !###======================================================================
 SUBROUTINE IMOD3D_TRIANGLE(X,Y,Z,IX,IY,IZ)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,DIMENSION(3),INTENT(IN) :: IX,IY,IZ
 REAL(KIND=GLDOUBLE),DIMENSION(3),INTENT(IN) :: X,Y,Z
 INTEGER :: I,ICLR
 REAL(KIND=DP_KIND) :: ZM

 DO I=1,3

  !## get color for z-mean between two segments
  IF(IDFPLOT(NIDFLIST)%ILEG.EQ.2)THEN
   IF(I.LT.3)ZM=(Z(IZ(I))+Z(IZ(I+1)))/2.0
   IF(I.EQ.3)ZM=(Z(IZ(I))+Z(IZ(1)))/2.0
   ICLR=UTL_IDFGETCLASS(IDFPLOT(NIDFLIST)%LEG,ZM)
   CALL IMOD3D_SETCOLOR(ICLR)
  ENDIF

  CALL GLVERTEX3D(X(IX(I)),Y(IY(I)),Z(IZ(I)))
 
 END DO

 CALL IMOD3D_ERROR('IMOD3D_TRIANGLE')

 END SUBROUTINE IMOD3D_TRIANGLE

 !###======================================================================
 SUBROUTINE IMOD3D_TRIANGLE_SOLID(X,Y,Z,IX,IY,IZ)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,DIMENSION(3),INTENT(IN) :: IX,IY,IZ
 REAL(KIND=GLDOUBLE),DIMENSION(3),INTENT(IN) :: X,Y,Z
 INTEGER :: I

 DO I=1,3
  CALL GLVERTEX3D(X(IX(I)),Y(IY(I)),Z(IZ(I)))
 END DO

 CALL IMOD3D_ERROR('IMOD3D_TRIANGLE_SOLID')

 END SUBROUTINE IMOD3D_TRIANGLE_SOLID

 !###======================================================================
 SUBROUTINE IMOD3D_LINE(X,Y,Z)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=GLDOUBLE),DIMENSION(2),INTENT(IN) :: X,Y,Z

 CALL GLVERTEX3D(X(1),Y(1),Z(1))
 CALL GLVERTEX3D(X(2),Y(2),Z(2))
 BOT%Z=MIN(BOT%Z,Z(1),Z(2))
 TOP%Z=MAX(TOP%Z,Z(1),Z(2))

 CALL IMOD3D_ERROR('IMOD3D_LINE')

 END SUBROUTINE IMOD3D_LINE

END MODULE MOD_3D_ENGINE