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

USE WINTERACTER
USE RESOURCE
USE MOD_IDFPLOT
USE MOD_DBL
USE MOD_MANAGER_UTL
USE MOD_UTL
USE MOD_INFO, ONLY : INFOSTAT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MODPLOT
USE MOD_IDF
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_POLYGON_PAR
USE MOD_POLYGON_UTL 
USE MOD_POLYGON, ONLY : POLYGON1MAIN
USE MOD_POLYGON_DRAW, ONLY : POLYGON1DRAWSHAPE,POLYGON1DRAWYSEL,POLYGON1PLOTYSEL
USE IMODVAR, ONLY : DP_KIND,SP_KIND,IDIAGERROR
USE MOD_KRIGING, ONLY : KRIGING_MAIN,KRIGINGSETTINGS
USE MOD_KRIGING_PAR
USE MOD_IDFEDIT_TRACE, ONLY : IDFEDITTRACE
USE MOD_IDFEDIT_UTL 
USE MOD_OSD, ONLY : OSD_OPEN,OSD_GETENV,OSD_IOSTAT_MSG
USE MOD_BIVARIATE, ONLY : BIVARIATE_INT
USE MOD_SOLID_PCG, ONLY : SOLID_PCGINT,MXITER1,MXITER2,HCLOSE,RCLOSE,ITIGHT,MICNVG,RELAX,IDAMPING,FTIGHT
USE MOD_PCG, ONLY : PCGSETTINGS
USE MOD_IDFEDIT_TABLE, ONLY : UTL_EDITTABLE
USE MOD_POLINT, ONLY : POL1LOCATE
USE MOD_MAIN_UTL

CONTAINS

 !###======================================================================
 SUBROUTINE IDFEDITMAIN(ITYPE,MESSAGE)
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER,INTENT(IN) :: ITYPE
 
 !## check polygon actions
 IACTSHAPES=(/3,1,1,1,3,3/)
 CALL POLYGON1MAIN(ITYPE,MESSAGE)
 IF(ITYPE.EQ.PUSHBUTTON.AND.MESSAGE%VALUE1.EQ.ID_ZOOMSELECT)THEN
  CALL IDFZOOM(ID_DGOTOXY,0.0D0,0.0D0,0)
  CALL IDFPLOT(1)
 ENDIF

 CALL WDIALOGSELECT(MESSAGE%WIN) 

 SELECT CASE (ITYPE)

  CASE(TABCHANGED)
   !## newer tab
   SELECT CASE (MESSAGE%VALUE2)
    CASE (ID_DIDFEDITTAB1)
     CALL WDIALOGFIELDSTATE(ID_GRIDSIZE,2)
    CASE (ID_DIDFEDITTAB2)
     CALL WDIALOGFIELDSTATE(ID_GRIDSIZE,1)
   END SELECT
  CASE(FIELDCHANGED)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_SHOW)
     CALL IDFEDITSHOWSELECTION()
   END SELECT

  CASE(PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_ZOOMFULL)
     CALL IDFEDITZOOMSELECTION()
    CASE (ID_PAINT)
     CALL IDFEDITPENCIL()
    CASE (ID_LOGICAL)
     CALL IDFEDITLOGICALMAIN()
    CASE (ID_PIPET)
     CALL IDFEDITPIPET()
    CASE (ID_CALC)
     CALL IDFEDITCALCINIT()
    CASE (ID_STAT)
     CALL INFOSTAT(MP(1:MPW%NACT)%IDFNAME,0,0)
    CASE (ID_CLEAR)
     CALL IDFEDITCLEARSELECTION()
    CASE (IDCANCEL)
     CALL IDFEDITCLOSE()
    CASE (IDHELP)
     CALL UTL_GETHELP('4.1.4','MMO.IDO.IDFEdit') 
    CASE (ID_GRIDSIZE)
     CALL IDFEDITGRIDSIZE()
     CALL WDIALOGSELECT(MESSAGE%WIN)
!    CASE (ID_GETGRIDSIZE)
!     CALL IDFEDITGETGRIDSIZE()
    CASE (ID_RESIZE)
     CALL IDFEDITSAVEGRIDSIZE(MESSAGE%VALUE1)
   END SELECT

 END SELECT

 END SUBROUTINE IDFEDITMAIN

 !###======================================================================
 SUBROUTINE IDFEDITGRIDSIZE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPOL,ITYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 REAL(KIND=DP_KIND) :: X
 
 IF(SUM(SHP%POL%IACT).NE.1)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should select at least one polygon to assign a gridsize to it','Error')
  RETURN
 ENDIF
 
 DO IPOL=1,SIZE(SHP%POL); IF(SHP%POL(IPOL)%IACT.EQ.1)EXIT; ENDDO; X=XGRIDSIZE(IPOL)
 
 CALL WDIALOGLOAD(ID_DGIVEREAL,ID_DGIVEREAL)
 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Enter gridsize (meter) for the selected Polygon ['//TRIM(SHP%POL(IPOL)%PNAME)//']; current value is '//TRIM(RTOS(X,'F',2)))
 CALL WDIALOGPUTDOUBLE(IDF_REAL1,X)
    
 CALL UTL_DIALOGSHOW(0,0,0,2)
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1) 
     CASE (IDCANCEL,IDOK)
      EXIT
    END SELECT
  END SELECT
 ENDDO 
 CALL WDIALOGGETDOUBLE(IDF_REAL1,X) 
 CALL WDIALOGUNLOAD(); IF(MESSAGE%VALUE1.EQ.IDCANCEL)RETURN
 
 !## set gridsize for current polygon
 XGRIDSIZE(IPOL)=X
  
 END SUBROUTINE IDFEDITGRIDSIZE
 
 !###======================================================================
 SUBROUTINE IDFEDITSAVEGRIDSIZE(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 CHARACTER(LEN=256) :: IDFNAME
 INTEGER :: I,II,J,IPLOT,ISCALE,JSCALE,NSX,NSY
 REAL(KIND=DP_KIND) :: DX,DY,X1,X2,Y1,Y2,XMAX,XMIN,YMAX,YMIN
 TYPE(IDFOBJ) :: IDFRESIZE
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: SX,SY
 
 !## use all polygons ... does not matter if they are selected
 IF(SHP%NPOL.LE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should create polygons first that determine the gridsizes','Error')
  RETURN
 ENDIF
 DO I=1,SHP%NPOL
  IF(XGRIDSIZE(I).LE.0.0D0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You should give each polygon an appropriate cellsize (> 0.0).'//CHAR(13)// &
     'Polygon '//TRIM(SHP%POL(I)%PNAME)//' does have a gridsize of '//TRIM(RTOS(XGRIDSIZE(I),'F',2))//' meter','Error')
   RETURN
  ENDIF
 ENDDO
 
 CALL WDIALOGSELECT(ID_DIDFEDITTAB2); CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)  
 !## get upscal algorithm
 CALL WDIALOGGETMENU(IDF_MENU1,ISCALE)
 !## get downscale algorithm
 CALL WDIALOGGETMENU(IDF_MENU3,JSCALE)

 IF(ID.EQ.ID_RESIZE)THEN
  IDFNAME=''
  IF(.NOT.UTL_WSELECTFILE('iMOD IDF File (*.idf)|*.idf|', &
   SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,IDFNAME,TITLE='Specify New IDF'))RETURN
 ELSE
  IDFNAME=MP(IPLOT)%IDFNAME 
 ENDIF

 IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))THEN; RETURN; ENDIF
 
 !## create new IDF file that stores the renewed grid dimensions
 CALL IDFNULLIFY(IDFRESIZE); CALL IDFCOPY(MP(IPLOT)%IDF,IDFRESIZE)
 IF(.NOT.IDFFILLSXSY(IDFRESIZE))RETURN
 
 !## create pointer for current grid-size that can be modified easily
 NSX=IDFRESIZE%NCOL+1; NSY=IDFRESIZE%NROW+1; ALLOCATE(SX(NSX),SY(NSY))
 !## start with current gridsizes
 DO I=1,NSX; SX(I)=IDFRESIZE%SX(I-1); ENDDO 
 DO I=1,NSY; SY(I)=IDFRESIZE%SY(I-1); ENDDO
 
 !## set sy in different order
 J=NSY; DO I=1,NSY/2
  X1=SY(I); SY(I)=SY(J); SY(J)=X1
  J=J-1
 ENDDO
 
 DO II=1,SHP%NPOL

  !## get position of shape j
  X1=MINVAL(SHP%POL(II)%X(1:SHP%POL(II)%N)); Y1=MINVAL(SHP%POL(II)%Y(1:SHP%POL(II)%N));
  X2=MAXVAL(SHP%POL(II)%X(1:SHP%POL(II)%N)); Y2=MAXVAL(SHP%POL(II)%Y(1:SHP%POL(II)%N)); DX=XGRIDSIZE(II); DY=DX
  
  !## polygon outside grid?
  XMAX=MP(IPLOT)%IDF%XMAX; XMIN=MP(IPLOT)%IDF%XMIN
  YMAX=MP(IPLOT)%IDF%YMAX; YMIN=MP(IPLOT)%IDF%YMIN
  IF((X1.GT.XMAX.OR.X1.LT.XMIN).AND.(X2.GT.XMAX.OR.X2.LT.XMIN))CYCLE
  IF((Y1.GT.YMAX.OR.Y1.LT.YMIN).AND.(Y2.GT.YMAX.OR.Y2.LT.YMIN))CYCLE
  
  !## call to subroutine to calculate new x and y arrays (SX and SY)
  CALL IDFEDITSAVEGRIDSIZE_INSERT(SX,NSX,X1,X2,DX,MP(IPLOT)%IDF%XMAX)
  CALL IDFEDITSAVEGRIDSIZE_INSERT(SY,NSY,Y1,Y2,DX,MP(IPLOT)%IDF%YMAX)
  
 ENDDO 

 !## set new sx/sy variables on idf object
 DEALLOCATE(IDFRESIZE%SX); ALLOCATE(IDFRESIZE%SX(0:NSX-1))
 DO I=1,NSX; IDFRESIZE%SX(I-1)=SX(I); ENDDO
 DEALLOCATE(IDFRESIZE%SY); ALLOCATE(IDFRESIZE%SY(0:NSY-1))

 !## reset sy in right order
 J=NSY; DO I=1,NSY/2
  X1=SY(I); SY(I)=SY(J); SY(J)=X1
  J=J-1
 ENDDO

 DO I=1,NSY; IDFRESIZE%SY(I-1)=SY(I); ENDDO 
 IDFRESIZE%NCOL=NSX-1; IDFRESIZE%NROW=NSY-1; IDFRESIZE%IEQ=1
 
 IF(IDFREADSCALE(MP(IPLOT)%IDFNAME,IDFRESIZE,ISCALE,1,0.0D0,0))THEN
  IF(.NOT.IDFWRITE(IDFRESIZE,IDFNAME,1))THEN; ENDIF
 ENDIF
 CALL IDFDEALLOCATEX(IDFRESIZE)
 
 CALL MANAGER_UTL_ADDFILE(IDFNAME)
!call idfplotfast()       
 CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONYES,'Succesfully resized IDF-file:'//CHAR(13)//TRIM(IDFNAME)//CHAR(13)// &
 'The file has been added to the iMOD-manager','Information')
 
 END SUBROUTINE IDFEDITSAVEGRIDSIZE

 !###======================================================================
 SUBROUTINE IDFEDITSAVEGRIDSIZE_INSERT(SXY,NSXY,X1,X2,DX,XMAX)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:),INTENT(INOUT) :: SXY
 INTEGER,INTENT(INOUT) :: NSXY
 REAL(KIND=DP_KIND),INTENT(INOUT) :: X1,X2
 REAL(KIND=DP_KIND),INTENT(IN) :: DX,XMAX
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: SXY_BU
 INTEGER :: I,J,N,I1,I2
 
 !## initialize array
 IF(X1.LT.SXY(1))THEN
  I1=1
 ELSE
  CALL POL1LOCATE(SXY,NSXY,REAL(X1,8),I1)
 ENDIF
 !## right/upper border
 IF(X2.GE.SXY(NSXY))THEN
  I2=NSXY
 ELSE
  CALL POL1LOCATE(SXY,NSXY,REAL(X2,8),I2)
  I2=I2+1
 ENDIF 
 X1=SXY(I1); X2=SXY(I2); N=NSXY+(X2-X1)/DX
 ALLOCATE(SXY_BU(N))

 DO I=1,NSXY
  IF(SXY(I).GT.X1)EXIT; SXY_BU(I)=SXY(I)
 ENDDO
  
 !## fill in modified gridcells
 J=I-1
 DO
  J=J+1; SXY_BU(J)=SXY_BU(J-1)+DX
  IF(SXY_BU(J).GE.X2)EXIT
 ENDDO
 SXY_BU(J)=X2
 
 DO 
  IF(SXY_BU(J).EQ.XMAX)EXIT
  I=I+1
  IF(SXY(I).GT.X2)THEN
   J=J+1
   SXY_BU(J)=SXY(I)
  ENDIF
 ENDDO

 DEALLOCATE(SXY); NSXY=J; ALLOCATE(SXY(NSXY))
 DO I=1,NSXY; SXY(I)=SXY_BU(I); ENDDO 
  
 END SUBROUTINE IDFEDITSAVEGRIDSIZE_INSERT
 
 !###======================================================================
 SUBROUTINE IDFEDITSHOWSELECTION()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL POLYGON1DRAWYSEL()
 CALL WDIALOGGETCHECKBOX(ID_SHOW,I)
 IF(I.EQ.0)LPLOTYSEL=.FALSE.
 IF(I.EQ.1)LPLOTYSEL=.TRUE.
 CALL POLYGON1DRAWYSEL()

 END SUBROUTINE IDFEDITSHOWSELECTION

 !###======================================================================
 SUBROUTINE IDFEDITCLEARSELECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: FNAME
 INTEGER :: I,IU,IOS

 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to delete the entire selection?','Question')
 IF(WINFODIALOG(4).NE.1)RETURN

 IF(ALLOCATED(SELIDF))THEN
  CALL POLYGON1DRAWYSEL()
  CALL POLYGON1DEALLOCATE_SELIDF()
  IF(ALLOCATED(ITHRD))DEALLOCATE(ITHRD)
 ENDIF

 !## no reset of selection

 DO I=1,IACTIONISEL
  FNAME=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_SELECTED'//TRIM(ITOS(I))//'.DAT'
  IU=UTL_GETUNIT()
  CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='UNFORMATTED',IOSTAT=IOS)
  IF(IOS.EQ.0)CLOSE(IU,STATUS='DELETE')
 END DO
 IACTIONISEL=0

