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

USE WINTERACTER
USE RESOURCE
USE MOD_IR_PAR
USE MOD_UTL, ONLY : ITOS,RTOS,UTL_GETUNIT,UTL_WSELECTFILE
USE MOD_IR_UTL, ONLY : IR1GETTREEVIEWID,IR1SHAPE2POL,IR1POL2SHAPE,IR1DEALLOCATE_TREE,IR1ALLOCATE_INIT
USE MOD_OSD, ONLY : OSD_OPEN

CONTAINS

 !###======================================================================
 LOGICAL FUNCTION IR1PRJFILES(ID,FNAME,IQUESTION)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: FNAME
 INTEGER,INTENT(IN),OPTIONAL :: IQUESTION
 INTEGER,INTENT(IN) :: ID
 INTEGER :: IU,ITARGET,IMEASURE,IRESULT,IPOL,ICRD,IDEF,IMES,N,MTARGET,MRESULT,MMEASURE,IFIELD,IOPT,ITREE,IOS,IDUMMY
 CHARACTER(LEN=256) :: LINE

 IR1PRJFILES=.FALSE.

 IU=UTL_GETUNIT()
 IF(ID.EQ.ID_OPEN)THEN
  IF(.NOT.PRESENT(FNAME))THEN
   LINE=TRIM(RESDIR)//'\*.qpf'
   IF(.NOT.UTL_WSELECTFILE('iMOD Quick-Scan Project Files (*.qpf)|*.qpf|',     &
        LOADDIALOG+MUSTEXIST+PROMPTON+APPENDEXT,LINE,&
        'Load iMOD Quick-Scan Project File'))RETURN
   PRJFNAME=LINE
  ELSE
   PRJFNAME=FNAME
  ENDIF
  CALL OSD_OPEN(IU,FILE=PRJFNAME,STATUS='OLD',ACTION='READ,DENYWRITE',FORM='FORMATTED',IOSTAT=IOS)
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open '//TRIM(PRJFNAME),'Error')
   RETURN
  ENDIF

  !## clean entire project
  CALL IR1DEALLOCATE_TREE()
  !## allocate memory
  CALL IR1ALLOCATE_INIT()

  READ(IU,*) NTARGET
  NMEASURE=0
  NRESULT =0
  IFIELD  =0
  !## targets
  DO ITARGET=1,NTARGET
   IFIELD=IFIELD+1
   READ(IU,*) TTREE(ITARGET)%CNAME
   TTREE(ITARGET)%TARGET_ID=IFIELD
   TTREE(ITARGET)%IDPOS    =1
   READ(IU,*) TTREE(ITARGET)%NPOL
   DO IPOL=1,TTREE(ITARGET)%NPOL
