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

USE MOD_IR_PAR
USE MOD_POLYGON_PAR
USE MOD_POLYGON_UTL
!USE MOD_IDFPLOT
USE MOD_UTL
USE IMODVAR

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,'Cannot 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,'Cannot 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

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

 IF(ICODE.EQ.1)THEN
  IF(LEN_TRIM(PRJFNAME).EQ.0)CALL WMESSAGEBOX(YESNOCANCEL,QUESTIONICON,COMMONNO,'Do you want to save your work?','Question')
  IF(LEN_TRIM(PRJFNAME).NE.0)CALL WMESSAGEBOX(YESNOCANCEL,QUESTIONICON,COMMONNO,'Do you want to save your work to'//CHAR(13)// &
   TRIM(PRJFNAME)//' ?','Question')
  IF(WINFODIALOG(4).EQ.0)THEN
   IDIAGERROR=1
   RETURN
  ENDIF
  IF(WINFODIALOG(4).EQ.1)THEN
   ID=ID_SAVE
   IF(LEN_TRIM(PRJFNAME).EQ.0)ID=ID_SAVEAS
   IF(.NOT.IR1PRJFILES(ID))THEN
   ENDIF
  ENDIF
 ENDIF

 IF(IRWIN.NE.0)THEN
  CALL WINDOWCLOSECHILD(IRWIN)
  CALL WDIALOGSELECT(ID_DIRMEASURES)
  CALL WDIALOGUNLOAD()
  CALL WDIALOGSELECT(ID_DIRTARGETS)
  CALL WDIALOGUNLOAD()
 ENDIF

 IRWIN=0

 !##draw previous filled shape
! CALL IR1DRAWSHAPES()

! CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
 CALL POLYGON1CLOSE()

 CALL IR1DEALLOCATE()

 LPLOTYSEL=.FALSE.

 CALL WINDOWSELECT(0)
 CALL WMENUSETSTATE(ID_IRDATABASE,2,0)

! CALL IDFPLOT(1)

 END SUBROUTINE IR1CLOSE
 
 !###======================================================================
 SUBROUTINE IR1DEALLOCATE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL IR1DEALLOCATE_TREE()

 IF(ALLOCATED(RES))DEALLOCATE(RES)
 IF(ALLOCATED(PER))DEALLOCATE(PER)
 IF(ALLOCATED(PERRES))DEALLOCATE(PERRES)

 IF(ALLOCATED(BC))THEN
  DO I=1,NBC
   IF(ASSOCIATED(BC(I)%X))   DEALLOCATE(BC(I)%X)
   IF(ASSOCIATED(BC(I)%Y))   DEALLOCATE(BC(I)%Y)
   IF(ASSOCIATED(BC(I)%IXY)) DEALLOCATE(BC(I)%IXY)
   IF(ASSOCIATED(BC(I)%XMIN))DEALLOCATE(BC(I)%XMIN)
   IF(ASSOCIATED(BC(I)%XMAX))DEALLOCATE(BC(I)%XMAX)
   IF(ASSOCIATED(BC(I)%YMIN))DEALLOCATE(BC(I)%YMIN)
   IF(ASSOCIATED(BC(I)%YMAX))DEALLOCATE(BC(I)%YMAX)
  ENDDO
  DEALLOCATE(BC)
 ENDIF

 CALL IR1FIELDS_DEALLOCATE()

 CALL UTL_CLOSEUNITS()

 END SUBROUTINE IR1DEALLOCATE
 
 !###======================================================================
 SUBROUTINE IR1ALLOCATE_INIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J

 !##-----------
 !## allocate memory and nullify pointers for TARGETS
 !##-----------

 ALLOCATE(TTREE(MAXTARGET))
 !## nullify pointers
 DO I=1,MAXTARGET
  NULLIFY(TTREE(I)%POL)
  ALLOCATE(TTREE(I)%POL(MAXSHAPES))
  !##nullify pointers
  DO J=1,MAXSHAPES
   NULLIFY(TTREE(I)%POL(J)%DEF)
   NULLIFY(TTREE(I)%POL(J)%X)
   NULLIFY(TTREE(I)%POL(J)%Y)
   !ALLOCATE(TTREE(I)%POL(J)%X(1))
   !ALLOCATE(TTREE(I)%POL(J)%Y(1))
   !ALLOCATE(TTREE(I)%POL(J)%DEF(1))
   !## initialize number of definitions
   TTREE(I)%POL(J)%NDEF=0
   TTREE(I)%POL(J)%NCRD=0
  END DO
  !## initialize number of polygons
  TTREE(I)%NPOL=0
 END DO
 TTREE%IDPOS    =0
 TTREE%TARGET_ID=0
 NTARGET        =0

 !##-----------
 !## allocate memory and nullify pointers for MEASURES
 !##-----------

 ALLOCATE(MTREE(MAXMEASURE))
 !## nullify pointers
 DO I=1,MAXMEASURE
  NULLIFY(MTREE(I)%POL)
  NULLIFY(MTREE(I)%OPT)
  ALLOCATE(MTREE(I)%POL(MAXSHAPES))
  !##nullify pointers
  DO J=1,MAXSHAPES
   NULLIFY(MTREE(I)%POL(J)%MES)
   NULLIFY(MTREE(I)%POL(J)%X)
   NULLIFY(MTREE(I)%POL(J)%Y)
   !ALLOCATE(MTREE(I)%POL(J)%X(1))
   !ALLOCATE(MTREE(I)%POL(J)%Y(1))
   !ALLOCATE(MTREE(I)%POL(J)%MES(1))
   !## initialize number of measures
   MTREE(I)%POL(J)%NMES=0
   MTREE(I)%POL(J)%NCRD=0
  END DO
  !## initialize number of polygons
  MTREE(I)%NPOL=0
 END DO
 MTREE%IDPOS     =0
 MTREE%MEASURE_ID=0
 NMEASURE        =0

 !##-----------
 !## allocate memory and nullify pointers for RESULTS
 !##-----------

 ALLOCATE(RTREE(MAXRESULT))
 !## nullify pointers
 DO I=1,MAXRESULT
 END DO
 RTREE%IDPOS    =0
 RTREE%RESULT_ID=0
 NRESULT        =0

 END SUBROUTINE IR1ALLOCATE_INIT

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

 IF(ALLOCATED(TTREE))THEN
  DO I=1,SIZE(TTREE)
   CALL IR1DEALLOCATE_TARGET(I)
  END DO
  DEALLOCATE(TTREE)
 ENDIF
 IF(ALLOCATED(MTREE))THEN
  DO I=1,SIZE(MTREE)
   CALL IR1DEALLOCATE_MEASURE(I)
  END DO
  DEALLOCATE(MTREE)
 ENDIF
 IF(ALLOCATED(RTREE))THEN
!  DO I=1,SIZE(RTREE)
!   CALL IR1DEALLOCATE_RESULT(I)
!  END DO
  DEALLOCATE(RTREE)
 ENDIF

 END SUBROUTINE IR1DEALLOCATE_TREE

 !###======================================================================
 SUBROUTINE IR1DEALLOCATE_TARGET(IFIELD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFIELD
 INTEGER :: IPOL

 IF(ASSOCIATED(TTREE(IFIELD)%POL))THEN
  DO IPOL=1,SIZE(TTREE(IFIELD)%POL)
   CALL IR1DEALLOCATE_TARGET2(IFIELD,IPOL)
  END DO
  DEALLOCATE(TTREE(IFIELD)%POL)
 ENDIF

 END SUBROUTINE IR1DEALLOCATE_TARGET

 !###======================================================================
 SUBROUTINE IR1DEALLOCATE_TARGET2(IFIELD,IPOL)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFIELD,IPOL

 IF(TTREE(IFIELD)%POL(IPOL)%NDEF.GT.0)THEN
! IF(ASSOCIATED(TTREE(IFIELD)%POL(IPOL)%DEF))
  DEALLOCATE(TTREE(IFIELD)%POL(IPOL)%DEF)
 ENDIF
 IF(TTREE(IFIELD)%POL(IPOL)%NCRD.GT.0)THEN
! IF(ASSOCIATED(TTREE(IFIELD)%POL(IPOL)%X))
  DEALLOCATE(TTREE(IFIELD)%POL(IPOL)%X)
! IF(ASSOCIATED(TTREE(IFIELD)%POL(IPOL)%Y))
  DEALLOCATE(TTREE(IFIELD)%POL(IPOL)%Y)
 ENDIF
 NULLIFY(TTREE(IFIELD)%POL(IPOL)%X)
 NULLIFY(TTREE(IFIELD)%POL(IPOL)%Y)
 NULLIFY(TTREE(IFIELD)%POL(IPOL)%DEF)
 
 TTREE(IFIELD)%POL(IPOL)%NDEF=0

 END SUBROUTINE IR1DEALLOCATE_TARGET2

 !###======================================================================
 SUBROUTINE IR1DEALLOCATE_MEASURE(IFIELD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFIELD
 INTEGER :: IPOL

 IF(ASSOCIATED(MTREE(IFIELD)%POL))THEN
  DO IPOL=1,SIZE(MTREE(IFIELD)%POL)
   CALL IR1DEALLOCATE_MEASURE2(IFIELD,IPOL)
  END DO
  DEALLOCATE(MTREE(IFIELD)%POL)
 ENDIF
 IF(ASSOCIATED(MTREE(IFIELD)%OPT))DEALLOCATE(MTREE(IFIELD)%OPT)
 
 END SUBROUTINE IR1DEALLOCATE_MEASURE

 !###======================================================================
 SUBROUTINE IR1DEALLOCATE_MEASURE2(IFIELD,IPOL)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFIELD,IPOL
 
 IF(MTREE(IFIELD)%POL(IPOL)%NMES.GT.0)THEN
! IF(ASSOCIATED(MTREE(IFIELD)%POL(IPOL)%MES))
  DEALLOCATE(MTREE(IFIELD)%POL(IPOL)%MES)
 ENDIF
 IF(MTREE(IFIELD)%POL(IPOL)%NCRD.GT.0)THEN
! IF(ASSOCIATED(MTREE(IFIELD)%POL(IPOL)%X))
  DEALLOCATE(MTREE(IFIELD)%POL(IPOL)%X)
! IF(ASSOCIATED(MTREE(IFIELD)%POL(IPOL)%Y))
  DEALLOCATE(MTREE(IFIELD)%POL(IPOL)%Y)
 ENDIF
 NULLIFY(MTREE(IFIELD)%POL(IPOL)%X)
 NULLIFY(MTREE(IFIELD)%POL(IPOL)%Y)
 NULLIFY(MTREE(IFIELD)%POL(IPOL)%MES)
 
 MTREE(IFIELD)%POL(IPOL)%NMES=0

 END SUBROUTINE IR1DEALLOCATE_MEASURE2

 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION IR1IMPULSEFACTOR(IMP,IIR)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIR
 REAL(KIND=DP_KIND),INTENT(IN) :: IMP

 IR1IMPULSEFACTOR=(IMP-IR(IIR)%MINIR)/(IR(IIR)%MAXIR-IR(IIR)%MINIR)

 END FUNCTION IR1IMPULSEFACTOR

 !###======================================================================
 REAL(KIND=DP_KIND) FUNCTION IR1FACTORIMPULSE(IMP,IIR)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IIR
 REAL(KIND=DP_KIND),INTENT(IN) :: IMP

 IR1FACTORIMPULSE=(IMP*(IR(IIR)%MAXIR-IR(IIR)%MINIR))+IR(IIR)%MINIR

 END FUNCTION IR1FACTORIMPULSE

 !###======================================================================
 SUBROUTINE IR1DIRNAME(DIRNAME)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(OUT) :: DIRNAME
 INTEGER :: IFIELD,ITREE

 !## get level of treeview
 CALL IR1GETTREEVIEWID(ITREE,IFIELD)
 !## construct dirname
 CALL IR1FIELDS_STRING(CTREE,ITREE,IFIELD)
 !## construct result name
 DIRNAME=TRIM(RESDIR)//'\'//TRIM(ADJUSTL(CTREE(1)))//'\'//TRIM(ADJUSTL(CTREE(2)))//'\'//TRIM(ADJUSTL(CTREE(3)))

 END SUBROUTINE

 !###======================================================================
 SUBROUTINE IR1SHAPE2POL(ITREE,IFIELD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITREE,IFIELD
 INTEGER :: I 
 
 SELECT CASE (ITREE)
  !## target
  CASE (1)

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

   !## copy shapes into polygon for ir
   DO I=1,SHP%NPOL
!    lex=ASSOCIATED(TTREE(IFIELD)%POL(I)%X)
    IF(TTREE(IFIELD)%POL(I)%NCRD.GT.0)THEN
!    if(lex)then
!    IF(ASSOCIATED(TTREE(IFIELD)%POL(I)%X))THEN
     DEALLOCATE(TTREE(IFIELD)%POL(I)%X) !,STAT=IOS)
!    ENDIF
!    lex=ASSOCIATED(TTREE(IFIELD)%POL(I)%Y)
!    IF(LEX)THEN !IF(ASSOCIATED(TTREE(IFIELD)%POL(I)%Y))THEN
     DEALLOCATE(TTREE(IFIELD)%POL(I)%Y) !,STAT=IOS)
    ENDIF
    !NULLIFY(TTREE(IFIELD)%POL(I)%X)
    !NULLIFY(TTREE(IFIELD)%POL(I)%Y)
    ALLOCATE(TTREE(IFIELD)%POL(I)%X(SHP%POL(I)%N))
    ALLOCATE(TTREE(IFIELD)%POL(I)%Y(SHP%POL(I)%N))
    TTREE(IFIELD)%POL(I)%X      =SHP%POL(I)%X(1:SHP%POL(I)%N)
    TTREE(IFIELD)%POL(I)%Y      =SHP%POL(I)%Y(1:SHP%POL(I)%N)
    TTREE(IFIELD)%POL(I)%NCRD   =SHP%POL(I)%N
    TTREE(IFIELD)%POL(I)%ITYPE  =SHP%POL(I)%ITYPE
    TTREE(IFIELD)%POL(I)%IACT   =SHP%POL(I)%IACT
    TTREE(IFIELD)%POL(I)%ICLR   =SHP%POL(I)%ICOLOR
    TTREE(IFIELD)%POL(I)%POLNAME=SHP%POL(I)%PNAME
    TTREE(IFIELD)%POL(I)%WIDTH  =SHP%POL(I)%IWIDTH
   END DO
   TTREE(IFIELD)%NPOL=SHP%NPOL

  !## measure
  CASE (2)

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

   !## copy shapes into polygon for ir
   DO I=1,SHP%NPOL
    IF(MTREE(IFIELD)%POL(I)%NCRD.GT.0)THEN
!    IF(ASSOCIATED(MTREE(IFIELD)%POL(I)%X))
     DEALLOCATE(MTREE(IFIELD)%POL(I)%X)
!    IF(ASSOCIATED(MTREE(IFIELD)%POL(I)%Y))
     DEALLOCATE(MTREE(IFIELD)%POL(I)%Y)
    ENDIF
    NULLIFY(MTREE(IFIELD)%POL(I)%X)
    NULLIFY(MTREE(IFIELD)%POL(I)%Y)
    ALLOCATE(MTREE(IFIELD)%POL(I)%X(SHP%POL(I)%N))
    ALLOCATE(MTREE(IFIELD)%POL(I)%Y(SHP%POL(I)%N))
    MTREE(IFIELD)%POL(I)%X      =SHP%POL(I)%X(1:SHP%POL(I)%N)
    MTREE(IFIELD)%POL(I)%Y      =SHP%POL(I)%Y(1:SHP%POL(I)%N)
    MTREE(IFIELD)%POL(I)%NCRD   =SHP%POL(I)%N
    MTREE(IFIELD)%POL(I)%ITYPE  =SHP%POL(I)%ITYPE
    MTREE(IFIELD)%POL(I)%IACT   =SHP%POL(I)%IACT
    MTREE(IFIELD)%POL(I)%ICLR   =SHP%POL(I)%ICOLOR
    MTREE(IFIELD)%POL(I)%POLNAME=SHP%POL(I)%PNAME
    MTREE(IFIELD)%POL(I)%WIDTH  =SHP%POL(I)%IWIDTH
!WRITE(*,*) 'shape2pol,ifield,ncrd(2)',ifield,SHP%POL(I)%N,MTREE(IFIELD)%POL(I)%NCRD
   END DO
   MTREE(IFIELD)%NPOL=SHP%NPOL
!   WRITE(*,*) 'shape2pol,field,SHP%NPOL',ifield,SHP%NPOL

 END SELECT

 !## clear existence of polygons
 SHP%NPOL=0

 END SUBROUTINE IR1SHAPE2POL

 !###======================================================================
 SUBROUTINE IR1POL2SHAPE(ITREE,IFIELD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ITREE,IFIELD
 INTEGER :: I

 SELECT CASE (ITREE)
  !## target
  CASE (1)
   SHP%NPOL=TTREE(IFIELD)%NPOL
   !## copy shapes into polygon for ir
   DO I=1,SHP%NPOL
    SHP%POL(I)%N           =TTREE(IFIELD)%POL(I)%NCRD
    SHP%POL(I)%ITYPE           =TTREE(IFIELD)%POL(I)%ITYPE
    SHP%POL(I)%IACT           =TTREE(IFIELD)%POL(I)%IACT
    SHP%POL(I)%ICOLOR          =TTREE(IFIELD)%POL(I)%ICLR
    SHP%POL(I)%PNAME           =TTREE(IFIELD)%POL(I)%POLNAME
    SHP%POL(I)%IWIDTH          =TTREE(IFIELD)%POL(I)%WIDTH
    SHP%POL(I)%X(1:SHP%POL(I)%N)=TTREE(IFIELD)%POL(I)%X
    SHP%POL(I)%Y(1:SHP%POL(I)%N)=TTREE(IFIELD)%POL(I)%Y
   END DO
  !## measure
  CASE (2)
   SHP%NPOL=MTREE(IFIELD)%NPOL
   !## copy shapes into polygon for ir
   DO I=1,SHP%NPOL
    SHP%POL(I)%N           =MTREE(IFIELD)%POL(I)%NCRD
    SHP%POL(I)%ITYPE           =MTREE(IFIELD)%POL(I)%ITYPE
    SHP%POL(I)%IACT           =MTREE(IFIELD)%POL(I)%IACT
    SHP%POL(I)%ICOLOR          =MTREE(IFIELD)%POL(I)%ICLR
    SHP%POL(I)%PNAME           =MTREE(IFIELD)%POL(I)%POLNAME
    SHP%POL(I)%IWIDTH          =MTREE(IFIELD)%POL(I)%WIDTH
!WRITE(*,*) 'pol2shape=',SHP%POL(I)%N,SIZE(mtree(ifield)%POL(i)%x),ifield
    SHP%POL(I)%X(1:SHP%POL(I)%N)=MTREE(IFIELD)%POL(I)%X
    SHP%POL(I)%Y(1:SHP%POL(I)%N)=MTREE(IFIELD)%POL(I)%Y
   END DO
!   WRITE(*,*) 'pol2shape,SHP%NPOL=',SHP%NPOL,ifield,MTREE(IFIELD)%NPOL

 END SELECT

 END SUBROUTINE IR1POL2SHAPE

 !###======================================================================
 SUBROUTINE IR1GETTREEVIEWID(ITREE,IFIELD)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: ITREE,IFIELD
 INTEGER :: ID

 CALL WDIALOGSELECT(ID_DIR_PM)
 CALL WDIALOGGETTREEVIEW(IDF_TREEVIEW1,ID)
 CALL IR1GETTREEID(ITREE,IFIELD,ID)

 END SUBROUTINE IR1GETTREEVIEWID

 !###======================================================================
 SUBROUTINE IR1GETTREEID(ITREE,IFIELD,ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(OUT) :: ITREE,IFIELD
 INTEGER,INTENT(IN) :: ID

 ITREE=1
 DO IFIELD=1,NTARGET
  IF(TTREE(IFIELD)%TARGET_ID.EQ.ID)  RETURN
 END DO
 ITREE=2
 DO IFIELD=1,NMEASURE
  IF(MTREE(IFIELD)%MEASURE_ID.EQ.ID)RETURN
 END DO
 ITREE=3
 DO IFIELD=1,NRESULT
  IF(RTREE(IFIELD)%RESULT_ID.EQ.ID)  RETURN
 END DO

 END SUBROUTINE

 !###======================================================================
 FUNCTION IR1GETFREETREEID()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ID,I,J,IR1GETFREETREEID

! DO I=1,NTARGET
!  WRITE(*,*) I,NTARGET,TTREE(I)%TARGET_ID
! END DO
! DO I=1,NMEASURE
!  WRITE(*,*) I,NMEASURE,MTREE(I)%MEASURE_ID
! END DO
! DO I=1,NRESULT
!  WRITE(*,*) I,NRESULT,RTREE(I)%RESULT_ID
! END DO

 ID=0
 DO
  ID=ID+1
  J =0
  DO I=1,NTARGET
   IF(TTREE(I)%TARGET_ID.EQ.ID) J=J+1
  END DO
  DO I=1,NMEASURE
   IF(MTREE(I)%MEASURE_ID.EQ.ID)J=J+1
  END DO
  DO I=1,NRESULT
   IF(RTREE(I)%RESULT_ID.EQ.ID) J=J+1
  END DO
  IF(J.EQ.0)EXIT
 END DO
 IR1GETFREETREEID=ID

 END FUNCTION

 !###======================================================================
 SUBROUTINE IR1GETTREEIDS(IFIELD,ITARGET,IMEASURE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IFIELD
 INTEGER,INTENT(OUT) :: ITARGET,IMEASURE
 INTEGER :: I,ITREE

 !## get measure id
 I=RTREE(IFIELD)%IDPOS
 CALL IR1GETTREEID(ITREE,IMEASURE,I)
 !## get target id
 I=MTREE(IMEASURE)%IDPOS
 CALL IR1GETTREEID(ITREE,ITARGET,I)

 END SUBROUTINE IR1GETTREEIDS

 !###======================================================================
 SUBROUTINE IR1FIELDS_STRING(CTREE,ITREE,IFIELD)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),DIMENSION(3),INTENT(OUT) :: CTREE
 INTEGER,INTENT(IN) :: ITREE,IFIELD
 INTEGER :: JTREE,JFIELD,I,ID

 JTREE =ITREE
 JFIELD=IFIELD

 CTREE=''
 DO I=ITREE,1,-1
  SELECT CASE (JTREE)
   CASE (1)
    CTREE(I)=TTREE(JFIELD)%CNAME
!    ID=TTREE(IFIELD)%IDPOS
   CASE (2)
    CTREE(I)=MTREE(JFIELD)%CNAME
    ID=MTREE(JFIELD)%IDPOS
   CASE (3)
    CTREE(I)=RTREE(JFIELD)%CNAME
    ID=RTREE(JFIELD)%IDPOS
  END SELECT
  CALL IR1GETTREEID(JTREE,JFIELD,ID)
 END DO

 END SUBROUTINE IR1FIELDS_STRING

 !###======================================================================
 SUBROUTINE IR1FIELDS_GETIPERIRES(IDFNAME,IPER,IRES)
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: IDFNAME
 INTEGER,INTENT(OUT) :: IPER,IRES

 !## find proper time-information found
 DO IPER=1,NPER
  IF(INDEX(TRIM(IDFNAME),TRIM(PER(IPER)%NAMEPER)).NE.0)EXIT
 END DO
 !## find proper topic-information found
 DO IRES=1,NRES
  IF(INDEX(TRIM(IDFNAME),TRIM(RES(IRES)%NAMERES)).NE.0)EXIT
 END DO

 END SUBROUTINE IR1FIELDS_GETIPERIRES

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

 IF(ALLOCATED(LISTNAME))DEALLOCATE(LISTNAME)
 IF(ALLOCATED(IDFRESLIST))DEALLOCATE(IDFRESLIST)

 END SUBROUTINE IR1FIELDS_DEALLOCATE

END MODULE MOD_IR_UTL