! CALL IDFEDITPENCILFIELDS()
 CALL IDFEDITLOGICALFIELDS()
 CALL IDFEDITFIELDS()

 !## allocate again memory
 CALL IDFEDITALLOCATE()

 END SUBROUTINE IDFEDITCLEARSELECTION

 !###======================================================================
 SUBROUTINE IDFEDITZOOMSELECTION()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: XC,YC
 INTEGER :: I,IROW,ICOL

 DO I=1,SELIDF(1)%NTHREAD
  !## cell-indices from selection
  ICOL=INT(SELIDF(1)%YSEL(1,I))
  IROW=INT(SELIDF(1)%YSEL(2,I))
  !## compute x,y-coordinate
  CALL IDFGETLOC(SELIDF(1),IROW,ICOL,XC,YC)
  IF(I.EQ.1)THEN
   MPW%XMIN=XC-1.0D0
   MPW%YMIN=YC-1.0D0
   MPW%XMAX=XC+1.0D0
   MPW%YMAX=YC+1.0D0
  ELSE
   MPW%XMIN=MIN(MPW%XMIN,XC)
   MPW%YMIN=MIN(MPW%YMIN,YC)
   MPW%XMAX=MAX(MPW%XMAX,XC)
   MPW%YMAX=MAX(MPW%YMAX,YC)
  ENDIF
 ENDDO

 !## increase window to count for y-size!
 YC      =(MPW%YMAX-MPW%YMIN)/2.0D0
 YC      = YC/2.0D0
 MPW%YMAX= MPW%YMAX+YC
 MPW%YMIN= MPW%YMIN-YC

 CALL IDFZOOM(ID_DGOTOXY,0.0D0,0.0D0,0)
 CALL IDFPLOTFAST(1)

 END SUBROUTINE IDFEDITZOOMSELECTION

 !###======================================================================
 SUBROUTINE IDFEDITRESTORESELECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: FNAME
 INTEGER :: IU,IOS,I

 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to restore last selection ?','Question')
 IF(WINFODIALOG(4).NE.1)RETURN

 !## store previous results of calculation for backward tracing
 FNAME=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_SELECTED'//TRIM(ITOS(IACTIONISEL))//'.DAT'
! FNAME=TRIM(PREFVAL(1))//'\TMP\TMPSELECTED'//TRIM(ITOS(IACTIONISEL))//'.DAT'
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ',FORM='UNFORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot READ current file'//CHAR(13)// &
    TRIM(FNAME),'Error')
  RETURN
 ENDIF

 !## remove current selection
 CALL POLYGON1DRAWYSEL()

 READ(IU) SELIDF(1)%NTHREAD
 DO I=1,SELIDF(1)%NTHREAD
  READ(IU) SELIDF(1)%YSEL(1,I),SELIDF(1)%YSEL(2,I)
 ENDDO
 !## remove backup for selection
 CLOSE(IU,STATUS='DELETE')

 !## redraw current selection
 CALL POLYGON1DRAWYSEL()

 IACTIONISEL=MAX(0,IACTIONISEL-1)
 I=MIN(MAX(0,IACTIONISEL),1)
 CALL WDIALOGSELECT(ID_DIDFEDITLOGICAL)
 CALL WDIALOGFIELDSTATE(ID_RESTORE,I)

 CALL IDFEDITLOGICALFIELDS()

 END SUBROUTINE IDFEDITRESTORESELECTION

 !###======================================================================
 SUBROUTINE IDFEDITSTORESELECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: FNAME
 INTEGER :: IU,IOS,I

 !## nothing yet selected
 IF(.NOT.ALLOCATED(SELIDF))RETURN

 !## store previous results of calculation for backward tracing
 IACTIONISEL=IACTIONISEL+1
 FNAME=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_SELECTED'//TRIM(ITOS(IACTIONISEL))//'.DAT'
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='UNFORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot WRITE current file'//CHAR(13)// &
    TRIM(FNAME),'Error')
  RETURN
 ENDIF

 WRITE(IU) SELIDF(1)%NTHREAD
 DO I=1,SELIDF(1)%NTHREAD
  WRITE(IU) SELIDF(1)%YSEL(1,I),SELIDF(1)%YSEL(2,I)
 ENDDO
 CLOSE(IU)

 CALL WDIALOGSELECT(ID_DIDFEDITLOGICAL)
 CALL WDIALOGFIELDSTATE(ID_RESTORE,1)

 CALL IDFEDITLOGICALFIELDS()

 END SUBROUTINE IDFEDITSTORESELECTION

 !###======================================================================
 SUBROUTINE IDFEDITPENCIL()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,ICOL,IROW,IBUTDOWN,I,J,IMODE 
 REAL(KIND=DP_KIND) :: MOUSEX,MOUSEY
 
 CALL IDFEDITALLOCATE()

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,0)

 CALL WDIALOGLOAD(ID_DIDFEDITDRAW,ID_DIDFEDITDRAW)
 CALL IDFEDITPENCILFIELDS()

 CALL UTL_DIALOGSHOW(-1,-1,0,2)

 CALL WCURSORSHAPE(ID_CURSORDRAWPLUS)
 IMODE=1

 LPLOTYSEL=.TRUE.
 IBUTDOWN=0

 DO 
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_RADIO1)
      CALL WCURSORSHAPE(ID_CURSORDRAWPLUS)
      IMODE=1
     CASE (IDF_RADIO2)
      CALL WCURSORSHAPE(ID_CURSORDRAWMIN)
      IMODE=2
    END SELECT 

   CASE (MENUSELECT)
