!!  Copyright (C) Stichting Deltares, 2005-2017.
!!
!!  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_POLYGON_UTL

USE WINTERACTER
USE RESOURCE
USE MOD_POLYGON_PAR
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_UTL, ONLY : ITOS,RTOS,UTL_GETUNIT,UTL_WSELECTFILE,UTL_CREATEDIR,UTL_GENLABELSREAD, &
          UTL_GENLABELSDEALLOCATE,UTL_GENLABELSWRITE,VAR,NV,NL,IV,VAR_TMP,MAXLEN,DVAR,CCNST
USE MOD_IDF, ONLY : IDFDEALLOCATE
USE MOD_SPOINTS_PAR
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_GENPLOT, ONLY : TOPOSHPTOGEN

!CHARACTER(LEN=MAXLEN),POINTER,DIMENSION(:,:),PRIVATE :: VAR
!CHARACTER(LEN=MAXLEN),POINTER,DIMENSION(:),PRIVATE :: CCNST
!INTEGER,ALLOCATABLE,DIMENSION(:),PRIVATE :: IVAR,ICOL_VAR,IACT_VAR

CONTAINS

 !###======================================================================
 SUBROUTINE POLYGON_FILLDATAGRID(FNAME) 
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: FNAME
 INTEGER :: ITYPE,I,J,K,IU,ICOL,IROW,NLL,NP
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,ALLOCATABLE,DIMENSION(:) :: ICOLS
 CHARACTER(LEN=MAXLEN) :: LABELNAME
  
 NP=0; DO I=1,SHPNO; IF(SHPTYPE(I).NE.ID_POINT)NP=NP+1; ENDDO 
 
 !## reading labels
 IF(LEN_TRIM(FNAME).GT.0)THEN
  CALL UTL_GENLABELSREAD(FNAME,VAR,NL,NV) 
  IF(NV.LE.0.OR.NL.LE.0.OR..NOT.ASSOCIATED(VAR))RETURN
 ELSE
  IF(.NOT.ASSOCIATED(VAR))THEN
   CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONYES,'Do you want to add additional data to the shapes?','Question')
   IF(WINFODIALOG(4).NE.1)RETURN
   NV=3; NL=SHPNO; ALLOCATE(VAR(NV,0:NL)); VAR=''
   !## not all equal to points
   IF(NP.NE.0)THEN
    VAR(1,0)='ShapeID'; VAR(2,0)='ShapeType'; VAR(3,0)='Variable'
   ELSE
    VAR(1,0)='X-crd (UTM)'; VAR(2,0)='Y-crd (UTM)'; VAR(3,0)='Variable'
   ENDIF
   DO I=1,SHPNO  
    SELECT CASE (SHPTYPE(I))
     CASE (ID_POLYGON); VAR(1,I)=TRIM(ITOS(SHPID(I)));   VAR(2,I)='Polygon'
     CASE (ID_POINT);   VAR(1,I)=RTOS(SHPXC(1,I),'F',3); VAR(2,I)=RTOS(SHPYC(1,I),'F',3)
     CASE (ID_LINE);    VAR(1,I)=TRIM(ITOS(SHPID(I)));   VAR(2,I)='Lines'
    END SELECT
    VAR(3,I)=TRIM(SHPNAME(I))
   ENDDO
  ELSE
   !## update coordinates for points
   DO I=1,SHPNO  
    SELECT CASE (SHPTYPE(I))
     CASE (ID_POINT)
      VAR(1,I)=RTOS(SHPXC(1,I),'F',2); VAR(2,I)=RTOS(SHPYC(1,I),'F',2)
    END SELECT
   ENDDO
  ENDIF
 ENDIF
 
 !## copy of dbase
 ALLOCATE(DVAR(NV,0:NL)); DVAR=VAR
 
 !## nothing selected, take everything
 NLL=SUM(SHPIACT(1:SHPNO)); IF(NLL.EQ.0)SHPIACT=1; NLL=SUM(SHPIACT(1:SHPNO))
 
 CALL WDIALOGLOAD(ID_DGENDATA)
 CALL WDIALOGTITLE('Content of file: '//TRIM(FNAME))
 IF(NLL.GT.WINFOGRID(IDF_GRID1,GRIDROWSMAX))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot display all data ('//TRIM(ITOS(NLL))//' records) in:'//CHAR(13)// &
  TRIM(FNAME)//'.'//CHAR(13)//'Only first '//TRIM(ITOS(WINFOGRID(IDF_GRID1,GRIDROWSMAX)))//&
  ' records will be displayed','Error')
 ENDIF

 ALLOCATE(ICOLS(NV)); ICOLS=1; CALL WGRIDCOLUMNS(IDF_GRID1,NV,ICOLS); DEALLOCATE(ICOLS)
 CALL WGRIDROWS(IDF_GRID1,NLL)
 CALL WDIALOGPUTIMAGE(ID_PLUS,ID_ICONPLUS)
 CALL WDIALOGPUTIMAGE(ID_MIN,ID_ICONMIN)
 CALL WDIALOGPUTIMAGE(ID_RENAME,ID_ICONRENAME)
 
 !## put labels
 DO I=1,NV; CALL WGRIDLABELCOLUMN(IDF_GRID1,I,TRIM(VAR(I,0))); END DO
 K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1; DO J=1,NV; CALL WGRIDPUTCELLSTRING(IDF_GRID1,J,K,TRIM(VAR(J,I))); END DO; END DO
 CALL WDIALOGPUTCHECKBOX(IDF_CHECK1,MAX(0,MIN(IV,1)))
 IV=MIN(NV,MAX(1,IV)); CALL WDIALOGPUTMENU(IDF_MENU1,VAR(:,0),NV,IV)
 
 !## outgrey the first column, they are used internally
 IF(NP.NE.0)THEN
  CALL WGRIDSTATE(IDF_GRID1,1,0)
  CALL WGRIDSTATE(IDF_GRID1,2,0)
 ENDIF
 
 ICOL=0; CALL WDIALOGSHOW(-1,-1,0,3)
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (FIELDCHANGED)
    SELECT CASE (MESSAGE%VALUE2)
     CASE (IDF_GRID1)
      CALL WGRIDPOS(MESSAGE%Y,ICOL,IROW)     
    END SELECT
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (ID_PLUS)
      CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
      CALL WDIALOGSHOW(-1,-1,0,3)
      CALL WDIALOGPUTSTRING(IDF_LABEL1,'Give an attribute name')
      CALL WDIALOGPUTSTRING(IDF_STRING1,'Attribute'//TRIM(ITOS(NV+1)))
      DO
       CALL WMESSAGE(ITYPE,MESSAGE)
       SELECT CASE (ITYPE)
        CASE (PUSHBUTTON)
         SELECT CASE (MESSAGE%VALUE1)
          CASE (IDOK,IDCANCEL)
           CALL WDIALOGGETSTRING(IDF_STRING1,LABELNAME); EXIT
         END SELECT
       END SELECT
      ENDDO
      CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DGENDATA)
      K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1; DO J=2,NV; CALL WGRIDGETCELLSTRING(IDF_GRID1,J,K,VAR(J,I)); ENDDO; ENDDO
      ALLOCATE(VAR_TMP(NV+1,0:NL)); VAR_TMP(1:NV,0:NL)=VAR(1:NV,0:NL); DEALLOCATE(VAR); VAR=>VAR_TMP
      NV=NV+1; VAR(NV,:)=''; VAR(NV,0)=TRIM(LABELNAME) 
      CALL WDIALOGCLEARFIELD(IDF_GRID1)
      ALLOCATE(ICOLS(NV)); ICOLS=1; CALL WGRIDCOLUMNS(IDF_GRID1,NV,ICOLS); DEALLOCATE(ICOLS)
      DO I=1,NV; CALL WGRIDLABELCOLUMN(IDF_GRID1,I,TRIM(VAR(I,0))); END DO
      K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1; DO J=1,NV; CALL WGRIDPUTCELLSTRING(IDF_GRID1,J,K,TRIM(VAR(J,I))); END DO; END DO
      CALL WDIALOGPUTMENU(IDF_MENU1,VAR(:,0),NV,IV)

     CASE (ID_MIN)
      CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to remove the attribute column '//TRIM(VAR(ICOL,0)),'Question')
      IF(WINFODIALOG(4).EQ.1)THEN
       K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1 ;DO J=2,NV; CALL WGRIDGETCELLSTRING(IDF_GRID1,J,K,VAR(J,I)); ENDDO; ENDDO
       ALLOCATE(VAR_TMP(NV-1,0:NL))
       K=1
       DO I=1,NV
        IF(I.NE.ICOL)THEN; DO J=0,NL; VAR_TMP(K,J)=VAR(I,J); ENDDO; K=K+1; ENDIF
       ENDDO
       DEALLOCATE(VAR); VAR=>VAR_TMP
       CALL WDIALOGCLEARFIELD(IDF_GRID1)
       NV=NV-1; ALLOCATE(ICOLS(NV)); ICOLS=1; CALL WGRIDCOLUMNS(IDF_GRID1,NV,ICOLS); DEALLOCATE(ICOLS)
       DO I=1,NV; CALL WGRIDLABELCOLUMN(IDF_GRID1,I,TRIM(VAR(I,0))); END DO
       K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1; DO J=1,NV; CALL WGRIDPUTCELLSTRING(IDF_GRID1,J,K,TRIM(VAR(J,I))); END DO; END DO
       CALL WDIALOGPUTMENU(IDF_MENU1,VAR(:,0),NV,IV)
      ENDIF
     CASE (ID_RENAME)
      IF(ICOL.LE.0)THEN
       CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Select a column to rename it','Warning')
      ELSE
       CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
       CALL WDIALOGSHOW(-1,-1,0,3)
       CALL WDIALOGPUTSTRING(IDF_LABEL1,'Rename Attribute')
       CALL WDIALOGPUTSTRING(IDF_STRING1,TRIM(VAR(ICOL,0)))
       DO
        CALL WMESSAGE(ITYPE,MESSAGE)
        SELECT CASE (ITYPE)
         CASE (PUSHBUTTON)
          SELECT CASE (MESSAGE%VALUE1)
           CASE (IDOK,IDCANCEL)
            CALL WDIALOGGETSTRING(IDF_STRING1,VAR(ICOL,0)); EXIT
          END SELECT
        END SELECT
       ENDDO
       CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID_DGENDATA)
       DO I=1,NV; CALL WGRIDLABELCOLUMN(IDF_GRID1,I,TRIM(VAR(I,0))); END DO 
       CALL WDIALOGPUTMENU(IDF_MENU1,VAR(:,0),NV,IV)
      ENDIF
     CASE (IDHELP)
      CALL IMODGETHELP('4.1.4','MMO.IDO.IDFEdit')
     !## get data
     CASE (IDOK)
      CALL WDIALOGGETMENU(IDF_MENU1,IV)
      CALL WDIALOGGETCHECKBOX(IDF_CHECK1,I); IV=IV*I
      K=0; DO I=1,NL; IF(SHPIACT(I).EQ.0)CYCLE; K=K+1; DO J=2,NV; CALL WGRIDGETCELLSTRING(IDF_GRID1,J,K,VAR(J,I)); END DO; END DO; EXIT
     CASE (IDCANCEL)
      DEALLOCATE(VAR); NV=SIZE(DVAR,1); NL=SIZE(DVAR,2)-1
      ALLOCATE(VAR(NV,0:NL)); VAR=DVAR
      EXIT
    END SELECT
  END SELECT
 ENDDO
 DEALLOCATE(DVAR); CALL WDIALOGUNLOAD()