!    READ(IU,*) TTREE(ITARGET)%POL(IPOL)%POLNAME,TTREE(ITARGET)%POL(IPOL)%EFFECT,TTREE(ITARGET)%POL(IPOL)%NCRD
    READ(IU,*) TTREE(ITARGET)%POL(IPOL)%POLNAME,IDUMMY,TTREE(ITARGET)%POL(IPOL)%NCRD
    TTREE(ITARGET)%POL(IPOL)%ITYPE=ID_POLYGON
    TTREE(ITARGET)%POL(IPOL)%IACT =0  !## not selected
    TTREE(ITARGET)%POL(IPOL)%ICLR =ICLRTARGET
    TTREE(ITARGET)%POL(IPOL)%WIDTH=2
    N=TTREE(ITARGET)%POL(IPOL)%NCRD
    ALLOCATE(TTREE(ITARGET)%POL(IPOL)%X(N),TTREE(ITARGET)%POL(IPOL)%Y(N))
    DO ICRD=1,TTREE(ITARGET)%POL(IPOL)%NCRD
     READ(IU,*) TTREE(ITARGET)%POL(IPOL)%X(ICRD),TTREE(ITARGET)%POL(IPOL)%Y(ICRD)
    END DO
    READ(IU,*) TTREE(ITARGET)%POL(IPOL)%NDEF
    N=TTREE(ITARGET)%POL(IPOL)%NDEF
    ALLOCATE(TTREE(ITARGET)%POL(IPOL)%DEF(MAXDEF))!N))
    DO IDEF=1,TTREE(ITARGET)%POL(IPOL)%NDEF
     READ(IU,*) TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%INEWP,TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%INEWT, &
                TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%LOWER,TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%UPPER
    END DO
   ENDDO
   READ(IU,*) MMEASURE
   DO IMEASURE=1,MMEASURE
    IFIELD  =IFIELD+1
    NMEASURE=NMEASURE+1
    READ(IU,*) MTREE(NMEASURE)%CNAME
    MTREE(NMEASURE)%MEASURE_ID=IFIELD
    MTREE(NMEASURE)%IDPOS     =TTREE(ITARGET)%TARGET_ID
    READ(IU,*) MTREE(NMEASURE)%NPOL
    DO IPOL=1,MTREE(NMEASURE)%NPOL
     READ(IU,*) MTREE(NMEASURE)%POL(IPOL)%POLNAME,MTREE(NMEASURE)%POL(IPOL)%NCRD
     MTREE(NMEASURE)%POL(IPOL)%ITYPE=ID_POLYGON
     MTREE(NMEASURE)%POL(IPOL)%IACT =0  !## not selected
     MTREE(NMEASURE)%POL(IPOL)%ICLR =ICLRMEASURE
     MTREE(NMEASURE)%POL(IPOL)%WIDTH=2
     N=MTREE(NMEASURE)%POL(IPOL)%NCRD
     ALLOCATE(MTREE(NMEASURE)%POL(IPOL)%X(N),MTREE(NMEASURE)%POL(IPOL)%Y(N))
     DO ICRD=1,MTREE(NMEASURE)%POL(IPOL)%NCRD
      READ(IU,*) MTREE(NMEASURE)%POL(IPOL)%X(ICRD),MTREE(NMEASURE)%POL(IPOL)%Y(ICRD)
     END DO
     READ(IU,*) MTREE(NMEASURE)%POL(IPOL)%NMES
     N=MTREE(NMEASURE)%POL(IPOL)%NMES
     ALLOCATE(MTREE(NMEASURE)%POL(IPOL)%MES(MAXMES))!N))
     DO IMES=1,MTREE(NMEASURE)%POL(IPOL)%NMES
      READ(IU,*) MTREE(NMEASURE)%POL(IPOL)%MES(IMES)%IMES,MTREE(NMEASURE)%POL(IPOL)%MES(IMES)%IMP
     END DO
    END DO

    !## constraints
    READ(IU,*) MTREE(NMEASURE)%NOPT
    IF(MTREE(NMEASURE)%NOPT.GT.NIR)THEN
     !## error occured ...
     WRITE(*,*) 'ERROR READING QPF'
     pause
    ENDIF
    ALLOCATE(MTREE(IMEASURE)%OPT(NIR))
    DO IOPT=1,MTREE(IMEASURE)%NOPT
     READ(IU,*) MTREE(IMEASURE)%OPT(IOPT)%IFIXED,MTREE(IMEASURE)%OPT(IOPT)%ISEL,MTREE(IMEASURE)%OPT(IOPT)%LLIMP, &
                MTREE(IMEASURE)%OPT(IOPT)%ULIMP,MTREE(IMEASURE)%OPT(IOPT)%IMP
    END DO

    READ(IU,*) MRESULT
    DO IRESULT=1,MRESULT
     IFIELD =IFIELD+1
     NRESULT=NRESULT+1
     READ(IU,*) RTREE(IRESULT)%CNAME
     RTREE(NRESULT)%RESULT_ID=IFIELD
     RTREE(NRESULT)%IDPOS    =MTREE(NMEASURE)%MEASURE_ID
    ENDDO
   ENDDO
  ENDDO

  CALL WMENUSETSTATE(ID_SAVE,1,1)

 ELSEIF(ID.EQ.ID_SAVE.OR.ID.EQ.ID_SAVEAS)THEN

  IF(.NOT.PRESENT(FNAME))THEN
   IF(ID.EQ.ID_SAVEAS)THEN
    LINE=TRIM(RESDIR)//'\*.qpf'
    IF(.NOT.UTL_WSELECTFILE('iMOD Quick-Scan Project Files (*.qpf)|*.qpf|',  &
          SAVEDIALOG+PROMPTON+APPENDEXT,LINE,'Save iMOD Quick-Scan Project File'))RETURN
    PRJFNAME=LINE
   ELSE
    IF(PRESENT(IQUESTION))THEN
     IF(IQUESTION.EQ.1)THEN
      CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Save your current work in'//CHAR(13)//TRIM(PRJFNAME)//' ?','Question')
      IF(WINFODIALOG(4).NE.1)RETURN
     ENDIF
    ENDIF
   ENDIF
  ELSE
   PRJFNAME=FNAME
  ENDIF
  CALL OSD_OPEN(IU,FILE=PRJFNAME,STATUS='REPLACE',ACTION='WRITE,DENYREAD',FORM='FORMATTED',IOSTAT=IOS)
  IF(IOS.NE.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open '//TRIM(PRJFNAME),'Error')
   RETURN
  ENDIF

  MTARGET=0
  !## measures
  DO ITARGET=1,NTARGET
   IF(TTREE(ITARGET)%IDPOS.NE.0)MTARGET=MTARGET+1
  ENDDO

  LINE=TRIM(ITOS(MTARGET))//' !## no.target'
  WRITE(IU,'(A)') TRIM(LINE)

  !## get level of treeview
  CALL IR1GETTREEVIEWID(ITREE,IFIELD)
  !## copy data of current measures/target
  CALL IR1SHAPE2POL(ITREE,IFIELD)
  !## restore them again ...
  CALL IR1POL2SHAPE(ITREE,IFIELD)

  !## targets
  DO ITARGET=1,NTARGET

   IF(TTREE(ITARGET)%IDPOS.NE.0)THEN

    LINE='"'//TRIM(TTREE(ITARGET)%CNAME)//'" !## target name'
    WRITE(IU,'(A)') TRIM(LINE)
    LINE=TRIM(ITOS(TTREE(ITARGET)%NPOL))//' !## no.polygons'
    WRITE(IU,'(A)') TRIM(LINE)

    !## polygons
    IDUMMY=0
    DO IPOL=1,TTREE(ITARGET)%NPOL
     LINE='"'//TRIM(TTREE(ITARGET)%POL(IPOL)%POLNAME)//'",'//TRIM(ITOS(IDUMMY))//','// &!TTREE(ITARGET)%POL(IPOL)%EFFECT))//','// &
          TRIM(ITOS(TTREE(ITARGET)%POL(IPOL)%NCRD))//' !## polygon name,dummy,no.coordinates'  !,effectiveness
     WRITE(IU,'(A)') TRIM(LINE)
     !## coordinates
     DO ICRD=1,TTREE(ITARGET)%POL(IPOL)%NCRD
      LINE=TRIM(RTOS(TTREE(ITARGET)%POL(IPOL)%X(ICRD),'F',2))//','//TRIM(RTOS(TTREE(ITARGET)%POL(IPOL)%Y(ICRD),'F',2))
      WRITE(IU,'(A)') TRIM(LINE)
     END DO

     LINE=TRIM(ITOS(TTREE(ITARGET)%POL(IPOL)%NDEF))//' !## no.definitions'
     WRITE(IU,'(A)') TRIM(LINE)
     !## definitions
     DO IDEF=1,TTREE(ITARGET)%POL(IPOL)%NDEF
      LINE=TRIM(ITOS(TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%INEWP))      //','// &
           TRIM(ITOS(TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%INEWT))      //','// &
           TRIM(RTOS(TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%LOWER,'F',2))//','// &
           TRIM(RTOS(TTREE(ITARGET)%POL(IPOL)%DEF(IDEF)%UPPER,'F',2))//' !## iperiod,itopic,lowerlimit,upperlimit'
      WRITE(IU,'(A)') TRIM(LINE)
     END DO
    END DO

    MMEASURE=0
    !## measures
    DO IMEASURE=1,NMEASURE
     IF(MTREE(IMEASURE)%IDPOS.EQ.TTREE(ITARGET)%TARGET_ID)THEN
      MMEASURE=MMEASURE+1
     ENDIF
    ENDDO

    LINE=TRIM(ITOS(MMEASURE))//' !## no.measure'
    WRITE(IU,'(A)') TRIM(LINE)

    !## measures
    DO IMEASURE=1,NMEASURE
     IF(MTREE(IMEASURE)%IDPOS.EQ.TTREE(ITARGET)%TARGET_ID)THEN
      LINE='"'//TRIM(MTREE(IMEASURE)%CNAME)//'" !## measure name'
      WRITE(IU,'(A)') TRIM(LINE)
      LINE=TRIM(ITOS(MTREE(IMEASURE)%NPOL))//' !## no.polygons'
      WRITE(IU,'(A)') TRIM(LINE)
      !## polygons
      DO IPOL=1,MTREE(IMEASURE)%NPOL
       LINE='"'//TRIM(MTREE(IMEASURE)%POL(IPOL)%POLNAME)//'",'//TRIM(ITOS(MTREE(IMEASURE)%POL(IPOL)%NCRD))// &
          ' !## polygon name,no.coordinates'
       WRITE(IU,'(A)') TRIM(LINE)
       !## coordinates
       DO ICRD=1,MTREE(IMEASURE)%POL(IPOL)%NCRD
        LINE=TRIM(RTOS(MTREE(IMEASURE)%POL(IPOL)%X(ICRD),'F',2))//','//TRIM(RTOS(MTREE(IMEASURE)%POL(IPOL)%Y(ICRD),'F',2))
        WRITE(IU,'(A)') TRIM(LINE)
       END DO
       LINE=TRIM(ITOS(MTREE(IMEASURE)%POL(IPOL)%NMES))//' !## no.measures'
       WRITE(IU,'(A)') TRIM(LINE)
       !## measures
       DO IMES=1,MTREE(IMEASURE)%POL(IPOL)%NMES
        LINE=TRIM(ITOS(MTREE(IMEASURE)%POL(IPOL)%MES(IMES)%IMES))//','//TRIM(RTOS(MTREE(IMEASURE)%POL(IPOL)%MES(IMES)%IMP,'F',2))//&
             ' !## i-impulse,strength'
        WRITE(IU,'(A)') TRIM(LINE)
       END DO
      END DO

      LINE=TRIM(ITOS(MTREE(IMEASURE)%NOPT))//' !## no.constraints'
      WRITE(IU,*) TRIM(LINE)
      !## constraints
      DO IOPT=1,MTREE(IMEASURE)%NOPT
       LINE=TRIM(ITOS(MTREE(IMEASURE)%OPT(IOPT)%IFIXED))//','     //TRIM(ITOS(MTREE(IMEASURE)%OPT(IOPT)%ISEL))//','// &
            TRIM(RTOS(MTREE(IMEASURE)%OPT(IOPT)%LLIMP,'F',2))//','//TRIM(RTOS(MTREE(IMEASURE)%OPT(IOPT)%ULIMP,'F',2))//','// &
            TRIM(RTOS(MTREE(IMEASURE)%OPT(IOPT)%IMP,'F',2))//','//' !## i-constraint ifixed,type,lower/upper boundary,fixedimpulse'
       WRITE(IU,'(A)') TRIM(LINE)
      END DO

      MRESULT=0
      DO IRESULT=1,NRESULT
       IF(RTREE(IRESULT)%IDPOS.EQ.MTREE(IMEASURE)%MEASURE_ID)MRESULT=MRESULT+1
      ENDDO

      LINE=TRIM(ITOS(MRESULT))//' !## no.results'
      WRITE(IU,'(A)') TRIM(LINE)

      !## results
      DO IRESULT=1,NRESULT
       IF(RTREE(IRESULT)%IDPOS.EQ.MTREE(IMEASURE)%MEASURE_ID)THEN
        WRITE(IU,'(A)') '"'//TRIM(RTREE(IRESULT)%CNAME)//'" !## result name'
       ENDIF
      END DO

     ENDIF
    ENDDO
   ENDIF
  ENDDO

 ENDIF

 CLOSE(IU)

 CALL WINDOWSELECT(IRWIN)
 CALL WMENUSETSTATE(ID_SAVE,1,1)

 IR1PRJFILES=.TRUE.

 END FUNCTION IR1PRJFILES

END MODULE MOD_IR_QPF