!    CALL IMOD1MENUSELECT(MESSAGE) 
    IF(IMODE.EQ.1)CALL WCURSORSHAPE(ID_CURSORDRAWPLUS)
    IF(IMODE.EQ.2)CALL WCURSORSHAPE(ID_CURSORDRAWMIN)
     
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_CLEAR)
      CALL IDFEDITCLEARSELECTION()
      CALL IDFEDITPENCILFIELDS()
     CASE (IDCANCEL)
      EXIT
    END SELECT
   CASE (MOUSEBUTDOWN)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (1)
      IBUTDOWN=IMODE
     CASE (3)
 !     CALL WMENUFLOATING(ID_MENU4,MESSAGE%X,MESSAGE%Y)
    END SELECT
   CASE (MOUSEBUTUP)
    IBUTDOWN=0
   CASE (MOUSEMOVE)

    MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
    MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

    !## indices for template selidf
    CALL IDFIROWICOL(SELIDF(1),IROW,ICOL,MOUSEX,MOUSEY) !REAL(MESSAGE%GX,8),REAL(MESSAGE%GY,8))
    !## position with current selidf
    IF(ICOL.NE.0.AND.IROW.NE.0)THEN

     CALL WINDOWSELECT(0)
     CALL WINDOWOUTSTATUSBAR(1,'x = '//TRIM(RTOS(MOUSEX,'G',10))//' m; y = '//TRIM(RTOS(MOUSEY,'G',10))//' m')
!     CALL WINDOWOUTSTATUSBAR(1,'(x:'//TRIM(RTOS(REAL(MESSAGE%GX,8),'F',2))//' m ,y:'// &
!                                      TRIM(RTOS(REAL(MESSAGE%GY,8),'F',2))//' m)')

     IF(IBUTDOWN.NE.0)THEN

      DO I=1,SELIDF(1)%NTHREAD
       IF(INT(SELIDF(1)%YSEL(1,I)).EQ.ICOL.AND.INT(SELIDF(1)%YSEL(2,I)).EQ.IROW)EXIT
      END DO

      !## add location
      IF(IBUTDOWN.EQ.1.AND.I.GT.SELIDF(1)%NTHREAD)THEN
       SELIDF(1)%NTHREAD  =SELIDF(1)%NTHREAD+1
       SELIDF(1)%YSEL(1,SELIDF(1)%NTHREAD)=INT(ICOL,2)
       SELIDF(1)%YSEL(2,SELIDF(1)%NTHREAD)=INT(IROW,2)
       CALL IDFEDITPENCIL_PLOTYSEL(SELIDF(1)%NTHREAD)

      !## delete location
      ELSEIF(IBUTDOWN.EQ.2.AND.I.LE.SELIDF(1)%NTHREAD)THEN
       !## get whether current icol/irow is selected already
       CALL IDFEDITPENCIL_PLOTYSEL(I)
       SELIDF(1)%NTHREAD  =SELIDF(1)%NTHREAD-1
       DO J=I,SELIDF(1)%NTHREAD
        SELIDF(1)%YSEL(1,J)=SELIDF(1)%YSEL(1,J+1)
        SELIDF(1)%YSEL(2,J)=SELIDF(1)%YSEL(2,J+1)
       END DO
      ENDIF

      CALL IDFEDITPENCILFIELDS()

     ENDIF
    ENDIF
  END SELECT
 END DO

 CALL WCURSORSHAPE(CURARROW)

 CALL WDIALOGSELECT(ID_DIDFEDITDRAW)
 CALL WDIALOGUNLOAD()

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,2)

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGPUTCHECKBOX(ID_SHOW,1)

 CALL WDIALOGSELECT(ID_DIDFEDITCALC)
 CALL WDIALOGPUTCHECKBOX(ID_SHOW,1)

 CALL IGRPLOTMODE(MODECOPY)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRFILLPATTERN(OUTLINE)

 CALL IDFEDITFIELDS()

 END SUBROUTINE IDFEDITPENCIL

 !###======================================================================
 SUBROUTINE IDFEDITPENCILFIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 I=0
 IF(ALLOCATED(SELIDF))THEN
  IF(SELIDF(1)%NTHREAD.GT.0)I=1
 ENDIF

 CALL WDIALOGSELECT(ID_DIDFEDITDRAW)
 CALL WDIALOGFIELDSTATE(IDF_RADIO2,I)
 CALL WDIALOGFIELDSTATE(ID_CLEAR,I)

! CALL WDIALOGFIELDSTATE(ID_ZOOMFULL,I)
! CALL WDIALOGFIELDSTATE(ID_SHOW,I)

 !## write number of selections
 IF(ALLOCATED(SELIDF))THEN
  CALL WDIALOGPUTSTRING(IDF_LABEL2,TRIM(ITOS(SELIDF(1)%NTHREAD))//' cells selected out of '// &
       TRIM(ITOS(SELIDF(1)%NCOL*SELIDF(1)%NROW)))
 ELSE
  CALL WDIALOGPUTSTRING(IDF_LABEL2,'Nothing Selected')
 ENDIF

 END SUBROUTINE IDFEDITPENCILFIELDS

 !###======================================================================
 SUBROUTINE IDFEDITPENCIL_PLOTYSEL(I)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: I

 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRCOLOURN(WRGB(255,255,255))
 CALL IGRFILLPATTERN(SOLID)

 CALL UTL_PLOT1BITMAP()
 CALL IGRCOLOURN(WRGB(255,255,255))

 CALL POLYGON1PLOTYSEL(I)

 CALL UTL_PLOT2BITMAP()

 END SUBROUTINE IDFEDITPENCIL_PLOTYSEL

 !###======================================================================
 SUBROUTINE IDFEDITLOGICALINIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL WDIALOGLOAD(ID_DIDFEDITLOGICAL,ID_DIDFEDITLOGICAL)
 DO I=1,MXMPLOT; IF(MP(I)%ISEL.AND.MP(I)%IPLOT.EQ.1)EXIT; END DO
 IF(I.GT.MXMPLOT)I=1
 CALL WDIALOGPUTIMAGE(ID_ZOOMFULL,ID_ICONZOOMFULL,1)
 CALL WDIALOGPUTIMAGE(ID_SHOW,ID_ICONGLASSES,1)
 CALL WDIALOGPUTIMAGE(ID_RESTORE,ID_ICONUNDO,1)
 CALL WDIALOGPUTMENU(IDF_MENU2,MP%ALIAS,MPW%NACT,I)
 CALL WDIALOGPUTMENU(IDF_MENU4,MP%ALIAS,MPW%NACT,I)
 CALL WDIALOGPUTSTRING(IDF_CHECK3,'Skip NoDataValue ('//TRIM(RTOS(MP(I)%IDF%NODATA,'F',3))//')')
 CALL WDIALOGPUTSTRING(IDF_CHECK4,'Skip NoDataValue ('//TRIM(RTOS(MP(I)%IDF%NODATA,'F',3))//')')

 END SUBROUTINE IDFEDITLOGICALINIT

 !###======================================================================
 SUBROUTINE IDFEDITLOGICALMAIN()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,DIMENSION(2) :: IPLOT
 INTEGER :: ITYPE,I

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGGETMENU(IDF_MENU2,I)
 IF(MP(I)%IPLOT.NE.1)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to select an IDF file for storage of selected cells.','Error')
  RETURN
 ENDIF

 CALL WDIALOGSELECT(ID_DIDFEDIT)
 CALL WDIALOGGETMENU(IDF_MENU1,SHP%POL%IACT)

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,0)

 CALL WDIALOGSELECT(ID_DIDFEDITLOGICAL)

 CALL WDIALOGGETMENU(IDF_MENU2,IPLOT(1))  !idf1
 CALL WDIALOGGETMENU(IDF_MENU4,IPLOT(2))  !idf2

 IF(SUM(SHP%POL(1:SHP%NPOL)%IACT).EQ.0)THEN
  CALL WDIALOGFIELDSTATE(IDF_CHECK1,2)
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,0)
 ELSE
  CALL WDIALOGFIELDSTATE(IDF_CHECK1,1)
  CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,1)
 ENDIF
 CALL WDIALOGPUTSTRING(IDF_CHECK3,'Skip NoDataValue ('//TRIM(RTOS(MP(IPLOT(1))%IDF%NODATA,'G',7))//')')
 CALL WDIALOGPUTSTRING(IDF_CHECK4,'Skip NoDataValue ('//TRIM(RTOS(MP(IPLOT(2))%IDF%NODATA,'G',7))//')')

 CALL IDFEDITLOGICALFIELDS()

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDITLOGICAL,3)

 DO

  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)

   CASE (MENUSELECT)

   CASE (FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDF_MENU2)
      CALL WDIALOGGETMENU(IDF_MENU2,IPLOT(1))
      CALL WDIALOGPUTSTRING(IDF_CHECK3,'Skip NoDataValue ('//TRIM(RTOS(MP(IPLOT(1))%IDF%NODATA,'G',7))//')')
     CASE (IDF_MENU4)
      CALL WDIALOGGETMENU(IDF_MENU4,IPLOT(2))
      CALL WDIALOGPUTSTRING(IDF_CHECK4,'Skip NoDataValue ('//TRIM(RTOS(MP(IPLOT(2))%IDF%NODATA,'G',7))//')')
     CASE (IDF_CHECK2)
      CALL WDIALOGGETCHECKBOX(IDF_CHECK2,I)
      CALL WDIALOGFIELDSTATE(IDF_MENU3,I)
      CALL WDIALOGFIELDSTATE(IDF_MENU4,I)
      CALL WDIALOGFIELDSTATE(IDF_MENU5,I)
      CALL WDIALOGFIELDSTATE(IDF_REAL2,I)
      CALL WDIALOGFIELDSTATE(IDF_CHECK4,I)
      CALL WDIALOGFIELDSTATE(IDF_LABEL6,I)
      CALL WDIALOGFIELDSTATE(IDF_LABEL7,I)
      CALL WDIALOGFIELDSTATE(IDF_LABEL8,I)
      CALL WDIALOGFIELDSTATE(IDF_GROUP4,I)
     CASE (IDF_MENU1)
      CALL WDIALOGGETMENU(IDF_MENU1,I); I=MAX(0,MIN(1,11-I))
      CALL WDIALOGFIELDSTATE(IDF_REAL1,I)    
      CALL WDIALOGFIELDSTATE(IDF_LABEL5,I)    
     CASE (IDF_MENU5)
      CALL WDIALOGGETMENU(IDF_MENU5,I); I=MAX(0,MIN(1,11-I))
      CALL WDIALOGFIELDSTATE(IDF_REAL2,I)    
      CALL WDIALOGFIELDSTATE(IDF_LABEL8,I)    
     !## show selected cells
     CASE (ID_SHOW)
      CALL IDFEDITSHOWSELECTION()
    END SELECT
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     !## restore previous selection ---> if available
     CASE (ID_RESTORE)
      CALL IDFEDITRESTORESELECTION()
     !## clear selection
     CASE (ID_CLEAR)
      CALL IDFEDITCLEARSELECTION()
     !## zoom full selection
     CASE (ID_ZOOMFULL)
      CALL IDFEDITZOOMSELECTION()
     !## get selection
     CASE (IDOK)
      CALL IDFEDITLOGICAL()
     !## stop creating selection
     CASE (IDCANCEL)
      EXIT
    END SELECT
  END SELECT
 END DO

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDITLOGICAL,0)
 CALL WDIALOGGETCHECKBOX(ID_SHOW,I)
 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGPUTCHECKBOX(ID_SHOW,I)
 CALL IDFEDITFIELDS()
 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,2)

 END SUBROUTINE IDFEDITLOGICALMAIN

 !###======================================================================
 SUBROUTINE IDFEDITLOGICALFIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL WDIALOGSELECT(ID_DIDFEDITLOGICAL)

 I=0
 IF(ALLOCATED(SELIDF))THEN
  IF(SELIDF(1)%NTHREAD.GT.0)I=1
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_RADIO2,I)
 CALL WDIALOGFIELDSTATE(IDF_RADIO3,I)
 CALL WDIALOGFIELDSTATE(IDF_RADIO4,I)
 CALL WDIALOGFIELDSTATE(ID_ZOOMFULL,I)
 CALL WDIALOGFIELDSTATE(ID_CLEAR,I)
 CALL WDIALOGFIELDSTATE(ID_SHOW,I)
 IF(I.EQ.0)CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
 
 I=MIN(MAX(0,IACTIONISEL),1)
 CALL WDIALOGFIELDSTATE(ID_RESTORE,I)

 !## write number of selections
 IF(ALLOCATED(SELIDF))THEN
  CALL WDIALOGPUTSTRING(IDF_LABEL2,TRIM(ITOS(SELIDF(1)%NTHREAD))//' cells selected out of '// &
       TRIM(ITOS(SELIDF(1)%NCOL*SELIDF(1)%NROW)))
 ELSE
  CALL WDIALOGPUTSTRING(IDF_LABEL2,'Nothing Selected')
 ENDIF

 END SUBROUTINE IDFEDITLOGICALFIELDS

 !###======================================================================
 SUBROUTINE IDFEDITLOGICAL()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,DIMENSION(2) :: IUSE,ICHECK,IPLOT
 INTEGER,DIMENSION(3) :: ILOGICAL
 INTEGER :: ITYPE,IROW,ICOL,IR1,IR2,IC1,IC2,IRAT1,IRAT,JROW,JCOL,IADDSEL,SHPI
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX,XC,YC,R
 REAL(KIND=DP_KIND),DIMENSION(2) :: X,IDFVAL
 LOGICAL,DIMENSION(3) :: LX
 LOGICAL :: LEX,LPOL

 CALL WDIALOGSELECT(ID_DIDFEDITLOGICAL)

 IPLOT=0