! !## write dat file so it will goes right with zoom-full extent etc.
! IF(ASSOCIATED(VAR))CALL UTL_GENLABELSWRITE(FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'.dat' )

 END SUBROUTINE POLYGON_FILLDATAGRID
 
 !###======================================================================
 SUBROUTINE POLYGON1FIELDS(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: I

 SHPNO=MAX(0,SHPNO)

 CALL WDIALOGSELECT(ID)

 IF(SHPNO.GT.0)THEN
  CALL WDIALOGGETMENU(IDF_MENU1,SHPIACT)
 ELSE
  SHPIACT=0
 ENDIF

 I=0
 IF(SUM(SHPIACT(1:SHPNO)).GT.0)I=1
 CALL WDIALOGFIELDSTATE(ID_SAVESHAPE,I)
 CALL WDIALOGFIELDSTATE(ID_DELETE,I)
 CALL WDIALOGFIELDSTATE(ID_ZOOMSELECT,I)
 I=0
 IF(SUM(SHPIACT(1:SHPNO)).EQ.1)I=1
 CALL WDIALOGFIELDSTATE(ID_RENAME,I)

 END SUBROUTINE POLYGON1FIELDS

 !###======================================================================
 SUBROUTINE POLYGON1SAVELOADSHAPE(CODE,ID,GENFNAME,VAR,IDAT)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: GENFNAME
 INTEGER,INTENT(IN) :: CODE,ID
 INTEGER,INTENT(IN),OPTIONAL :: IDAT
 INTEGER :: IU,I,J,K,IOS,NSHAPE,NCRDS,MXCRDS,NID 
 REAL :: XC,YC
 REAL,ALLOCATABLE,DIMENSION(:) :: XPOL,YPOL
 CHARACTER(LEN=256) :: FNAME,STRING
 CHARACTER(LEN=10) :: CTYPE
 CHARACTER(LEN=50) :: SHAPENAME
 INTEGER :: N,M
 INTEGER,ALLOCATABLE,DIMENSION(:) :: IP
 LOGICAL :: LIPF
 CHARACTER(LEN=*),POINTER,DIMENSION(:,:),INTENT(OUT),OPTIONAL :: VAR

 !## save/load ipf file
 IF(INDEX(GENFNAME,'.IPF').GT.0)THEN
  FNAME=GENFNAME; IF(LEN_TRIM(GENFNAME).EQ.4)FNAME=''
  IF(CODE.EQ.ID_LOADSHAPE)THEN
   CALL POLYGON1LOADFROMIPF(FNAME,ID)
  ELSE
   CALL POLYGON1SAVEASIPF(FNAME)
  ENDIF
  RETURN
 ENDIF

 SHPFILE=''

 FNAME=TRIM(PREFVAL(1))//'\SHAPES'
 IU   =UTL_GETUNIT()

 IF(CODE.EQ.ID_LOADSHAPE)THEN

  IF(GENFNAME.EQ.'')THEN
   IF(.NOT.UTL_WSELECTFILE('All Possible Files (*.gen;*.shp)|*.gen;*.shp|ArcInfo Generate Files (*.gen)|*.gen|'// &
     'ArcGis Shape Files (*.shp)|*.shp|',&
        LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Load iMOD Shape File'))RETURN
  ELSE
   FNAME=GENFNAME
  ENDIF

  CALL IUPPERCASE(FNAME)

  !## reset number of polygons available yet!
  SHPNO=0
  
  !## test file to determine array-dimensions
  NSHAPE=0
  MXCRDS=0

  IF(INDEX(FNAME,'.SHP').GT.0)THEN
   !## transform shp/dbf -> gen/dat
   IF(.NOT.TOPOSHPTOGEN(TRIM(FNAME),LIPF))RETURN
   IF(LIPF)THEN
    CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open a POINT file here','Error')
    RETURN
   ENDIF
   FNAME=FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'.GEN' 
  ENDIF

  CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED',IOSTAT=IOS)
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open file for reading:'//CHAR(13)//'['//TRIM(FNAME)//']','Error')
   RETURN
  ENDIF  
  SHPFILE=FNAME
  
  DO
   READ(IU,*,IOSTAT=IOS) !I
   IF(IOS.NE.0)EXIT
   NSHAPE=NSHAPE+1
   NCRDS =0
   DO
    NCRDS=NCRDS+1
    READ(IU,*,IOSTAT=IOS) XC,YC
    IF(IOS.NE.0)EXIT
   END DO
   MXCRDS=MAX(NCRDS,MXCRDS)
  ENDDO

  IF(NSHAPE+SHPNO.GT.MAXSHAPES)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Total number of shapes read is '// &
             TRIM(ITOS(NSHAPE+SHPNO))//CHAR(13)//'* Maximal allowed is '//TRIM(ITOS(MAXSHAPES))//CHAR(13)//&
             'You can increase these settings in the menu-option: Preferences'//CHAR(13)//CHAR(13)// &
            'Selected file not read!','Error')
   CLOSE(IU)
   RETURN
  ENDIF

  REWIND(IU)

  IF(ALLOCATED(XPOL))DEALLOCATE(XPOL)
  IF(ALLOCATED(YPOL))DEALLOCATE(YPOL)
  ALLOCATE(XPOL(MXCRDS),YPOL(MXCRDS))

  !## maximum is for UTL_INSIDEPOLYGON etc.
  IF(ASSOCIATED(SHPXC))THEN
   IF(SIZE(SHPXC,1).LT.MXCRDS.OR.SIZE(SHPXC,2).LT.SHPNO)THEN
    ALLOCATE(CSHPXC(MXCRDS,MAXSHAPES+1),STAT=IOS)
    N=SIZE(SHPXC,1)
    M=SIZE(SHPXC,2)
    DO I=1,N; DO J=1,M; CSHPXC(I,J)=SHPXC(I,J); ENDDO; ENDDO
    DEALLOCATE(SHPXC)
    SHPXC=>CSHPXC
   ENDIF
  ENDIF
  IF(ASSOCIATED(SHPYC))THEN
   IF(SIZE(SHPYC,1).LT.MXCRDS.OR.SIZE(SHPYC,2).LT.SHPNO)THEN
    ALLOCATE(CSHPYC(MXCRDS,MAXSHAPES+1))
    N=SIZE(SHPYC,1)
    M=SIZE(SHPYC,2)
    DO I=1,N; DO J=1,M; CSHPYC(I,J)=SHPYC(I,J); ENDDO; ENDDO
    DEALLOCATE(SHPYC)
    SHPYC=>CSHPYC
   ENDIF
  ENDIF

  IF(SHPNO.GT.0)SHPIACT(1:SHPNO)=0

  J=SHPNO
  DO

   READ(IU,'(A256)',IOSTAT=IOS) STRING
   IF(IOS.NE.0)EXIT
   
   READ(STRING,*,IOSTAT=IOS) SHPID(MIN(J+1,MAXSHAPES)),SHAPENAME
   IF(IOS.NE.0)THEN
    SHAPENAME=''
    READ(STRING,*,IOSTAT=IOS) SHPID(MIN(J+1,MAXSHAPES))
   ENDIF
   IF(IOS.NE.0)EXIT

   J=MIN(J+1,MAXSHAPES)

   I=0
   DO
    READ(IU,*,IOSTAT=IOS) XC,YC
    IF(IOS.NE.0)EXIT
    I=I+1
    XPOL(I)=XC
    YPOL(I)=YC
   END DO

   SHPNCRD(J)=I
   SHPNO     =J

 !   CALL IMODSIMPLIFYSHAPE(XPOL,YPOL,SHPNCRD(J),MCRD)
 !   SHPNCRD(J)=MCRD
   SHPXC(1:SHPNCRD(J),J)=XPOL(1:SHPNCRD(J))
   SHPYC(1:SHPNCRD(J),J)=YPOL(1:SHPNCRD(J))
   SHPNAME(J)           =SHAPENAME
   SHPWIDTH(J)          =2
   SHPCOLOR(J)          =ICLRPOLG !WRGB(0,0,255)

   !## determine what kind of shape ...
   IF(SHPNCRD(J).EQ.1)THEN
    SHPTYPE(J)=ID_POINT
    CTYPE='POINT'
   ELSE
    IF(SHPXC(1,J).EQ.SHPXC(SHPNCRD(J),J).AND. &
       SHPYC(1,J).EQ.SHPYC(SHPNCRD(J),J))THEN
     !## remove last point
     SHPNCRD(J)=SHPNCRD(J)-1
     SHPTYPE(J)=ID_POLYGON
     CTYPE='POLYGON'
    ELSE
     SHPTYPE(J)=ID_LINE
     CTYPE='LINE'
    ENDIF
   ENDIF

   SHPCOLOR(SHPNO)=WRGB(255,0,0)
   IF(ALLOCATED(SPNT))THEN
    SPNT(J)%IDX=25
    SPNT(J)%IDY=25
    SPNT(J)%ISX=25
    SPNT(J)%ISY=25
    SPNT(J)%ISZ=1
    SPNT(J)%IRADIUS=100
    SPNT(J)%BOTIDF=''
    SPNT(J)%TOPIDF=''
    SPNT(J)%REFIDF=''
    SPNT(J)%IREF=0
   ENDIF

   IF(SHPNAME(SHPNO).EQ.'')THEN
    I=INDEXNOCASE(FNAME,'\',.TRUE.)+1
    K=INDEXNOCASE(FNAME,'.',.TRUE.)-1
    IF(K-I.LE.0)THEN
     SHPNAME(SHPNO) ='SHAPE'//TRIM(ITOS(J))//'_'//TRIM(CTYPE)
    ELSE
     SHPNAME(SHPNO) =FNAME(I:K)//'_'//TRIM(ITOS(J))//'_'//TRIM(CTYPE)
    ENDIF
   ENDIF

   SHPIACT(SHPNO)=1
  ENDDO

  CLOSE(IU)

  !## load associated file (if exist)
  IF(PRESENT(IDAT))THEN
   IF(IDAT.EQ.1)CALL UTL_GENLABELSREAD(FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'.dat',VAR,NL,NV)
  ENDIF
  
  IF(ALLOCATED(IP))DEALLOCATE(IP)
  IF(ALLOCATED(XPOL))DEALLOCATE(XPOL)
  IF(ALLOCATED(YPOL))DEALLOCATE(YPOL)

  IF(ID.NE.0)THEN
   CALL WDIALOGSELECT(ID)
   CALL WDIALOGPUTMENU(IDF_MENU1,SHPNAME,SHPNO,SHPIACT)
  ENDIF

 ELSEIF(CODE.EQ.ID_SAVESHAPE)THEN 
 
  IF(GENFNAME.EQ.'')THEN
   IF(.NOT.UTL_WSELECTFILE('iMOD Shape Files (*.gen)|*.gen|',     &
        SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Shape File'))RETURN
  ELSE
   FNAME=GENFNAME
   CALL UTL_CREATEDIR(FNAME(:INDEX(FNAME,'\',.TRUE.)-1))
  ENDIF

  IF(ID.NE.0)THEN
   CALL WDIALOGSELECT(ID); CALL WDIALOGGETMENU(IDF_MENU1,SHPIACT)
  ENDIF

  CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED',IOSTAT=IOS)
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open file for writing:'//CHAR(13)//'['//TRIM(FNAME)//']','Error')
   RETURN
  ENDIF  
  SHPFILE=FNAME

  CALL IUPPERCASE(FNAME)
  NID=0
  DO I=1,SHPNO
   IF(SHPNCRD(I).GT.0)THEN
    IF(SHPTYPE(I).EQ.ID_POINT)THEN
     DO J=1,SHPNCRD(I)
      NID=NID+1; STRING=TRIM(ITOS(NID))//','//TRIM(SHPNAME(I))
      WRITE(IU,'(A)') TRIM(STRING)
      WRITE(IU,'(2(G15.7,A1))') SHPXC(J,I),',',SHPYC(J,I)
      WRITE(IU,'(A)') 'END'
     END DO
    ELSEIF(SHPTYPE(I).EQ.ID_RECTANGLE)THEN
     NID=NID+1; IF(SHPID(I).EQ.0)SHPID(I)=NID
     STRING=TRIM(ITOS(SHPID(I)))//','//TRIM(SHPNAME(I))
     WRITE(IU,'(A)') TRIM(STRING) 

     WRITE(IU,'(2(G15.7,A1))') SHPXC(1,I),',',SHPYC(1,I)
     WRITE(IU,'(2(G15.7,A1))') SHPXC(1,I),',',SHPYC(2,I)
     WRITE(IU,'(2(G15.7,A1))') SHPXC(2,I),',',SHPYC(2,I)
     WRITE(IU,'(2(G15.7,A1))') SHPXC(2,I),',',SHPYC(1,I)
     WRITE(IU,'(2(G15.7,A1))') SHPXC(1,I),',',SHPYC(1,I)
     WRITE(IU,'(A)') 'END'

    ELSE
     NID=NID+1;IF(SHPID(I).EQ.0)SHPID(I)=NID
     STRING=TRIM(ITOS(SHPID(I)))//','//TRIM(SHPNAME(I))
     WRITE(IU,'(A)') TRIM(STRING) 
     DO J=1,SHPNCRD(I)
      WRITE(IU,'(2(G15.7,A1))') SHPXC(J,I),',',SHPYC(J,I)
     END DO
     !## close for polygons
     IF(SHPTYPE(I).EQ.ID_POLYGON)THEN
      WRITE(IU,'(2(G15.7,A1))') SHPXC(1,I),',',SHPYC(1,I)
     ENDIF
     WRITE(IU,'(A)') 'END'
    ENDIF
   ENDIF
  END DO
  WRITE(IU,'(A)') 'END'

  CLOSE(IU)
  
  !## save associated file (if exist)
  IF(PRESENT(IDAT))THEN
   IF(IDAT.EQ.1)CALL UTL_GENLABELSWRITE(FNAME(:INDEX(FNAME,'.',.TRUE.)-1)//'.dat',VAR)
  ENDIF

 ENDIF

 END SUBROUTINE POLYGON1SAVELOADSHAPE

 !###======================================================================
 SUBROUTINE POLYGON1SAVEASIPF(FNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256),INTENT(INOUT) :: FNAME
 CHARACTER(LEN=256) :: LINE
 INTEGER :: IOS,I,J,IU
! CHARACTER(LEN=52),POINTER,DIMENSION(:,:) :: VAR
  
 IF(LEN_TRIM(FNAME).EQ.0)THEN
  IF(.NOT.UTL_WSELECTFILE('iMOD Point Files (*.ipf)|*.ipf|',     &
       SAVEDIALOG+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Save iMOD Point File'))RETURN
 ENDIF
 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open file for writing:'//CHAR(13)//'['//TRIM(FNAME)//']','Error')
  RETURN
 ENDIF  
 LINE=TRIM(ITOS(SHPNO))
 WRITE(IU,'(A)') TRIM(LINE)
 LINE=TRIM(ITOS(2+MAX(0,NV-2))) 
 WRITE(IU,'(A)') TRIM(LINE)
 WRITE(IU,'(A)') '"X-COORDINATE (UTM)"'   
 WRITE(IU,'(A)') '"Y-COORDINATE (UTM)"'   
 DO I=3,NV; WRITE(IU,'(A)') TRIM(VAR(I,0)); ENDDO
 WRITE(IU,'(A)') '0,TXT'
 DO I=1,MAX(SHPNO,NL)
  LINE=TRIM(RTOS(SHPXC(1,I),'F',2))//','//TRIM(RTOS(SHPYC(1,I),'F',2))
  DO J=3,NV 
   LINE=TRIM(LINE)//','
   IF(INDEX(TRIM(VAR(J,I)),' ').GT.0)LINE=TRIM(LINE)//'"'
   LINE=TRIM(LINE)//TRIM(VAR(J,I))
   IF(INDEX(TRIM(VAR(J,I)),' ').GT.0)LINE=TRIM(LINE)//'"'
  ENDDO
  WRITE(IU,'(A)') TRIM(LINE)
 ENDDO
 CLOSE(IU)

 END SUBROUTINE POLYGON1SAVEASIPF

 !###======================================================================
 SUBROUTINE POLYGON1LOADFROMIPF(IPFFNAME,ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 CHARACTER(LEN=256),INTENT(INOUT) :: IPFFNAME
 INTEGER :: IU,IOS,I,J
 CHARACTER(LEN=256) :: FNAME
  
 IU   =UTL_GETUNIT()
 IF(IPFFNAME.EQ.'')THEN
  IF(.NOT.UTL_WSELECTFILE('iMOD Point Files (*.ipf)|*.ipf|',&
       LOADDIALOG+MUSTEXIST+PROMPTON+DIRCHANGE+APPENDEXT,FNAME,'Load iMOD Point File'))RETURN
 ELSE
  FNAME=IPFFNAME
 ENDIF
 CALL OSD_OPEN(IU,FILE=FNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot open file for reading:'//CHAR(13)//'['//TRIM(FNAME)//']','Error')
  RETURN
 ENDIF  

 READ(IU,*) NL
 READ(IU,*) NV
 
 IF(ASSOCIATED(VAR))DEALLOCATE(VAR)

 ALLOCATE(VAR(NV,0:NL)); VAR=''
 DO I=1,NV; READ(IU,*) VAR(I,0); ENDDO; READ(IU,*)
 DO I=1,NL; SHPNO=NL
  READ(IU,*) (VAR(J,I),J=1,NV)
  SHPNCRD(I)=1
  READ(VAR(1,I),*) SHPXC(1,I)
  READ(VAR(2,I),*) SHPYC(1,I)
  SHPNAME(I)='Point_'//TRIM(ITOS(I))
  SHPWIDTH(I)=2
  SHPCOLOR(I)=ICLRPOLG 
  SHPTYPE(I)=ID_POINT
 ENDDO
 CLOSE(IU)

 CALL WDIALOGSELECT(ID)
 CALL WDIALOGPUTMENU(IDF_MENU1,SHPNAME,SHPNO,SHPIACT)
  
 END SUBROUTINE POLYGON1LOADFROMIPF

 !###======================================================================
 SUBROUTINE POLYGON1INIT()
 !###======================================================================
 IMPLICIT NONE

 ALLOCATE(SHPNCRD(MAXSHAPES+1))
 ALLOCATE(SHPXC(MAXSHPCRD,MAXSHAPES+1))
 ALLOCATE(SHPYC(MAXSHPCRD,MAXSHAPES+1))
 ALLOCATE(SHPNAME(MAXSHAPES+1))
 ALLOCATE(SHPCOLOR(MAXSHAPES+1))
 ALLOCATE(SHPIACT(MAXSHAPES+1))
 ALLOCATE(SHPWIDTH(MAXSHAPES+1))
 ALLOCATE(SHPTYPE(MAXSHAPES+1))
 ALLOCATE(SHPID(MAXSHAPES+1))
 SHPNO  =0
 SHPNCRD=0

 END SUBROUTINE POLYGON1INIT

 !###======================================================================
 SUBROUTINE POLYGON1DEALLOCATE_SELIDF()
 !###======================================================================
 IMPLICIT NONE

 IF(ALLOCATED(SELIDF))THEN
  CALL IDFDEALLOCATE(SELIDF,SIZE(SELIDF))
  DEALLOCATE(SELIDF)
 ENDIF

 END SUBROUTINE POLYGON1DEALLOCATE_SELIDF

 !###======================================================================
 SUBROUTINE POLYGON1CLOSE()
 !###======================================================================
 IMPLICIT NONE

 IF(ASSOCIATED(SHPNCRD))DEALLOCATE(SHPNCRD)
 IF(ASSOCIATED(SHPXC))DEALLOCATE(SHPXC)
 IF(ASSOCIATED(SHPYC))DEALLOCATE(SHPYC)
 IF(ALLOCATED(SHPNAME))DEALLOCATE(SHPNAME)
 IF(ALLOCATED(SHPIACT))DEALLOCATE(SHPIACT)
 IF(ALLOCATED(SHPCOLOR))DEALLOCATE(SHPCOLOR)
 IF(ALLOCATED(SHPWIDTH))DEALLOCATE(SHPWIDTH)
 IF(ALLOCATED(SHPTYPE))DEALLOCATE(SHPTYPE)
 IF(ALLOCATED(SHPID))DEALLOCATE(SHPID)
 CALL POLYGON1DEALLOCATE_SELIDF()
 CALL UTL_GENLABELSDEALLOCATE()
 SHPNO  =0

 END SUBROUTINE POLYGON1CLOSE

 !###======================================================================
 SUBROUTINE POLYGON1IMAGES(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID

 CALL WDIALOGSELECT(ID)
 CALL WDIALOGPUTIMAGE(ID_SAVESHAPE,ID_ICONSAVEAS)
 CALL WDIALOGPUTIMAGE(ID_LOADSHAPE,ID_ICONOPEN)
 CALL WDIALOGPUTIMAGE(ID_DRAW,ID_ICONDRAW)
 CALL WDIALOGPUTIMAGE(ID_DELETE,ID_ICONDELETE)
 CALL WDIALOGPUTIMAGE(ID_RENAME,ID_ICONRENAME)
 CALL WDIALOGPUTIMAGE(ID_ZOOMSELECT,ID_ICONZOOMFULL)

 END SUBROUTINE POLYGON1IMAGES

END MODULE MOD_POLYGON_UTL