!(1)  =
!(2)  <>
!(3)  <
!(4)  <=
!(5)  >
!(6)  >=
!(7)  bnd
!(8)  spike (4)
!(9)  spike (3)
!(10) spike (2)
!(11) all
!(12) NaN
!(13) Inf
!(14) NodataValues

 CALL WDIALOGGETMENU(IDF_MENU1,ILOGICAL(1))       !## gt,lt,eq,etc.
 CALL WDIALOGGETMENU(IDF_MENU2,IPLOT(1))          !## idf 1
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,IUSE(1))      !## use polygon
 CALL WDIALOGGETDOUBLE(IDF_REAL1,X(1))            !## real1
 CALL WDIALOGGETCHECKBOX(IDF_CHECK3,ICHECK(1))    !## skip nodata value
 CALL WDIALOGGETCHECKBOX(IDF_CHECK2,IUSE(2))      !## incl. extra statement
 IF(IUSE(2).EQ.1)THEN
  CALL WDIALOGGETMENU(IDF_MENU3,ILOGICAL(3))      !## and/or
  CALL WDIALOGGETMENU(IDF_MENU5,ILOGICAL(2))      !## gt,lt,eq,etc.
  CALL WDIALOGGETMENU(IDF_MENU4,IPLOT(2))         !## idf 2
  CALL WDIALOGGETDOUBLE(IDF_REAL2,X(2))           !## real2
  CALL WDIALOGGETCHECKBOX(IDF_CHECK4,ICHECK(2))   !## nodata
 ENDIF
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IADDSEL)   !## 1=new;2=add;3=remove;4=subset

 !## store current selection
 CALL IDFEDITSTORESELECTION()

 !## remove current selection from screen
 CALL POLYGON1DRAWYSEL()

 IF(IADDSEL.EQ.1)THEN

  CALL POLYGON1DEALLOCATE_SELIDF()
  IF(ALLOCATED(ITHRD))DEALLOCATE(ITHRD)

 ENDIF

 CALL IDFEDITALLOCATE()

 !## store current selection in ithrd-array
 CALL IDFEDIT_YSEL2ITHRD()

 !## error occured
 IF(.NOT.IDFREAD(MP(IPLOT(1))%IDF,MP(IPLOT(1))%IDFNAME,0))RETURN

 IF(IUSE(2).EQ.1)THEN
   !## error occured
  IF(.NOT.IDFREAD(MP(IPLOT(2))%IDF,MP(IPLOT(2))%IDFNAME,0))RETURN
 ENDIF

 DO SHPI=1,MAX(1,SHP%NPOL)

  LPOL=.TRUE.
  IF(IUSE(1).EQ.1)THEN
   LPOL=.FALSE.
   IF(SHP%POL(SHPI)%IACT.EQ.1)THEN
    SELECT CASE (SHP%POL(SHPI)%ITYPE)
     CASE(ID_POLYGON,ID_RECTANGLE)
      XMIN=MINVAL(SHP%POL(SHPI)%X(1:SHP%POL(SHPI)%N))
      XMAX=MAXVAL(SHP%POL(SHPI)%X(1:SHP%POL(SHPI)%N))
      YMIN=MINVAL(SHP%POL(SHPI)%Y(1:SHP%POL(SHPI)%N))
      YMAX=MAXVAL(SHP%POL(SHPI)%Y(1:SHP%POL(SHPI)%N))
     CASE (ID_CIRCLE)
      XC=(SHP%POL(SHPI)%X(1)- SHP%POL(SHPI)%X(2))**2.0D0
      YC=(SHP%POL(SHPI)%Y(1)- SHP%POL(SHPI)%Y(2))**2.0D0
      R=XC+YC; IF(R.GT.0.0D0)R=SQRT(R)
      XMIN=SHP%POL(SHPI)%X(1)-R; XMAX=SHP%POL(SHPI)%X(1)+R
      XMAX=SHP%POL(SHPI)%X(1)+R; YMAX=SHP%POL(SHPI)%X(1)+R
    END SELECT           
    CALL IDFIROWICOL(SELIDF(1),IR1,IC1,XMIN,YMAX)
    CALL IDFIROWICOL(SELIDF(1),IR2,IC2,XMAX,YMIN)
    IF(XMIN.LT.SELIDF(1)%XMIN)IC1=1
    IF(XMAX.GT.SELIDF(1)%XMAX)IC2=SELIDF(1)%NCOL
    IF(YMAX.GT.SELIDF(1)%YMAX)IR1=1
    IF(YMIN.LT.SELIDF(1)%YMIN)IR2=SELIDF(1)%NROW
    LPOL=.TRUE.
   ENDIF
  ELSE
   IR1 =1; IR2 =SELIDF(1)%NROW
   IC1 =1; IC2 =SELIDF(1)%NCOL
  ENDIF

  IF(LPOL)THEN
   CALL UTL_MESSAGEHANDLE(0)
   CALL WINDOWOUTSTATUSBAR(2,'Press ESC to terminate')

   IRAT1=0
   IRAT =IRAT1
   CALL WINDOWSELECT(0)
   IRLOOP: DO IROW=IR1,IR2
    CALL WMESSAGEPEEK(ITYPE,MESSAGE)
    IF(ITYPE.EQ.KEYDOWN.AND.MESSAGE%VALUE1.EQ.KEYESCAPE)EXIT
    DO ICOL=IC1,IC2

     !## get x/y coordinates
     CALL IDFGETLOC(SELIDF(1),IROW,ICOL,XC,YC)

     LEX=.TRUE.
     IF(IUSE(1).EQ.1)THEN
      IF(DBL_IGRINSIDESHAPE(XC,YC,SHP%POL(SHPI)).NE.1)LEX=.FALSE.
     ENDIF
     IF(LEX)THEN

      !## get irow/icol indices for x/y coordinates
      CALL IDFIROWICOL(MP(IPLOT(1))%IDF,JROW,JCOL,XC,YC)

      IF(JCOL.NE.0.AND.JROW.NE.0)THEN
       IDFVAL(1)=IDFGETVAL(MP(IPLOT(1))%IDF,JROW,JCOL)

       LX(1)=IDFEDITGETLOGICAL(ILOGICAL(1),X(1),IDFVAL(1),ICHECK(1),MP(IPLOT(1))%IDF%NODATA,MP(IPLOT(1))%IDF, &
                               JROW,JCOL,MP(IPLOT(1))%IDF%ITYPE)

       !## involve extra idf
       IF(IUSE(2).EQ.1)THEN
        LX(3)=.FALSE.

        !## get irow/icol indices for x/y coordinates
        CALL IDFIROWICOL(MP(IPLOT(2))%IDF,JROW,JCOL,XC,YC)
        IF(JCOL.NE.0.AND.JROW.NE.0)THEN
         IDFVAL(2)=IDFGETVAL(MP(IPLOT(2))%IDF,JROW,JCOL)

         LX(2)=IDFEDITGETLOGICAL(ILOGICAL(2),X(2),IDFVAL(2),ICHECK(2),MP(IPLOT(2))%IDF%NODATA,MP(IPLOT(2))%IDF, &
                                 JROW,JCOL,MP(IPLOT(1))%IDF%ITYPE)
                                 
         SELECT CASE (ILOGICAL(3))
          !## and
          CASE (1)
           IF(LX(1).AND.LX(2))LX(3)=.TRUE.
          !## or
          CASE (2)
           IF(LX(1).OR.LX(2))LX(3)=.TRUE.
         END SELECT
        ENDIF
        LX(1)=LX(3)
       ENDIF

       !## element approves current selection criteria
       IF(LX(1))THEN

        SELECT CASE (IADDSEL)
          !## new/add
          CASE (1,2)
           ITHRD(ICOL,IROW)=INT(1,1)
          !## delete
          CASE (3)
           ITHRD(ICOL,IROW)=INT(0,1)
          !## subset -> convert to 2
          CASE (4)
           IF(ITHRD(ICOL,IROW).EQ.INT(1,1))ITHRD(ICOL,IROW)=INT(2,1)
        END SELECT

       ENDIF
      ENDIF
     ENDIF
    END DO
    CALL UTL_WAITMESSAGE(IRAT,IRAT1,IROW-IR1+1,IR2,'Progress ')
   END DO IRLOOP
  ENDIF
 !## no polygon used!
  IF(IUSE(1).NE.1)EXIT
 ENDDO

 !## construct ysel from ithrd
 CALL IDFEDIT_ITHRD2YSEL(IADDSEL)

 !## redraw current selection
 CALL POLYGON1DRAWYSEL()

 IF(IPLOT(1).NE.0)CLOSE(MP(IPLOT(1))%IDF%IU)
 IF(IPLOT(2).NE.0)CLOSE(MP(IPLOT(2))%IDF%IU)

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

 CALL IDFEDITLOGICALFIELDS()

 END SUBROUTINE IDFEDITLOGICAL

 !###======================================================================
 SUBROUTINE IDFEDIT_YSEL2ITHRD()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,IROW,ICOL

 !## reset selection raster
 ITHRD=INT(0,1)
 DO I=1,SELIDF(1)%NTHREAD
  ICOL            =INT(SELIDF(1)%YSEL(1,I))
  IROW            =INT(SELIDF(1)%YSEL(2,I))
  ITHRD(ICOL,IROW)=INT(1,1)
 END DO

 END SUBROUTINE IDFEDIT_YSEL2ITHRD

 !###======================================================================
 SUBROUTINE IDFEDIT_ITHRD2YSEL(IADDSEL)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IADDSEL
 INTEGER :: N,IROW,ICOL
 INTEGER(KIND=1) :: I

 !## new/add/delete to/from selection
 I=INT(1,1)
 !## subset selection
 IF(IADDSEL.EQ.4)I=INT(2,1)
 
 !## reset selection pointer
 SELIDF(1)%YSEL=INT(0,2)
 N=0
 DO IROW=1,SELIDF(1)%NROW
  DO ICOL=1,SELIDF(1)%NCOL
   IF(ITHRD(ICOL,IROW).EQ.I)THEN !INT(1,1))THEN
    N=N+1
    SELIDF(1)%YSEL(1,N)=INT(ICOL,2)
    SELIDF(1)%YSEL(2,N)=INT(IROW,2)
   ENDIF
  ENDDO
 ENDDO
 SELIDF(1)%NTHREAD=N

 END SUBROUTINE IDFEDIT_ITHRD2YSEL

 !###======================================================================
 SUBROUTINE IDFEDITFIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,N

 I=2
 IF(ALLOCATED(SELIDF))THEN
  N=SELIDF(1)%NTHREAD
  IF(N.EQ.0)THEN
   CALL POLYGON1DEALLOCATE_SELIDF()
   IF(ALLOCATED(ITHRD))DEALLOCATE(ITHRD)
   I=2
  ELSEIF(N.GT.0)THEN
   I=1
  ENDIF
 ENDIF
 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGFIELDSTATE(ID_CALC,I)
 CALL WDIALOGFIELDSTATE(ID_STAT,I)
 CALL WDIALOGFIELDSTATE(ID_CLEAR,I)
 CALL WDIALOGFIELDSTATE(ID_ZOOMFULL,I)
 CALL WDIALOGFIELDSTATE(ID_SHOW,I)
 IF(ALLOCATED(SELIDF))THEN
  CALL WDIALOGPUTSTRING(IDF_LABEL2,TRIM(ITOS(N))//' cells selected out of '// &
       TRIM(ITOS(SELIDF(1)%NCOL*SELIDF(1)%NROW)))
 ELSE
  CALL WDIALOGPUTSTRING(IDF_LABEL2,'Nothing selected')
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_MENU2,I-1)

 END SUBROUTINE IDFEDITFIELDS

 !###======================================================================
 LOGICAL FUNCTION IDFEDITGETLOGICAL(ILOGICAL,X,IDFVAL,ICHECK,NODATA,IDF,JROW,JCOL,IDFTYPE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ILOGICAL,ICHECK
 REAL(KIND=DP_KIND),INTENT(IN) :: IDFVAL,X,NODATA
 INTEGER,INTENT(IN) :: JROW,JCOL,IDFTYPE
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER,DIMENSION(4) :: DC,DR
 INTEGER :: IROW,ICOL,I,J
 DATA DC/ 0, 1, 0,-1/
 DATA DR/-1, 0, 1, 0/
 REAL(KIND=SP_KIND) :: XS,IS
 
 IDFEDITGETLOGICAL=.FALSE.
 IF(ICHECK.EQ.1.AND.IDFVAL.EQ.NODATA)RETURN
 
 !## in case single precision, convert for accurate comparison
 IF(IDFTYPE.EQ.4)THEN
 
  XS=REAL(X,4)
  IS=REAL(IDFVAL,4)
 
  SELECT CASE (ILOGICAL)
   CASE (1)
    IF(IS.EQ.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (2)
    IF(IS.NE.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (3)
    IF(IS.LT.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (4)
    IF(IS.LE.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (5)
    IF(IS.GT.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (6)
    IF(IS.GE.XS)IDFEDITGETLOGICAL=.TRUE.
   CASE (7) !## bnd - see whether cell bounds x
    IF(IS.EQ.XS)THEN
     J=0; DO I=1,SIZE(DC)
      IROW=JROW+DR(I)
      ICOL=JCOL+DC(I)
      IF(IROW.GT.IDF%NROW.OR.IROW.LT.1.OR. &
         ICOL.GT.IDF%NCOL.OR.ICOL.LT.1)THEN
       J=1
      ELSE
       IS=REAL(IDFGETVAL(IDF,IROW,ICOL),4)
       IF(IS.NE.XS)J=1
      ENDIF
     ENDDO
     IF(J.EQ.1)IDFEDITGETLOGICAL=.TRUE.
    ENDIF
   CASE (8,9,10) !## absolute spikes
    J=0; DO I=1,SIZE(DC)
     IROW=MIN(IDF%NROW,MAX(1,JROW+DR(I)))
     ICOL=MIN(IDF%NCOL,MAX(1,JCOL+DC(I)))    
     IF(ABS(REAL(IDFGETVAL(IDF,IROW,ICOL),4)-IS).GT.XS)J=J+1
    ENDDO  
    !## spikes surrounded by lower-values
    IF(ILOGICAL.EQ.8 .AND.J.EQ.4)IDFEDITGETLOGICAL=.TRUE.
    IF(ILOGICAL.EQ.9 .AND.J.EQ.3)IDFEDITGETLOGICAL=.TRUE.
    IF(ILOGICAL.EQ.10.AND.J.EQ.2)IDFEDITGETLOGICAL=.TRUE.
   CASE (11) !## all
    IDFEDITGETLOGICAL=.TRUE.
   CASE (12) !## NaN - not a number
    IF(IS.NE.IS)IDFEDITGETLOGICAL=.TRUE.
   CASE (13) !## Inf
    IF(IS.GT. HUGE(1.0))IDFEDITGETLOGICAL=.TRUE.
    IF(IS.LT.-HUGE(1.0))IDFEDITGETLOGICAL=.TRUE.
   CASE (14) !## NodataValues
    IF(IS.EQ.REAL(NODATA,4))IDFEDITGETLOGICAL=.TRUE.
  END SELECT
 
 !## double precision
 ELSE
 
  SELECT CASE (ILOGICAL)
   CASE (1)
    IF(IDFVAL.EQ.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (2)
    IF(IDFVAL.NE.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (3)
    IF(IDFVAL.LT.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (4)
    IF(IDFVAL.LE.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (5)
    IF(IDFVAL.GT.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (6)
    IF(IDFVAL.GE.X)IDFEDITGETLOGICAL=.TRUE.
   CASE (7) !## bnd - see whether cell bounds x
    IF(IDFVAL.EQ.X)THEN
     J=0; DO I=1,SIZE(DC)
      IROW=JROW+DR(I)
      ICOL=JCOL+DC(I)
      IF(IROW.GT.IDF%NROW.OR.IROW.LT.1.OR. &
         ICOL.GT.IDF%NCOL.OR.ICOL.LT.1)THEN
       J=1
      ELSE
       IF(IDFGETVAL(IDF,IROW,ICOL).NE.X)J=1
      ENDIF
     ENDDO
     IF(J.EQ.1)IDFEDITGETLOGICAL=.TRUE.
    ENDIF
   CASE (8,9,10) !## absolute spikes
    J=0; DO I=1,SIZE(DC)
     IROW=MIN(IDF%NROW,MAX(1,JROW+DR(I)))
     ICOL=MIN(IDF%NCOL,MAX(1,JCOL+DC(I)))    
     IF(ABS(IDFGETVAL(IDF,IROW,ICOL)-IDFVAL).GT.X)J=J+1
    ENDDO  
    !## spikes surrounded by lower-values
    IF(ILOGICAL.EQ.8 .AND.J.EQ.4)IDFEDITGETLOGICAL=.TRUE.
    IF(ILOGICAL.EQ.9 .AND.J.EQ.3)IDFEDITGETLOGICAL=.TRUE.
    IF(ILOGICAL.EQ.10.AND.J.EQ.2)IDFEDITGETLOGICAL=.TRUE.
   CASE (11) !## all
    IDFEDITGETLOGICAL=.TRUE.
   CASE (12) !## NaN - not a number
    IF(IDFVAL.NE.IDFVAL)IDFEDITGETLOGICAL=.TRUE.
   CASE (13) !## Inf
    IF(IDFVAL.GT. HUGE(1.0D0))IDFEDITGETLOGICAL=.TRUE.
    IF(IDFVAL.LT.-HUGE(1.0D0))IDFEDITGETLOGICAL=.TRUE.
   CASE (14) !## NodataValues
    IF(IDFVAL.EQ.NODATA)IDFEDITGETLOGICAL=.TRUE.
  END SELECT
 
 ENDIF
 
 END FUNCTION IDFEDITGETLOGICAL

 !###======================================================================
 SUBROUTINE IDFEDITPIPET()
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER  :: ITYPE,IMENU,IPLOT,IROW,ICOL,DTERM,I,MAXN,IADDSEL
 REAL(KIND=DP_KIND) :: IDFVALUE,XSTOP,MOUSEX,MOUSEY
 INTEGER(KIND=1),POINTER,DIMENSION(:) :: ISPEC 
 INTEGER(KIND=2),POINTER,DIMENSION(:,:) :: THREAD,YSEL
 INTEGER :: MAXTHREAD,NTHREAD,IDRAW,ISTOP
 LOGICAL :: LEX
 
 CALL WDIALOGSELECT(ID_DIDFEDITTAB1); CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)
 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,0)

 !## make sure to get memory
 CALL IDFEDITALLOCATE()
 IF(.NOT.ASSOCIATED(SELIDF(1)%X))THEN
  ALLOCATE(SELIDF(1)%X(SELIDF(1)%NCOL,SELIDF(1)%NROW))
 ENDIF

 IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))THEN
  IF(MP(IPLOT)%IDF%IU.GT.0)THEN
   INQUIRE(UNIT=MP(IPLOT)%IDF%IU,OPENED=LEX)
   IF(LEX)CLOSE(MP(IPLOT)%IDF%IU); MP(IPLOT)%IDF%IU=0
  ENDIF
  RETURN
 ENDIF

 !## store current selection in ithrd-array
 CALL IDFEDIT_YSEL2ITHRD()

 CALL WDIALOGLOAD(ID_DIDFEDITPIPET,ID_DIDFEDITPIPET)
 CALL WDIALOGPUTIMAGE(IDF_PICTURE1,ID_ICONFIVEPOINTS,1)
 CALL WDIALOGPUTIMAGE(IDF_PICTURE2,ID_ICONNINEPOINTS,1)
 CALL WDIALOGPUTSTRING(IDF_GROUP1,'Select values in: '//TRIM(MP(IPLOT)%ALIAS))
 CALL WDIALOGFIELDSTATE(IDF_REAL1,0)
 CALL UTL_DIALOGSHOW(0,0,0,2)
 
!  !## store current selection
! CALL IDFEDITSTORESELECTION()
!
! !## remove current selection from screen
! CALL POLYGON1DRAWYSEL()

 CALL WDIALOGSELECT(ID_DIDFEDITPIPET)
 CALL WDIALOGGETMENU(IDF_MENU1,IMENU)
 CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I); IF(I.EQ.1)IMENU=-1*IMENU
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,DTERM); DTERM=DTERM-1
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,IADDSEL)  !## 1=new;2=add;3=remove;4=subset

 IDRAW=0
 DO 
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   
   CASE (FIELDCHANGED)
    CALL WDIALOGSELECT(ID_DIDFEDITPIPET)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDF_CHECK2)
      CALL WDIALOGGETCHECKBOX(IDF_CHECK2,I)
      CALL WDIALOGFIELDSTATE(IDF_REAL1,I)  
!      !## 1=equal,2=less than,3=less or equal,4=greater than,5=greater than or equal,6=ne,7=never mind
!      CALL WDIALOGGETMENU(IDF_MENU1,IMENU)
!     CASE (IDF_CHECK1)
      !## negative means according to last location during search
!      CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I); IF(I.EQ.1)IMENU=-1*IMENU
!     CASE (IDF_RADIO1,IDF_RADIO2)
!      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,DTERM); DTERM=DTERM-1
!     CASE (IDF_RADIO3,IDF_RADIO4,IDF_RADIO5,IDF_RADIO7)
!      CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,IADDSEL)  !## 1=new;2=add;3=remove;4=subset
    END SELECT
    
   CASE (MENUSELECT)
!    CALL IMOD1MENUSELECT(MESSAGE)
    IF(IDRAW.EQ.0)CALL WCURSORSHAPE(CURARROW)
    IF(IDRAW.EQ.1)CALL WCURSORSHAPE(ID_CURSORPIPET)

   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDCANCEL)
      EXIT
     CASE (IDOK)
      IF(IADDSEL.EQ.1)ITHRD=INT(0,1)
      !## construct ysel from ithrd
      CALL IDFEDIT_ITHRD2YSEL(IADDSEL)
!      !## redraw current selection
!      CALL POLYGON1DRAWYSEL()
      !## restore picture
      CALL IDFPLOTFAST(0)
      IDRAW=1; CALL WCURSORSHAPE(ID_CURSORPIPET)
    END SELECT

   CASE (MOUSEBUTDOWN)
    
    SELECT CASE (MESSAGE%VALUE1)
     
     !## left mouse button
     CASE (1)
  
      !## selected to set location on map
      IF(IDRAW.EQ.1)THEN

       CALL WDIALOGSELECT(ID_DIDFEDITPIPET)
       !## 1=equal,2=less than,3=less or equal,4=greater than,5=greater than or equal,6=ne,7=never mind
       CALL WDIALOGGETMENU(IDF_MENU1,IMENU)
       !## negative means according to last location during search
       CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I); IF(I.EQ.1)IMENU=-1*IMENU
       CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,DTERM); DTERM=DTERM-1
       CALL WDIALOGGETRADIOBUTTON(IDF_RADIO3,IADDSEL)  !## 1=new;2=add;3=remove;4=subset
       CALL WDIALOGGETCHECKBOX(IDF_CHECK2,ISTOP)
       CALL WDIALOGGETDOUBLE(IDF_REAL1,XSTOP)
       
       INQUIRE(FILE=MP(IPLOT)%IDFNAME,OPENED=LEX)
       IF(.NOT.LEX)THEN
        IF(.NOT.IDFOPEN(MP(IPLOT)%IDF%IU,MP(IPLOT)%IDFNAME,'R',MP(IPLOT)%IDF%ITYPE,0,IQUESTION=0))EXIT !## stop pipet action
       ELSE
        INQUIRE(FILE=MP(IPLOT)%IDFNAME,NUMBER=MP(IPLOT)%IDF%IU)
       ENDIF 
       
       MAXTHREAD=1000; ALLOCATE(ISPEC(MAXTHREAD),THREAD(3,MAXTHREAD),YSEL(2,MAXTHREAD)); MAXN=MAXTHREAD
 
       !## set begin values
       NTHREAD=1; YSEL(1,NTHREAD)=ICOL; YSEL(2,NTHREAD)=IROW; SELIDF(1)%X=SELIDF(1)%NODATA
       !## trace all higher than neighbouring cell, imenu=-4, idf(1) will be adjusted
       IF(ISTOP.EQ.0)THEN
        CALL IDFEDITTRACE(MP(IPLOT)%IDF,SELIDF(1),THREAD,YSEL,ISPEC,DTERM,IMENU,MAXTHREAD,MAXN,IDFVALUE,NTHREAD,1) !,I)
       ELSE
        CALL IDFEDITTRACE(MP(IPLOT)%IDF,SELIDF(1),THREAD,YSEL,ISPEC,DTERM,IMENU,MAXTHREAD,MAXN,IDFVALUE,NTHREAD,1,STOPVALUE=XSTOP) !,I,STOPVALUE=XSTOP)
       ENDIF
       !## adjust surface in backwards direction
       IF(NTHREAD.GT.0)THEN
        DO I=1,NTHREAD; ICOL=YSEL(1,I); IROW=YSEL(2,I)
         SELECT CASE (IADDSEL)
          !## new/add
          CASE (1,2)
           ITHRD(ICOL,IROW)=INT(1,1)
          !## delete
          CASE (3)
           ITHRD(ICOL,IROW)=INT(0,1)
          !## subset -> convert to 2
          CASE (4)
           IF(ITHRD(ICOL,IROW).EQ.INT(1,1))ITHRD(ICOL,IROW)=INT(2,1)
         END SELECT
        ENDDO
       ENDIF

       !## redraw current selection
       CALL POLYGON1DRAWYSEL()
       !## construct ysel from ithrd
       CALL IDFEDIT_ITHRD2YSEL(IADDSEL)
       !## redraw current selection
       CALL POLYGON1DRAWYSEL()
    
      ENDIF

     !## right mouse button
     CASE (3)
      IDRAW=0; CALL WCURSORSHAPE(CURARROW)
    
    END SELECT
    
   CASE (MOUSEMOVE)

    MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
    MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

    IF(MP(IPLOT)%IDF%IU.LE.0)THEN
     IF(.NOT.IDFOPEN(MP(IPLOT)%IDF%IU,MP(IPLOT)%IDFNAME,'R',MP(IPLOT)%IDF%ITYPE,0,IQUESTION=0))THEN; ENDIF
    ENDIF
    CALL IDFIROWICOL(MP(IPLOT)%IDF,IROW,ICOL,MOUSEX,MOUSEY) !REAL(MESSAGE%GX,8),REAL(MESSAGE%GY,8))
    IF(IROW.NE.0.AND.ICOL.NE.0)THEN
     IDFVALUE=IDFGETVAL(MP(IPLOT)%IDF,IROW,ICOL)
     CALL WINDOWOUTSTATUSBAR(1,'x = '//TRIM(RTOS(MOUSEX,'G',10))//' m; y = '//TRIM(RTOS(MOUSEY,'G',10))//' m')
!     CALL WINDOWOUTSTATUSBAR(1,'(x:'//TRIM(RTOS(MESSAGE%GX/100.0D0,'F',2))//'km ,y:'// &
!                                      TRIM(RTOS(MESSAGE%GY/100.0D0,'F',2))//'km)')
     CALL WINDOWOUTSTATUSBAR(2,'IDF-value: '//TRIM(RTOS(IDFVALUE,'F',2)))
    ELSE
     CALL WINDOWOUTSTATUSBAR(2,'Outside current idf')
    ENDIF

  END SELECT
 END DO

 CALL WDIALOGSELECT(ID_DIDFEDITPIPET); CALL WDIALOGUNLOAD()
 
 IF(ASSOCIATED(ISPEC)) DEALLOCATE(ISPEC)
 IF(ASSOCIATED(THREAD))DEALLOCATE(THREAD) 
 IF(ASSOCIATED(YSEL))  DEALLOCATE(YSEL) 
 CLOSE(MP(IPLOT)%IDF%IU); MP(IPLOT)%IDF%IU=0
 
 CALL IDFEDITFIELDS()
 
 CALL WDIALOGSELECT(ID_DIDFEDITCALC); CALL WDIALOGPUTCHECKBOX(ID_SHOW,1)
 LPLOTYSEL=.TRUE.

 !## restore picture
 CALL IDFPLOTFAST(0)

 CALL UTL_HIDESHOWDIALOG(ID_DIDFEDIT,2)

 END SUBROUTINE IDFEDITPIPET

 !###======================================================================
 SUBROUTINE IDFEDITCALCINIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I

 CALL WINDOWSELECT(0); CALL WMENUSETSTATE(ID_IDFEDIT,1,0)

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGGETCHECKBOX(ID_SHOW,I)
 CALL WDIALOGSELECT(ID_DIDFEDIT)
 CALL WDIALOGHIDE()

 CALL WDIALOGSELECT(ID_DIDFEDITCALC)
 CALL WDIALOGPUTCHECKBOX(ID_SHOW,I)
 CALL IDFEDITCALCFIELDS()

 CALL WDIALOGPUTMENU(IDF_MENU1,MP%ALIAS,MPW%NACT,1)
 DO IPLOT=1,MXMPLOT; IF(MP(IPLOT)%ISEL)EXIT; END DO
 CALL WDIALOGPUTMENU(IDF_MENU2,MP%ALIAS,MPW%NACT,IPLOT)
 CALL WDIALOGPUTMENU(IDF_MENU4,MP%ALIAS,MPW%NACT,IPLOT)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,0)
 CALL WDIALOGRANGEINTEGER(IDF_INTEGER2,1,100)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER2,2)
 CALL WDIALOGFIELDSTATE(ID_UNDO,2)
 CALL WDIALOGPUTSTRING(ID_UNDO,'Undo Last Action (0)')
 ICALC=0
 
 CALL UTL_DIALOGSHOW(0,0,0,2)

 END SUBROUTINE IDFEDITCALCINIT

 !###======================================================================
 SUBROUTINE IDFEDITCALCCLOSE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IACTION,I
 LOGICAL :: LEX

 CALL WDIALOGSELECT(ID_DIDFEDITCALC)
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,IACTION)
 IF(IACTION.NE.0)THEN
  CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONOK,'Changes cannot be undone after you leave this Editing Mode.'//CHAR(13)//CHAR(13)//&
   'Are you sure to leave this Editing Mode?','Question')
  IF(WINFODIALOG(4).NE.1)RETURN
 ENDIF

 !## remove backtracing files
 DO I=1,IACTION
  INQUIRE(FILE=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_COMPUTED'//TRIM(ITOS(I))//'.DAT',EXIST=LEX)
  IF(LEX)CALL IOSDELETEFILE(TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_COMPUTED'//TRIM(ITOS(I))//'.DAT')
 END DO

 CALL WINDOWSELECT(0); CALL WMENUSETSTATE(ID_IDFEDIT,1,1)

 CALL WDIALOGSELECT(ID_DIDFEDITCALC)
 CALL WDIALOGGETCHECKBOX(ID_SHOW,I)
 CALL WDIALOGHIDE()

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGPUTCHECKBOX(ID_SHOW,I)
 CALL WDIALOGSELECT(ID_DIDFEDIT)
 CALL UTL_DIALOGSHOW(-0,65,0,2)

 CALL IDFPLOTFAST(0)

 END SUBROUTINE IDFEDITCALCCLOSE

 !###======================================================================
 SUBROUTINE IDFEDITCALCMAIN(ITYPE,MESSAGE)
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER,INTENT(IN) :: ITYPE
 INTEGER :: I

 CALL WDIALOGSELECT(ID_DIDFEDITCALC)

 SELECT CASE (ITYPE)

  CASE (FIELDCHANGED)
   CALL WDIALOGSELECT(MESSAGE%WIN)
   IF(MESSAGE%VALUE1.EQ.MESSAGE%VALUE2)THEN
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDF_RADIO1,IDF_RADIO2,IDF_RADIO3,IDF_RADIO4,IDF_RADIO5,IDF_RADIO6,IDF_RADIO7, &
           IDF_RADIO8,IDF_RADIO9,IDF_RADIO10,IDF_RADIO11)
      CALL IDFEDITCALCFIELDS()
     CASE (ID_SHOW)
      CALL POLYGON1DRAWYSEL()
      CALL WDIALOGGETCHECKBOX(ID_SHOW,I)
      IF(I.EQ.0)LPLOTYSEL=.FALSE.
      IF(I.EQ.1)LPLOTYSEL=.TRUE.
      CALL POLYGON1DRAWYSEL()
      CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
      CALL WDIALOGPUTCHECKBOX(ID_SHOW,I)
      CALL WDIALOGSELECT(ID_DIDFEDITCALC)
    END SELECT
   ENDIF
  CASE (PUSHBUTTON)
   CALL WDIALOGSELECT(MESSAGE%WIN)
   SELECT CASE (MESSAGE%VALUE1)
    CASE (ID_UNDO)
     CALL IDFEDITUNDOCALCSELECTION()
    CASE (ID_TABLE)
     CALL UTL_EDITTABLE(); CALL WDIALOGSELECT(ID_DIDFEDITCALC)
    CASE (ID_CALC)
     CALL IDFEDITCALCSELECTION()
     CALL IDFPLOTFAST(0)
     ICALC=1
    CASE (ID_PROPERTIES1)
     CALL PCGSETTINGS(MXITER1,MXITER2,HCLOSE,RCLOSE,ITIGHT,MICNVG,RELAX,IDAMPING,FTIGHT)
     CALL WDIALOGSELECT(ID_DIDFEDITCALC)
    CASE (ID_PROPERTIES2)
     CALL KRIGINGSETTINGS(MAXPNT,KTYPE,RANGE,SILL,NUGGET,PNTSEARCH,COINCIDENT,COINCIDENTDIST,IQUADRANT,0)
     CALL WDIALOGSELECT(ID_DIDFEDITCALC)
    CASE (IDCANCEL)
     IF(ICALC.EQ.0)THEN
      CALL WMESSAGEBOX(YESNOCANCEL,QUESTIONICON,COMMONNO,'Nothing has been modified. Are you sure to leave this dialog?','Question')
      IF(WINFODIALOG(4).EQ.1)CALL IDFEDITCALCCLOSE()
     ELSE
      CALL IDFEDITCALCCLOSE()
     ENDIF
    CASE (ID_SAVE)
     CALL IDFEDITSAVEAS()
   END SELECT

 END SELECT

 END SUBROUTINE IDFEDITCALCMAIN

 !###======================================================================
 SUBROUTINE IDFEDITSAVEAS()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: IDFNAME
 
 IDFNAME=''
 IF(.NOT.UTL_WSELECTFILE('iMOD IDF File (*.idf)|*.idf|', &
  SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,IDFNAME,TITLE='Specify New IDF'))RETURN
 CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(IDFNAME))
 
 END SUBROUTINE IDFEDITSAVEAS
 
 !###======================================================================
 SUBROUTINE IDFEDITCALCSELECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256)   :: FNAME
 INTEGER :: IOS,IROW,ICOL,JROW,JCOL,IACTION,ICHECK,NSMOOTH,I,J,IR,IC,IPLOT, &
     ICALC,N,ISAVE,JPLOT,IC1,IC2,IR1,IR2,NR,NC,KCOL,KROW,NBUFFER,IRAT,&
     IRAT1,IINTOPT,ITABLE,JCALC,IBREAK,RECLEN
 INTEGER :: IU,JU,ND
 REAL(KIND=DP_KIND) :: IDFVAL,XT,NT,DMIN,DMAX
 REAL(KIND=DP_KIND) :: X
 LOGICAL :: LEX
 REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: XD,YD,ZD,PD,WD
 TYPE(IDFOBJ) :: IDF,STDEVIDF,MP_CALC
   
 CALL WDIALOGSELECT(ID_DIDFEDITCALC)
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ICHECK)
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO7,IINTOPT)
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO10,ISAVE)
 CALL WDIALOGGETDOUBLE(IDF_REAL1,X)
 CALL WDIALOGGETINTEGER(IDF_INTEGER2,NSMOOTH)
 CALL WDIALOGGETINTEGER(IDF_INTEGER4,NBUFFER)
 CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)  !## compute to ...
 CALL WDIALOGGETMENU(IDF_MENU1,JPLOT)  !## compute from ...
 CALL WDIALOGGETMENU(IDF_MENU3,ICALC)  !## operator
 CALL WDIALOGGETMENU(IDF_MENU5,JCALC)  !## operator
 CALL WDIALOGGETMENU(IDF_MENU4,ITABLE) !## table
 
 !## show pcg setting to be sure one is not doing something stupid, break if needed
 IF(ICHECK.EQ.5)THEN
  IF(IINTOPT.EQ.2)THEN
   CALL PCGSETTINGS(MXITER1,MXITER2,HCLOSE,RCLOSE,ITIGHT,MICNVG,RELAX,IDAMPING,FTIGHT,IBREAK)
   CALL WDIALOGSELECT(ID_DIDFEDITCALC); IF(IBREAK.EQ.1)RETURN
  ELSEIF(IINTOPT.EQ.3)THEN
   CALL KRIGINGSETTINGS(MAXPNT,KTYPE,RANGE,SILL,NUGGET,PNTSEARCH,COINCIDENT,COINCIDENTDIST,IQUADRANT,0,IBREAK)
   CALL WDIALOGSELECT(ID_DIDFEDITCALC); IF(IBREAK.EQ.1)RETURN
  ENDIF
 ENDIF
 
 !## copy mp(iplot)
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO10,I)
 IF(I.EQ.1)THEN
  CALL IDFCOPY(MP(IPLOT)%IDF,MP_CALC) !=SELECTED IDF
  MP_CALC%FNAME=MP(IPLOT)%IDFNAME
 ELSE
  CALL IDFCOPY(SELIDF(1),MP_CALC) !=SELECTION IDF
  CALL IDFDEALLOCATEX(MP_CALC)
  CALL WDIALOGGETSTRING(IDF_STRING1,MP_CALC%FNAME)
  MP_CALC%IXV=0; IF(.NOT.IDFALLOCATEX(MP_CALC))RETURN
  MP_CALC%X=MP_CALC%NODATA
  !## actually write IDF priorly with nodata only (empty)
  IF(.NOT.IDFWRITE(MP_CALC,MP_CALC%FNAME,0))RETURN
 ENDIF
 
 !## not idf selected
 IF(MP(IPLOT)%IPLOT.NE.1)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Only IDF types are permitted to ASSIGN new values TO','Error'); RETURN
 ENDIF

 IF(ICHECK.EQ.3)THEN
  IF(MP(JPLOT)%IPLOT.NE.1)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Only IDF types are permitted to COPY values FROM','Error'); RETURN
  ENDIF
  IF(IPLOT.EQ.JPLOT)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You cannot copy FROM and TO an identical IDF','Error'); RETURN 
  ENDIF
 ENDIF

 !## use icalc to compute nodata value
 IF(ICHECK.EQ.1)ICALC=0

 !## store previous results of calculation for backward tracing
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,IACTION)
 IACTION=IACTION+1
 FNAME=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_COMPUTED'//TRIM(ITOS(IACTION))//'.DAT'
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='UNFORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot adjust current file'//CHAR(13)// &
    TRIM(FNAME),'Error')
  RETURN
 ENDIF

 CALL WINDOWOUTSTATUSBAR(4,'Busy with calculation ...')

 WRITE(IU) MP_CALC%FNAME

 CALL WINDOWSELECT(0); CALL UTL_MESSAGEHANDLE(0)

 INQUIRE(FILE=MP_CALC%FNAME,OPENED=LEX)
 IF(LEX)CLOSE(MP_CALC%IU)
 MP_CALC%IU=UTL_GETUNIT()
 RECLEN=UTL_GETRECORDLENGTH(MP_CALC%FNAME)
 MP_CALC%ITYPE=RECLEN
 CALL OSD_OPEN(MP_CALC%IU,FILE=MP_CALC%FNAME,STATUS='OLD',FORM='UNFORMATTED',ACCESS='DIRECT', &
                RECL=RECLEN/4,ACTION='READWRITE',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot adjust current file'//CHAR(13)// &
    TRIM(MP_CALC%FNAME)//CHAR(13)//'IDF has been marked probably as READ-ONLY','Error')
  IF(IU.GT.0)CLOSE(IU) 
  RETURN
 ENDIF
 IF(.NOT.IDFREADDIM(0,MP_CALC))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot read header information for file'//CHAR(13)// &
    TRIM(MP_CALC%FNAME),'Error')
  IF(IU.GT.0)CLOSE(IU) 
  RETURN
 ENDIF

 IRAT=0; IRAT1=IRAT
 DMIN=HUGE(1.0D0); DMAX=-HUGE(1.0D0)

 SELECT CASE (ICHECK)

 !## new-value/nodata value
  CASE (1,2)
   DO I=1,SELIDF(1)%NTHREAD
    !## cell-indices from selection
    ICOL=INT(SELIDF(1)%YSEL(1,I))
    IROW=INT(SELIDF(1)%YSEL(2,I))
    !## get x/y coordinates
    CALL IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
    IF(JCOL.NE.0.AND.JROW.NE.0)THEN
     IDFVAL=IDFGETVAL(MP_CALC,JROW,JCOL)
     !## store previous value
     WRITE(IU) JROW,JCOL,IDFVAL
     SELECT CASE (ICALC)
      CASE (0) !nodata value
       IDFVAL=MP_CALC%NODATA
      CASE (1) !=
       IDFVAL=X
      CASE (2) !+
       IF(IDFVAL.NE.MP_CALC%NODATA)IDFVAL=IDFVAL+X
      CASE (3) !-
       IF(IDFVAL.NE.MP_CALC%NODATA)IDFVAL=IDFVAL-X
      CASE (4) !*
       IF(IDFVAL.NE.MP_CALC%NODATA)IDFVAL=IDFVAL*X
      CASE (5) !/
       IF(IDFVAL.NE.MP_CALC%NODATA)IDFVAL=IDFVAL/X
     END SELECT
     !## write result in idf
     CALL IDFPUTVAL(MP_CALC,JROW,JCOL,IDFVAL)
     IF(IDFVAL.NE.MP_CALC%NODATA)THEN
      DMIN=MIN(DMIN,IDFVAL)
      DMAX=MAX(DMAX,IDFVAL)
     ENDIF
    ENDIF
    CALL UTL_WAITMESSAGE(IRAT,IRAT1,I,SELIDF(1)%NTHREAD,'Busy calculating ...')
   ENDDO

  !## idf-value from a different idf
  CASE (3)
   IF(IDFOPEN(MP(JPLOT)%IDF%IU,MP(JPLOT)%IDFNAME,'R',MP(JPLOT)%IDF%ITYPE,0,IQUESTION=0))THEN

    DO J=1,SELIDF(1)%NTHREAD
     ICOL=INT(SELIDF(1)%YSEL(1,J)); IROW=INT(SELIDF(1)%YSEL(2,J))
     CALL IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
     IF(JCOL.NE.0.AND.JROW.NE.0)THEN
      IDFVAL=IDFGETVAL(MP_CALC,JROW,JCOL); X=IDFVAL
      !## store previous value
      WRITE(IU) JROW,JCOL,IDFVAL
      CALL IDFEDITGETCURRENTNODE(ICOL,IROW,JPLOT,KCOL,KROW)
      IF(KCOL.NE.0.AND.KROW.NE.0)THEN
       IDFVAL=IDFGETVAL(MP(JPLOT)%IDF,KROW,KCOL)
       
       IF(JCALC.NE.1)THEN
        IF(X.NE.MP_CALC%NODATA.AND.IDFVAL.NE.MP(JPLOT)%IDF%NODATA)THEN
         SELECT CASE (JCALC)
          CASE (2) !+
           IDFVAL=X+IDFVAL
          CASE (3) !-
           IDFVAL=X-IDFVAL
          CASE (4) !*
           IDFVAL=X*IDFVAL
          CASE (5) !/
           IDFVAL=X/IDFVAL
         END SELECT
        ENDIF
       ELSE
        !## if new value equal to its nodata, set it to the nodata of the new idf
        IF(IDFVAL.EQ.MP(JPLOT)%IDF%NODATA)THEN
         IDFVAL=MP_CALC%NODATA
        ENDIF
       ENDIF

       !## write result in idf
       CALL IDFPUTVAL(MP_CALC,JROW,JCOL,IDFVAL)
       DMIN=MIN(DMIN,IDFVAL)
       DMAX=MAX(DMAX,IDFVAL)
      ENDIF
     ENDIF
     CALL UTL_WAITMESSAGE(IRAT,IRAT1,J,SELIDF(1)%NTHREAD,'Busy calculating ...')
    ENDDO
    CLOSE(MP(JPLOT)%IDF%IU)

   ENDIF

  !## smoothing
  CASE (4)

   DO I=1,NSMOOTH
    DO J=1,SELIDF(1)%NTHREAD
     ICOL=INT(SELIDF(1)%YSEL(1,J)); IROW=INT(SELIDF(1)%YSEL(2,J))
     CALL IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
     IF(JCOL.NE.0.AND.JROW.NE.0)THEN
      IDFVAL=IDFGETVAL(MP_CALC,JROW,JCOL)
      !## store previous value
      IF(I.EQ.1)WRITE(IU) JROW,JCOL,IDFVAL
      !## determine next value after smoothing
      NT=0.0D0; XT=0.0D0
      DO IR=MAX(1,JROW-NBUFFER),MIN(MP_CALC%NROW,JROW+NBUFFER)
       DO IC=MAX(1,JCOL-NBUFFER),MIN(MP_CALC%NCOL,JCOL+NBUFFER)
        IDFVAL=IDFGETVAL(MP_CALC,IR,IC)
        IF(IDFVAL.NE.MP_CALC%NODATA)THEN
         XT=XT+IDFVAL
         NT=NT+1.0D0
        ENDIF
       END DO
      END DO
      !## write result in idf
      IF(NT.GT.0.0D0)THEN
       IDFVAL=XT/NT 
       CALL IDFPUTVAL(MP_CALC,JROW,JCOL,IDFVAL) 
       DMIN=MIN(DMIN,IDFVAL); DMAX=MAX(DMAX,IDFVAL)
      ENDIF
     ENDIF
     CALL UTL_WAITMESSAGE(IRAT,IRAT1,J,SELIDF(1)%NTHREAD,'Busy calculating ('//TRIM(ITOS(I))//'-'//TRIM(ITOS(NSMOOTH))//' ...')
    ENDDO
   ENDDO
   
  !## interpolate selected points
  CASE (5)

   CALL UTL_WAITMESSAGE(IRAT,IRAT1,J,SELIDF(1)%NTHREAD,'Busy interpolating ...')

   N=SELIDF(1)%NTHREAD
   IC1=MINVAL(SELIDF(1)%YSEL(1,1:N))-1; IC2=MAXVAL(SELIDF(1)%YSEL(1,1:N))+1
   IR1=MINVAL(SELIDF(1)%YSEL(2,1:N))-1; IR2=MAXVAL(SELIDF(1)%YSEL(2,1:N))+1
   IC1=MAX(1,IC1); IC2=MIN(SELIDF(1)%NCOL,IC2)
   IR1=MAX(1,IR1); IR2=MIN(SELIDF(1)%NROW,IR2)
   NR=IR2-IR1+1; NC=IC2-IC1+1
   CALL IDFNULLIFY(IDF); CALL IDFNULLIFY(STDEVIDF); IDF%IEQ=0; IDF%ITB=0
   IDF%DX=SELIDF(1)%DX; IDF%DY=SELIDF(1)%DY; IDF%NODATA=0.0D0
   CALL IDFGETLOC(SELIDF(1),IR2,IC1,IDF%XMIN,IDF%YMIN)
   CALL IDFGETLOC(SELIDF(1),IR1,IC2,IDF%XMAX,IDF%YMAX) 
   IDF%XMIN=IDF%XMIN-(IDF%DX/2.0D0); IDF%YMIN=IDF%YMIN-(IDF%DY/2.0D0)
   IDF%XMAX=IDF%XMAX+(IDF%DX/2.0D0); IDF%YMAX=IDF%YMAX+(IDF%DY/2.0D0)
   IDF%NCOL=(IDF%XMAX-IDF%XMIN)/IDF%DX; IDF%NROW=(IDF%YMAX-IDF%YMIN)/IDF%DY
   IF(.NOT.IDFALLOCATEX(IDF))THEN; ENDIF; IDF%X=0.0D0
   !## mark selected points
   DO J=1,SELIDF(1)%NTHREAD
    ICOL=INT(SELIDF(1)%YSEL(1,J)); IROW=INT(SELIDF(1)%YSEL(2,J))
    CALL IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
    IF(JCOL.NE.0.AND.JROW.NE.0)THEN
     IDFVAL=IDFGETVAL(MP_CALC,JROW,JCOL)
     !## store previous value
     WRITE(IU) JROW,JCOL,IDFVAL
     ICOL=ICOL-IC1+1; IROW=IROW-IR1+1
     !## selected location
     IDF%X(ICOL,IROW)=1.0D0 
    ENDIF
   ENDDO

   !## get fixed points - direct next to the selected zone(s) (only if not equal to nodata value)
   DO IROW=1,NR; DO ICOL=1,NC
    IF(IDF%X(ICOL,IROW).EQ.1.0D0)THEN
     DO IR1=MAX(1,IROW-1),MIN(IROW+1,NR); DO IC1=MAX(1,ICOL-1),MIN(ICOL+1,NC)
      IF(IDF%X(IC1,IR1).EQ.0.0D0)IDF%X(IC1,IR1)=2.0D0
     ENDDO; ENDDO
    ENDIF
   ENDDO; ENDDO
   ND=0; DO IROW=1,NR; DO ICOL=1,NC; IF(IDF%X(ICOL,IROW).EQ.2.0)ND=ND+1; ENDDO; ENDDO 
   !## number data points
   ALLOCATE(XD(ND),YD(ND),ZD(ND),PD(ND),WD(ND))

   IC1=MINVAL(SELIDF(1)%YSEL(1,1:N))-1; IC2=MAXVAL(SELIDF(1)%YSEL(1,1:N))+1
   IR1=MINVAL(SELIDF(1)%YSEL(2,1:N))-1; IR2=MAXVAL(SELIDF(1)%YSEL(2,1:N))+1
   IC1=MAX(1,IC1); IC2=MIN(SELIDF(1)%NCOL,IC2)
   IR1=MAX(1,IR1); IR2=MIN(SELIDF(1)%NROW,IR2)
   ND=0; DO IROW=1,NR; DO ICOL=1,NC
    IF(IDF%X(ICOL,IROW).EQ.2.0)THEN
     CALL IDFEDITGETCURRENTNODE(ICOL+IC1-1,IROW+IR1-1,IPLOT,JCOL,JROW)
     IF(JCOL.NE.0.AND.JROW.NE.0)THEN
      ND=ND+1
      !## bivariate (x,y,z)
      IF(IINTOPT.EQ.1)THEN
       CALL IDFGETLOC(MP_CALC,JROW,JCOL,XD(ND),YD(ND))
      !## pcg/kriging solver (icol,irow,z)
      ELSEIF(IINTOPT.EQ.2)THEN
       XD(ND)=REAL(ICOL); YD(ND)=REAL(IROW)
      ELSEIF(IINTOPT.EQ.3)THEN
       CALL IDFGETLOC(MP_CALC,JROW,JCOL,XD(ND),YD(ND))
      ENDIF
      ZD(ND)=0.0D0
      PD(ND)=IDFGETVAL(MP_CALC,JROW,JCOL)     
      !## remove point whenever equal to nodata
      IF(PD(ND).EQ.MP_CALC%NODATA)ND=ND-1
     ENDIF
    ENDIF
   ENDDO; ENDDO 

   SELECT CASE (IINTOPT)
    !## bivariate
    CASE (1)
     CALL BIVARIATE_INT(XD,YD,PD,ND,IOS,IDF)
    !## pcg solver
    CASE (2)
     CALL SOLID_PCGINT(XD,YD,PD,ND,IOS,IDF,1)
    !## kriging
    CASE (3)
     CALL IDFCOPY(IDF,STDEVIDF)
     !## set all cells to be interpolated to nodata
     DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL
      IF(IDF%X(ICOL,IROW).EQ.1)IDF%X(ICOL,IROW)=IDF%NODATA
     ENDDO; ENDDO
     CALL KRIGING_MAIN(SIZE(XD),XD,YD,ZD,PD,WD,IDF,STDEVIDF,0,0.0D0)
   END SELECT
   
   !## successfully completed interpolation
   IF(IOS.EQ.0)THEN   
    IC1=MINVAL(SELIDF(1)%YSEL(1,1:N))-1; IC2=MAXVAL(SELIDF(1)%YSEL(1,1:N))+1
    IR1=MINVAL(SELIDF(1)%YSEL(2,1:N))-1; IR2=MAXVAL(SELIDF(1)%YSEL(2,1:N))+1
    IC1=MAX(1,IC1); IC2=MIN(SELIDF(1)%NCOL,IC2)
    IR1=MAX(1,IR1); IR2=MIN(SELIDF(1)%NROW,IR2)
    DO J=1,SELIDF(1)%NTHREAD
     ICOL=INT(SELIDF(1)%YSEL(1,J)); IROW=INT(SELIDF(1)%YSEL(2,J))
     CALL IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
     IF(JCOL.NE.0.AND.JROW.NE.0)THEN
      IROW=IROW-IR1+1; ICOL=ICOL-IC1+1
      !## write results
      CALL IDFPUTVAL(MP_CALC,JROW,JCOL,IDF%X(ICOL,IROW))
      DMIN=MIN(DMIN,IDF%X(ICOL,IROW)); DMAX=MAX(DMAX,IDF%X(ICOL,IROW))
     ENDIF
    ENDDO
   ENDIF
   CALL IDFDEALLOCATEX(IDF); CALL IDFDEALLOCATEX(STDEVIDF)
   DEALLOCATE(XD,YD,ZD,PD,WD)
 !## table
 CASE (6)
  JU=UTL_GETUNIT()
  CALL OSD_OPEN(JU,FILE=TRIM(PREFVAL(1))//'\TMP\IDFEDIT_'//TRIM(OSD_GETENV('USERNAME'))//'.CSV',IOSTAT=IOS,ACTION='READ')
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot read the spreadsheet from the temporary file:'//CHAR(13)// &
       TRIM(PREFVAL(1))//'\TMP\IDFEDIT_'//TRIM(OSD_GETENV('USERNAME'))//'.CSV','Error') 
  ENDIF
  DO J=1,SELIDF(1)%NTHREAD
   READ(JU,*) ICOL,IROW,X
   IDFVAL=IDFGETVAL(MP_CALC,IROW,ICOL)
   WRITE(IU) IROW,ICOL,IDFVAL
   CALL IDFPUTVAL(MP_CALC,IROW,ICOL,X)
  ENDDO
  CLOSE(JU)
  
 END SELECT

 !## write dmin/dmax again
 MP_CALC%DMIN=MIN(DMIN,MP_CALC%DMIN)
 MP_CALC%DMAX=MAX(DMAX,MP_CALC%DMAX)
 IF(MP_CALC%ITYPE.EQ.4)THEN
  WRITE(MP_CALC%IU,REC=8) REAL(MP_CALC%DMIN,4)
  WRITE(MP_CALC%IU,REC=9) REAL(MP_CALC%DMAX,4)
 ELSEIF(MP_CALC%ITYPE.EQ.8)THEN
  WRITE(MP_CALC%IU,REC=8) MP_CALC%DMIN
  WRITE(MP_CALC%IU,REC=9) MP_CALC%DMAX
 ENDIF
 CLOSE(MP_CALC%IU)
 CALL IDFDEALLOCATEX(MP_CALC)

 CALL UTL_MESSAGEHANDLE(1)

 CLOSE(IU)

 CALL WINDOWOUTSTATUSBAR(4,'')

 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,IACTION)
 CALL WDIALOGFIELDSTATE(ID_UNDO,1)
 CALL WDIALOGPUTSTRING(ID_UNDO,'Undo Last Action ('//TRIM(ITOS(IACTION))//')')

 END SUBROUTINE IDFEDITCALCSELECTION

 !###======================================================================
 SUBROUTINE IDFEDITGETCURRENTNODE(ICOL,IROW,IPLOT,JCOL,JROW)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IPLOT,IROW,ICOL
 INTEGER,INTENT(OUT) :: JCOL,JROW
 REAL(KIND=DP_KIND) :: XC,YC

 !## get x/y coordinates
 CALL IDFGETLOC(SELIDF(1),IROW,ICOL,XC,YC)
 !## get irow/icol for current idf
 CALL IDFIROWICOL(MP(IPLOT)%IDF,JROW,JCOL,XC,YC)

 END SUBROUTINE IDFEDITGETCURRENTNODE

 !###======================================================================
 SUBROUTINE IDFEDITUNDOCALCSELECTION()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: FNAME
 INTEGER :: IOS,IACTION,IROW,ICOL,RECLEN
 INTEGER,DIMENSION(2) :: IU
 REAL(KIND=DP_KIND) :: IDFVAL
 LOGICAL :: LEX
 TYPE(IDFOBJ) :: IDF

 !## store previous results of calculation for backward tracing
 CALL WDIALOGGETINTEGER(IDF_INTEGER1,IACTION)
 FNAME=TRIM(PREFVAL(1))//'\TMP\'//TRIM(OSD_GETENV('USERNAME'))//'_COMPUTED'//TRIM(ITOS(IACTION))//'.DAT'
 IU(1)=UTL_GETUNIT()
 CALL OSD_OPEN(IU(1),FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='UNFORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot read current file'//CHAR(13)// &
    TRIM(FNAME),'Error')
  RETURN
 ENDIF

 CALL WINDOWOUTSTATUSBAR(4,'Busy with undoing calculation '//TRIM(ITOS(IACTION))//' ...')

 READ(IU(1),IOSTAT=IOS) FNAME

 INQUIRE(FILE=FNAME,EXIST=LEX)
 IF(LEX)THEN

  IDF%IU=UTL_GETUNIT()
  RECLEN=UTL_GETRECORDLENGTH(FNAME)
  IDF%ITYPE=RECLEN
  CALL OSD_OPEN(IDF%IU,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED',ACCESS='DIRECT', &
                 RECL=RECLEN/4,ACTION='READWRITE',IOSTAT=IOS)
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD can reset current file'//CHAR(13)// &
     TRIM(FNAME)//CHAR(13)//'IDF has been marked probably as READ-ONLY','Error')
   CLOSE(IU(1))
   RETURN
  ENDIF
  IF(.NOT.IDFREADDIM(0,IDF))THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot read header information for file'//CHAR(13)// &
     TRIM(FNAME),'Error')
   CLOSE(IU(1))
   RETURN
  ENDIF
  DO
   !## read icol/irow selection
   READ(IU(1),IOSTAT=IOS) IROW,ICOL,IDFVAL
   IF(IOS.NE.0)EXIT
   !## write results
   CALL IDFPUTVAL(IDF,IROW,ICOL,IDFVAL)
  ENDDO
  CALL IDFDEALLOCATEX(IDF)

  CLOSE(IDF%IU)
  IDF%IU=0

 ENDIF
 CLOSE(IU(1),STATUS='DELETE')

 CALL WINDOWOUTSTATUSBAR(4,'')

 IACTION=MAX(0,IACTION-1)
 CALL WDIALOGPUTINTEGER(IDF_INTEGER1,IACTION)
 IF(IACTION.LE.0)THEN
  CALL WDIALOGPUTSTRING(ID_UNDO,'No Actions to undo')
  CALL WDIALOGFIELDSTATE(ID_UNDO,2)
 ELSE
  CALL WDIALOGPUTSTRING(ID_UNDO,'Undo Last Action ('//TRIM(ITOS(IACTION))//')')
 ENDIF

 CALL IDFPLOTFAST(0)

 END SUBROUTINE IDFEDITUNDOCALCSELECTION

 !###======================================================================
 SUBROUTINE IDFEDITCALCFIELDS()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,K,L,M,ID

 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,ID)
 I=0; J=0; K=0; L=0; M=0
 SELECT CASE (ID)
  CASE (2); I=1
  CASE (3); J=1
  CASE (4); K=1
  CASE (5); L=1
  CASE (6); M=1
 END SELECT
 !## nodata
 !## new value
 CALL WDIALOGFIELDSTATE(IDF_MENU3,I)
 CALL WDIALOGFIELDSTATE(IDF_REAL1,I)
 !## copy values
 CALL WDIALOGFIELDSTATE(IDF_MENU1,J)
 CALL WDIALOGFIELDSTATE(IDF_MENU5,J)
 !## smooth
 CALL WDIALOGFIELDSTATE(IDF_INTEGER2,K)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER4,K)
 CALL WDIALOGFIELDSTATE(IDF_LABEL1,K)
 CALL WDIALOGFIELDSTATE(IDF_LABEL5,K)
 !## interpolate
 CALL WDIALOGFIELDSTATE(IDF_RADIO7,L)
 CALL WDIALOGFIELDSTATE(IDF_RADIO8,L)
 CALL WDIALOGFIELDSTATE(IDF_RADIO9,L)
 !## table
 CALL WDIALOGFIELDSTATE(IDF_MENU4,M)
 CALL WDIALOGFIELDSTATE(ID_TABLE,M)
 IF(M.EQ.1)THEN
  CALL WDIALOGGETMENU(IDF_MENU4,I)
  CALL WDIALOGPUTOPTION(IDF_MENU1,I)
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_MENU1,ABS(M-1))
 CALL WDIALOGFIELDSTATE(IDF_STRING1,ABS(M-1))
 CALL WDIALOGFIELDSTATE(ID_SAVE,ABS(M-1)) 
 
 CALL WDIALOGGETRADIOBUTTON(IDF_RADIO10,ID)
 IF(ID.EQ.1)THEN
  I=1; J=0
 ELSE
  I=0; J=1
 ENDIF
 CALL WDIALOGFIELDSTATE(IDF_MENU2,I)
 CALL WDIALOGFIELDSTATE(IDF_STRING1,J)
 CALL WDIALOGFIELDSTATE(ID_SAVE,J)
 
 END SUBROUTINE IDFEDITCALCFIELDS

 !###======================================================================
 SUBROUTINE IDFEDITALLOCATE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGGETMENU(IDF_MENU2,IPLOT)
! IF(MP(IPLOT)%IPLOT.NE.1)THEN
!  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'You need to select an IDF file.','Error')
!  RETURN
! ENDIF
  
 IF(.NOT.ALLOCATED(SELIDF))THEN

  IF(.NOT.IDFREAD(MP(IPLOT)%IDF,MP(IPLOT)%IDFNAME,0))RETURN

  ALLOCATE(SELIDF(1))
  CALL IDFNULLIFY(SELIDF(1))
  !NULLIFY(SELIDF(1)%SX,SELIDF(1)%SY,SELIDF(1)%X,SELIDF(1)%V,SELIDF(1)%YSEL,SELIDF(1)%COMMENT)
  MP(IPLOT)%IDF%IXV=2
  !## copy settings
  CALL IDFCOPY(MP(IPLOT)%IDF,SELIDF(1))   !## selidf(1)=mp(iplot)%idf
  IF(.NOT.IDFALLOCATEX(SELIDF(1)))THEN; ENDIF
  IF(.NOT.ASSOCIATED(SELIDF(1)%SX).OR..NOT.ASSOCIATED(SELIDF(1)%SY))THEN
   IF(.NOT.IDFALLOCATESXY(SELIDF(1)))THEN; ENDIF
  ENDIF
!  SELIDF(1)%IXV =2                        !## usages of nthreads, ysel -> selidf(1)%ysel()
!  ALLOCATE(SELIDF(1)%YSEL(2,ITHRD(SELIDF(1)%NCOL*SELIDF(1)%NROW))
  CLOSE(MP(IPLOT)%IDF%IU)
  MP(IPLOT)%IDF%IXV=0
  CALL IDFDEALLOCATEX(MP(IPLOT)%IDF)

  ALLOCATE(ITHRD(SELIDF(1)%NCOL,SELIDF(1)%NROW))

 ENDIF

 END SUBROUTINE IDFEDITALLOCATE

 !###======================================================================
 SUBROUTINE IDFEDITINIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I
 CHARACTER(LEN=52),DIMENSION(:),ALLOCATABLE :: TMPNAME
 
 CALL WINDOWSELECT(0)
 IF(WMENUGETSTATE(ID_IDFEDIT,2).EQ.1)THEN
  CALL IDFEDITCLOSE(); RETURN
 ENDIF

 CALL MAIN_UTL_INACTMODULE(ID_IDFEDIT)

 !## other module no closed, no approvement given
 IF(IDIAGERROR.EQ.1)RETURN

 CALL WMENUSETSTATE(ID_IDFEDIT,2,1)

 CALL WDIALOGLOAD(ID_DIDFEDITCALC,ID_DIDFEDITCALC)
 CALL WDIALOGPUTIMAGE(ID_SHOW,ID_ICONGLASSES,1)
 CALL WDIALOGPUTIMAGE(ID_UNDO,ID_ICONUNDO,1)
 CALL WDIALOGPUTIMAGE(ID_PROPERTIES1,ID_ICONPROPERTIES,1)
 CALL WDIALOGPUTIMAGE(ID_PROPERTIES2,ID_ICONPROPERTIES,1)
 CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVEAS,1)
 CALL WDIALOGPUTIMAGE(ID_TABLE,ID_ICONEDITATTRIB,1)

 CALL WDIALOGPUTCHECKBOX(ID_SHOW,1)
 LPLOTYSEL  =.TRUE.
 IACTIONISEL=0  !## backward compatible for selection

 CALL WDIALOGLOAD(ID_DIDFEDIT,ID_DIDFEDIT)
 CALL POLYGON1IMAGES(ID_DIDFEDIT)
 CALL WDIALOGPUTIMAGE(ID_GRIDSIZE,ID_ICONNETWORK,1)
 CALL WDIALOGFIELDSTATE(ID_GRIDSIZE,2)

 CALL WDIALOGSELECT(ID_DIDFEDITTAB1)
 CALL WDIALOGPUTIMAGE(ID_SHOW,ID_ICONGLASSES,1)
 CALL WDIALOGPUTIMAGE(ID_ZOOMFULL,ID_ICONZOOMFULL,1)

 DO I=1,MXMPLOT; IF(DRWLIST(I).EQ.1.AND.MP(I)%IPLOT.EQ.1)EXIT; END DO
 IF(I.GT.MXMPLOT)I=1
 ALLOCATE(TMPNAME(MPW%NACT)); TMPNAME=MP%ALIAS
 CALL WDIALOGPUTMENU(IDF_MENU2,TMPNAME,MPW%NACT,I)
 DEALLOCATE(TMPNAME)
 CALL WDIALOGFIELDSTATE(IDF_MENU2,1)

 CALL WDIALOGSELECT(ID_DIDFEDITTAB2)
 CALL WDIALOGPUTMENU(IDF_MENU2,MP%ALIAS,MPW%NACT,I)
! CALL WDIALOGPUTIMAGE(ID_SAVE,ID_ICONSAVE,1)
! CALL WDIALOGPUTIMAGE(ID_SAVEAS,ID_ICONSAVEAS,1)

 CALL WDIALOGPUTMENU(IDF_MENU1,SCLNAMES_UP,SIZE(SCLNAMES_UP),2)
 CALL WDIALOGPUTMENU(IDF_MENU3,SCLNAMES_DOWN,SIZE(SCLNAMES_DOWN),1)
 
 CALL IDFEDITFIELDS(); CALL IDFEDITLOGICALINIT()
 CALL POLYGON1INIT(); CALL POLYGON1FIELDS(ID_DIDFEDIT)

 IF(ALLOCATED(XGRIDSIZE))DEALLOCATE(XGRIDSIZE); ALLOCATE(XGRIDSIZE(MAXSHAPES)); XGRIDSIZE=0.0D0
 CALL WDIALOGSELECT(ID_DIDFEDIT); CALL UTL_DIALOGSHOW(-0,65,0,2)

 SILL=60.0D0; RANGE=1000.0D0; NUGGET=0.0D0; KTYPE=-2; PNTSEARCH=0
 COINCIDENT=0.0D0; IQUADRANT=0; MAXPNT=10

 END SUBROUTINE IDFEDITINIT
 
END MODULE MOD_IDFEDIT