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

USE MOD_UTL
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_ISG_UTL, ONLY : UTL_GETUNITSISG
USE MOD_ISG_PAR, ONLY : ISFR,TATTRIB1,TATTRIB2,ICF,ISGDOUBLE,RECLEN,RECLND,X_SP
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_POLYGON_UTL, ONLY  :POLYGON1SAVELOADSHAPE
USE MOD_IDF, ONLY : IDFREAD,IDFGETVAL,IDFIROWICOL
USE MOD_IPF, ONLY : IPFALLOCATE,IPFREAD2
USE MOD_IPF_PAR, ONLY : IPF,NIPF

INTEGER,PARAMETER :: NIU=19
INTEGER,PARAMETER :: ISG=1,ISP=2,ISD1=3,ISD2=4,ISC1=5,ISC2=6,IOUT=11,IIDFZ=12, &
                     IST1=7,IST2=8,ISQ1=9,ISQ2=10,ICCF=13,IIDFW=14,IIDFB=15,   &
                     IIDFC=16,IIDFI=17,IIDFZ_BU=18,IIDFW_BU=19

CHARACTER(LEN=256),DIMENSION(NIU) :: FNAME
INTEGER,DIMENSION(NIU) :: IOS,IU
INTEGER,DIMENSION(7) :: DATCOL
INTEGER :: SAMPLE,NPROF,ISTART,ISTOP,IBOT,ICDY,IINF,ISUMMER_BACKUP,IWINTER_BACKUP,NP,NBRCH,ICORDIR
CHARACTER(LEN=4) :: CWINTER,CSUMMER
REAL(KIND=DP_KIND) :: CDAY,INFFCT,RBOT,XSEARCH
REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: PNTX,PNTY
REAL(KIND=DP_KIND),DIMENSION(2,2) :: XC,YC
INTEGER,ALLOCATABLE,DIMENSION(:) :: IP,IDNSEG
CHARACTER(LEN=MAXLEN),ALLOCATABLE,DIMENSION(:) :: CBID
CHARACTER(LEN=256) :: LINE
TYPE(IDFOBJ),DIMENSION(7) :: IDF
TYPE TYPEPROF
 REAL(KIND=DP_KIND) :: DISTANCE,BOTTOM,WLVLUP,WLVLDN
END TYPE TYPEPROF
TYPE(TYPEPROF),DIMENSION(:,:),ALLOCATABLE :: PROF
LOGICAL :: LDAT

CONTAINS

 !##=====================================================================
 SUBROUTINE ISGGEN_IPFTOISG(IPFFILE,ISGFILE,DATCOL)
 !##=====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: IPFFILE,ISGFILE
 INTEGER,INTENT(IN),DIMENSION(:) :: DATCOL
 CHARACTER(LEN=MAXLEN) :: CS1,CS2
 CHARACTER(LEN=52) :: WC
 CHARACTER(LEN=256) :: DIR
 CHARACTER(LEN=256),DIMENSION(:),POINTER :: LISTNAME
 REAL(KIND=DP_KIND) :: WL1,BL1,WD1,WL2,BL2,WD2,X1,Y1,X2,Y2,HC1,HC2
 INTEGER :: I,J,IIPF
 CHARACTER(LEN=52),POINTER,DIMENSION(:,:) :: VAR
 
 !## get list of ipf files
 IF(INDEX(IPFFILE,'*').GT.0)THEN
  WC=IPFFILE(INDEX(IPFFILE,'\',.TRUE.)+1:)
  DIR=IPFFILE(:INDEX(IPFFILE,'\',.TRUE.)-1)
  IF(.NOT.UTL_DIRINFO_POINTER(DIR,WC,LISTNAME,'F'))RETURN
  IF(SIZE(LISTNAME).LE.0)RETURN
  NIPF=SIZE(LISTNAME); CALL IPFALLOCATE()
  !## read all ipf files
  DO I=1,NIPF
   IPF(I)%FNAME=TRIM(DIR)//'\'//TRIM(LISTNAME(I))
   IPF(I)%XCOL =DATCOL(1)  !## x1
   IPF(I)%YCOL =DATCOL(2)  !## y1
   IPF(I)%ZCOL =DATCOL(5)  !## x2
   IPF(I)%Z2COL=DATCOL(6)  !## y2
   IPF(I)%QCOL =DATCOL(7)  !## stage
   !## read entire ipf
   IF(.NOT.IPFREAD2(I,1,1))THEN
    WRITE(*,'(A)') 'Cannot read '//TRIM(IPF(I)%FNAME); RETURN
   ENDIF
  ENDDO
 ELSE
  !## read ipf
  NIPF=1; CALL IPFALLOCATE()
  IPF(1)%FNAME=IPFFILE
  IPF(1)%XCOL =DATCOL(1)  !## x1
  IPF(1)%YCOL =DATCOL(2)  !## y1
  IPF(1)%ZCOL =DATCOL(5)  !## x2
  IPF(1)%Z2COL=DATCOL(6)  !## y2
  IPF(1)%QCOL =DATCOL(7)  !## stage
  !## read entire ipf
  IF(.NOT.IPFREAD2(1,1,1))THEN
   WRITE(*,'(A)') 'Cannot read '//TRIM(IPFFILE); RETURN
  ENDIF
 ENDIF
 
 !## fill in cross-sections per segment
 LDAT=.FALSE.;  NPROF=4

 !## allocate pntx/pnty/ip/ibid
 DO I=1,2
  NBRCH=0; NP=0; IF(I.EQ.2)IP(0)=1
  DO IIPF=1,SIZE(IPF)
   DO J=1,IPF(IIPF)%NROW-1
    
    !## if not a label, use id-number
    IF(TRIM(IPF(IIPF)%INFO(DATCOL(3),J)).EQ.'')IPF(IIPF)%INFO(DATCOL(3),J)=IPF(IIPF)%INFO(DATCOL(4),J)

    READ(IPF(IIPF)%INFO(DATCOL(1),J),*)   X1
    READ(IPF(IIPF)%INFO(DATCOL(2),J),*)   Y1
    READ(IPF(IIPF)%INFO(DATCOL(1),J+1),*) X2
    READ(IPF(IIPF)%INFO(DATCOL(2),J+1),*) Y2

    CS1=UTL_CAP(IPF(IIPF)%INFO(DATCOL(4),J  ),'U')
    CS2=UTL_CAP(IPF(IIPF)%INFO(DATCOL(4),J+1),'U')

    !## duplicate coordinates, start new branch
    IF(TRIM(CS1).EQ.TRIM(CS2))THEN
     !## skip distance is zero
     IF(UTL_DIST(X1,Y1,X2,Y2).GT.0.0D0)THEN 
      IF(I.EQ.2)THEN
       PNTX(NP+1)=X1; PNTY(NP+1)=Y1
       PNTX(NP+2)=X2; PNTY(NP+2)=Y2
     
       IP(NBRCH+1)=NP+3
       CBID(NBRCH+1)='S_'//TRIM(IPF(IIPF)%INFO(DATCOL(3),J))//'_R_'//TRIM(ITOS(NBRCH+1))
       IDNSEG(NBRCH+1)=0 
     
       !## left side
       READ(IPF(IIPF)%INFO(DATCOL(5),J),*)     WD1
       READ(IPF(IIPF)%INFO(DATCOL(6),J),*)     BL1
       READ(IPF(IIPF)%INFO(DATCOL(7),J),*)     WL1
       READ(IPF(IIPF)%INFO(DATCOL(8),J),*)     HC1

       READ(IPF(IIPF)%INFO(DATCOL(5),J+1),*)   WD2
       READ(IPF(IIPF)%INFO(DATCOL(6),J+1),*)   BL2
       READ(IPF(IIPF)%INFO(DATCOL(7),J+1),*)   WL2
       READ(IPF(IIPF)%INFO(DATCOL(8),J+1),*)   HC2
       
!!## controles hessen
!       IF(BL1.LE.0.0D0)THEN
!        WRITE(*,*) J,WL1,BL1,WL1-BL1,TRIM(IPF(IIPF)%INFO(DATCOL(3),J))
!       ENDIF 
!       IF(BL2.LE.0.0D0)THEN
!        WRITE(*,*) J,WL2,BL2,WL2-BL2,TRIM(IPF(IIPF)%INFO(DATCOL(3),J))
!       ENDIF 
!
!       IF(BL1.GE.WL1)THEN
!        WRITE(*,*) J,WL1,BL1,WL1-BL1,TRIM(IPF(IIPF)%INFO(DATCOL(3),J))
!       ENDIF
!       IF(BL2.GE.WL2)THEN
!        WRITE(*,*) J,WL2,BL2,WL2-BL2,TRIM(IPF(IIPF)%INFO(DATCOL(3),J))
!       ENDIF
!!##
!       !## skip these ...?
!       IF(BL1.LE.BL2)THEN
!        WRITE(*,*) J,BL1,BL2,BL1-BL2,TRIM(IPF(IIPF)%INFO(DATCOL(3),J))
!        cycle
!       ENDIF 
       
       PROF(1,NBRCH+1)%DISTANCE=-WD1
       PROF(1,NBRCH+1)%BOTTOM  = WL1
       PROF(2,NBRCH+1)%DISTANCE=-HC1 
       PROF(2,NBRCH+1)%BOTTOM  = BL1
       PROF(3,NBRCH+1)%DISTANCE= HC2 
       PROF(3,NBRCH+1)%BOTTOM  = BL2
       PROF(4,NBRCH+1)%DISTANCE= WD2
       PROF(4,NBRCH+1)%BOTTOM  = WL2
      ENDIF
      NP=NP+2; NBRCH=NBRCH+1
     ENDIF
    ENDIF 
   ENDDO
  ENDDO
  IF(I.EQ.1)THEN
   ALLOCATE(PNTX(NP),PNTY(NP),IP(0:NBRCH),CBID(NBRCH),IDNSEG(NBRCH)); ALLOCATE(PROF(4,NBRCH))
  ENDIF
 ENDDO

 !## create isgfile from ipffile
 ISFR=1; ISGDOUBLE=4; CALL ISGGEN_CREATEISG(ISGFILE,VAR)

 END SUBROUTINE ISGGEN_IPFTOISG

 !##=====================================================================
 SUBROUTINE ISGGEN_GENTOISG(GENFNAME,OUTFILE)
 !##=====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(IN) :: GENFNAME,OUTFILE
 INTEGER :: I,J
 LOGICAL :: LEX
 REAL(KIND=DP_KIND) :: X,Y
 INTEGER,DIMENSION(7) :: ILIST
 CHARACTER(LEN=52),POINTER,DIMENSION(:,:) :: VAR
 DATA ILIST/IIDFZ,IIDFW,IIDFB,IIDFC,IIDFI,IIDFZ_BU,IIDFW_BU/
 
CALL POLYGON1SAVELOADSHAPE(ID_LOADSHAPE,GENFNAME,'GEN')
CALL ISGGEN_READGEN() 

IF(.NOT.LDAT)THEN
 IU(ICCF)=UTL_GETUNIT()
 CALL OSD_OPEN(IU(ICCF),FILE=FNAME(ICCF),STATUS='OLD',ACTION='READ,DENYWRITE')
 READ(IU(ICCF),*)
 NPROF=0
 DO
  READ(IU(ICCF),*,IOSTAT=IOS(ICCF)) X,Y
  IF(IOS(ICCF).NE.0)EXIT
  NPROF=NPROF+1
 END DO
 ALLOCATE(PROF(NPROF,1))
 REWIND(IU(ICCF))
 READ(IU(ICCF),*)
 WRITE(*,'(/1X,2A10)') 'DISTANCE','BOTTOM'
 DO I=1,NPROF
  READ(IU(ICCF),*,IOSTAT=IOS(ICCF)) PROF(I,1)%DISTANCE,PROF(I,1)%BOTTOM
  WRITE(*,'(1X,2F10.2)') PROF(I,1)%DISTANCE,PROF(I,1)%BOTTOM
 END DO
 CLOSE(IU(ICCF))

 IF(IBOT.EQ.1)ILIST(3)=0
 IF(ICDY.EQ.1)ILIST(4)=0
 IF(IINF.EQ.1)ILIST(5)=0
 IF(IWINTER_BACKUP.EQ.0)ILIST(6)=0 
 IF(ISUMMER_BACKUP.EQ.0)ILIST(7)=0
 
 DO I=1,SIZE(ILIST) 
  IF(ILIST(I).NE.0)THEN
   J    =ILIST(I)
   IU(J)=UTL_GETUNIT()
   INQUIRE(FILE=FNAME(J),EXIST=LEX)
   IF(LEX)THEN
    IF(.NOT.IDFREAD(IDF(I),FNAME(J),0))RETURN
    IF(IDF(I)%IEQ.NE.0)STOP 'cannot use idf with ieq ne 0'
   ELSE
    WRITE(*,'(A)') 'Cannot find '//TRIM(FNAME(J)); STOP
   ENDIF
  ENDIF
 ENDDO

ELSE

 CALL UTL_GENLABELSREAD(GENFNAME(:INDEX(GENFNAME,'.',.TRUE.)-1)//'.DAT',VAR,NL,NV)
 IF(NV.LT.MAXVAL(DATCOL))STOP 'No enough columns in dat file'
 IF(.NOT.ASSOCIATED(VAR).OR.NL.LE.0)STOP 'No records found in dat file'

ENDIF

!## create isgfile from genfile
ISFR=0; ISGDOUBLE=4; CALL ISGGEN_CREATEISG(OUTFILE,VAR)

DEALLOCATE(PNTX,PNTY,IP,CBID)

END SUBROUTINE ISGGEN_GENTOISG

!##=====================================================================
SUBROUTINE ISGGEN_CREATEISG(OUTFILE,VAR)
!##=====================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: OUTFILE
INTEGER :: ISEG,ICRS,IB,NNP,ICLC,NSEG,NCLC,NCRS,IREFSD,IREFSC,I,IREC,IQHR,NQHR,IREFQH
LOGICAL :: LCRDFLIP
REAL(KIND=DP_KIND) :: DIST
CHARACTER(LEN=*),POINTER,DIMENSION(:,:),INTENT(IN) :: VAR

FNAME(ISG) =OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISG'
FNAME(ISP) =OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISP'
FNAME(ISD1)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISD1'
FNAME(ISD2)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISD2'
FNAME(ISC1)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISC1'
FNAME(ISC2)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISC2'
FNAME(IST1)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.IST1'
FNAME(IST2)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.IST2'
FNAME(ISQ1)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISQ1'
FNAME(ISQ2)=OUTFILE(:INDEX(OUTFILE,'.',.TRUE.)-1)//'.ISQ2'

FNAME(IOUT)='OUTPUT.TXT'

!## create folder
I=INDEX(OUTFILE,'\',.TRUE.)-1; CALL UTL_CREATEDIR(OUTFILE(:I))

CALL UTL_GETUNITSISG(IU,OUTFILE,'REPLACE')

IU(IOUT)=UTL_GETUNIT()
CALL OSD_OPEN(IU(IOUT),FILE=FNAME(IOUT),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED',IOSTAT=IOS(IOUT))

WRITE(IU(ISG),*) NBRCH,ISFR

WRITE(*,'(/A/)')

ISEG  =0  !## segment-points
ICRS  =0  !## cross-sections
ICLC  =0  !## data
IQHR  =0  !## qwd
IREFSD=0
IREFSC=0
IREFQH=0
NNP   =0
DO IB=1,NBRCH

 CALL ISGGEN_GETDIST(IB,DIST)

 IF(ISFR.EQ.0)THEN
  CALL ISGGEN_CREATEISD1(ICLC,NCLC,IREFSD,DIST,IB,VAR,LCRDFLIP,1)
 ELSEIF(ISFR.EQ.1)THEN
  CALL ISGGEN_CREATEISD1_SFR(ICLC,NCLC,IREFSD,DIST,IB,LCRDFLIP,1)
 ENDIF 

 CALL ISGGEN_CREATEISP(IB,ISEG,NNP,NSEG,LCRDFLIP)

 IF(ISFR.EQ.0)THEN
  CALL ISGGEN_CREATEISD1(ICLC,NCLC,IREFSD,DIST,IB,VAR,LCRDFLIP,2)
  CALL ISGGEN_CREATEISC1(ICRS,NCRS,IREFSC,DIST,IB,1,VAR)
  IQHR=-1; NQHR=0
 ELSEIF(ISFR.EQ.1)THEN
  CALL ISGGEN_CREATEISD1_SFR(ICLC,NCLC,IREFSD,DIST,IB,LCRDFLIP,2)
  CALL ISGGEN_CREATEISC1(ICRS,NCRS,IREFSC,DIST,IB,IB,VAR)
  CALL ISGGEN_CREATEISQ1(IQHR,NQHR,IREFQH,DIST)
 ENDIF 
 
 
 LINE='"'//TRIM(CBID(IB))//'",'//TRIM(ITOS(ISEG-NSEG+1))//','//TRIM(ITOS(NSEG))//','// &
                                 TRIM(ITOS(ICLC-NCLC+1))//','//TRIM(ITOS(NCLC))//','// &
                                 TRIM(ITOS(ICRS-NCRS+1))//','//TRIM(ITOS(NCRS))//','// &
                                 TRIM(ITOS(0))          //','//TRIM(ITOS(0))   //','// &
                                 TRIM(ITOS(IQHR-NQHR+1))//','//TRIM(ITOS(NQHR))

 WRITE(IU(ISG),'(A)') TRIM(LINE)

 IF(NBRCH.GT.1000)WRITE(6,'(A,F10.4,A)') '+Progress ',REAL(IB*100)/REAL(NBRCH),'%         '   
END DO

WRITE(*,'(A)') 'Number of records in:'
WRITE(*,'(A, I10)') TRIM(FNAME(ISG)) //' ',NBRCH
WRITE(*,'(A, I10)') TRIM(FNAME(ISP)) //' ',NNP
WRITE(*,'(A,2I10)') TRIM(FNAME(ISD1))//' ',ICLC,IREFSD
WRITE(*,'(A,2I10)') TRIM(FNAME(ISC1))//' ',ICRS,IREFSC
WRITE(*,'(A,2I10)') TRIM(FNAME(IST1))//' ',0,0
WRITE(*,'(A,2I10)') TRIM(FNAME(ISQ1))//' ',MAX(0,IQHR),IREFQH

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISP) ,REC=1) UTL_PUTRECORDLENGTH(RECLEN(2)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISP) ,REC=1) UTL_PUTRECORDLENGTH(RECLND(2)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISD1),REC=1) UTL_PUTRECORDLENGTH(RECLEN(3)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISD1),REC=1) UTL_PUTRECORDLENGTH(RECLND(3)) 

IF(ISGDOUBLE.EQ.4)THEN
 IF(ISFR.EQ.0)IREC=RECLEN(4) 
 IF(ISFR.EQ.1)IREC=9*4 + 5*4 + 8
ELSEIF(ISGDOUBLE.EQ.8)THEN
 IF(ISFR.EQ.0)IREC=RECLND(4) 
 IF(ISFR.EQ.1)IREC=9*8 + 5*4 + 8
ENDIF

WRITE(IU(ISD2),REC=1) UTL_PUTRECORDLENGTH(IREC)

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISC1),REC=1) UTL_PUTRECORDLENGTH(RECLEN(5)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISC1),REC=1) UTL_PUTRECORDLENGTH(RECLND(5)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISC2),REC=1) UTL_PUTRECORDLENGTH(RECLEN(6)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISC2),REC=1) UTL_PUTRECORDLENGTH(RECLND(6)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(IST1),REC=1) UTL_PUTRECORDLENGTH(RECLEN(7)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(IST1),REC=1) UTL_PUTRECORDLENGTH(RECLND(7)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(IST2),REC=1) UTL_PUTRECORDLENGTH(RECLEN(8)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(IST2),REC=1) UTL_PUTRECORDLENGTH(RECLND(8)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISQ1),REC=1) UTL_PUTRECORDLENGTH(RECLEN(9)) 
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISQ1),REC=1) UTL_PUTRECORDLENGTH(RECLND(9)) 

IF(ISGDOUBLE.EQ.4)WRITE(IU(ISQ2),REC=1) UTL_PUTRECORDLENGTH(RECLEN(10))
IF(ISGDOUBLE.EQ.8)WRITE(IU(ISQ2),REC=1) UTL_PUTRECORDLENGTH(RECLND(10))
 
END SUBROUTINE ISGGEN_CREATEISG

 !##=====================================================================
 SUBROUTINE ISGGEN_CREATEISP(IB,ISEG,NNP,NSEG,LCRDFLIP)
 !##=====================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(IN) :: LCRDFLIP
 LOGICAL :: LEX
 INTEGER,INTENT(IN) :: IB
 INTEGER,INTENT(INOUT) :: ISEG,NNP
 INTEGER,INTENT(OUT) :: NSEG
 INTEGER :: N,I,J,II !,I1,I2
 REAL(KIND=DP_KIND) :: X,Y
 
 IF(IB.EQ.33367)THEN
 WRITE(*,*)
 ENDIF
 
 !## flip coordinates
 IF(LCRDFLIP)THEN
  N=((IP(IB)-1)-IP(IB-1))/2
  J=0; II=1+(IP(IB)-1)
  DO I=IP(IB-1),IP(IB)-1
   II=II-1
   J=J+1; IF(J.GT.N)EXIT
   X=PNTX(I)
   Y=PNTY(I)
   PNTX(I)=PNTX(II)
   PNTY(I)=PNTY(II)
   PNTX(II)=X
   PNTY(II)=Y
  ENDDO
 ENDIF

 J   =0
 DO I=IP(IB-1),IP(IB)-1

  LEX=.TRUE.
  IF(I.NE.IP(IB-1))THEN
   IF(PNTX(I).EQ.PNTX(I-1).AND.PNTY(I).EQ.PNTY(I-1))LEX=.FALSE.
  ENDIF

  IF(LEX)THEN
   ISEG=ISEG+1
   J   =J+1
   IF(ISGDOUBLE.EQ.4)THEN
    X_SP(1)=REAL(PNTX(I),4)
    X_SP(2)=REAL(PNTY(I),4)
    WRITE(IU(ISP),REC=ISEG+ICF) X_SP(1),X_SP(2)
   ELSE
    WRITE(IU(ISP),REC=ISEG+ICF) PNTX(I),PNTY(I)
   ENDIF
  ENDIF
   
 END DO

 if(J.LE.1)THEN
  WRITE(*,*) 
 ENDIF

 NSEG=J
 NNP =NNP+J

 END SUBROUTINE ISGGEN_CREATEISP

!##=====================================================================
SUBROUTINE ISGGEN_GETDIST(IB,DIST)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IB
REAL(KIND=DP_KIND),INTENT(OUT) :: DIST
INTEGER :: I

DIST=0.0D0
DO I=IP(IB-1)+1,IP(IB)-1
 IF(PNTX(I).NE.PNTX(I-1).OR.PNTY(I).NE.PNTY(I-1))THEN
  DIST=DIST+SQRT((PNTX(I)-PNTX(I-1))**2.0D0+(PNTY(I)-PNTY(I-1))**2.0D0)
 ENDIF
END DO

END SUBROUTINE ISGGEN_GETDIST

!##=====================================================================
SUBROUTINE ISGGEN_CREATEISD1(ICLC,NCLC,IREFSD,DIST,IB,VAR,LCRDFLIP,IMODE)
!##=====================================================================
IMPLICIT NONE
LOGICAL,INTENT(OUT) :: LCRDFLIP
INTEGER,INTENT(INOUT) :: ICLC,IREFSD
INTEGER,INTENT(OUT) :: NCLC
REAL(KIND=DP_KIND),INTENT(IN) :: DIST
INTEGER,INTENT(IN) :: IB,IMODE
CHARACTER(LEN=*),POINTER,DIMENSION(:,:),INTENT(IN) :: VAR
REAL(KIND=DP_KIND) :: WL,WB,RS,FC,XDIST,XSAMPLE,FCT,D,DSAMPLE,MXWL_F,MXWL_T
INTEGER :: ID,I,J,ISAMPLE,IC,N,IY,ISTEP,IL,IOS
CHARACTER(LEN=8) :: CDATE
REAL(KIND=DP_KIND) :: XC,YC
CHARACTER(LEN=32) :: CNAME
CHARACTER(LEN=52) :: CID

NCLC=0; FC=INFFCT; RS=CDAY; LCRDFLIP=.FALSE.

MXWL_F=-1.0D0*HUGE(1.0)
MXWL_T=-1.0D0*HUGE(1.0)

!## add data for start and end segment point
IF(LDAT)THEN

 WRITE(CID,*) CBID(IB)
 CID=ADJUSTL(CID)

 CALL UTL_GENLABELSGET(CID,IL,VAR)
 IF(IL.EQ.0)RETURN

 READ(VAR(DATCOL(1),IL),*,IOSTAT=IOS) WL
 READ(VAR(DATCOL(3),IL),*,IOSTAT=IOS) WB

 MXWL_F=MAX(MXWL_F,WL)
 
 IF(IMODE.EQ.2)THEN

  N=1; ICLC=ICLC+1; NCLC=NCLC+1; IREFSD=IREFSD+1              

  !## from
  WRITE(CNAME,'(A8,I4.4)') 'ClcFROM:',IB
  IF(ISGDOUBLE.EQ.4)WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,0.0  ,CNAME
  IF(ISGDOUBLE.EQ.8)WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,0.0D0,CNAME

  IF(ISGDOUBLE.EQ.4)THEN
   X_SP(1)=REAL(WL,4)
   X_SP(2)=REAL(WB,4)
   X_SP(3)=REAL(RS,4)
   X_SP(4)=REAL(FC,4)
   WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,(X_SP(I),I=1,4)
  ELSEIF(ISGDOUBLE.EQ.8)THEN
   WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,WL,WB,RS,FC 
  ENDIF
 
 ENDIF
 
 READ(VAR(DATCOL(2),IL),*,IOSTAT=IOS) WL
 READ(VAR(DATCOL(4),IL),*,IOSTAT=IOS) WB

 MXWL_T=MAX(MXWL_T,WL)

 IF(IMODE.EQ.2)THEN

  N=1; ICLC=ICLC+1; NCLC=NCLC+1; IREFSD=IREFSD+1              

  !## to
  WRITE(CNAME,'(A8,I4.4)') 'ClcTO:',IB
  IF(ISGDOUBLE.EQ.4)THEN
   X_SP(1)=REAL(DIST,4)
   WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,X_SP(1),CNAME
  ELSEIF(ISGDOUBLE.EQ.8)THEN
   WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,DIST,CNAME
  ENDIF

  IF(ISGDOUBLE.EQ.4)THEN
   X_SP(1)=REAL(WL,4)
   X_SP(2)=REAL(WB,4)
   X_SP(3)=REAL(RS,4)
   X_SP(4)=REAL(FC,4)
   WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,(X_SP(I),I=1,4)
  ELSE
   WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,WL,WB,RS,FC 
  ENDIF
 
 ENDIF
 
 RETURN
ENDIF

IF(IMODE.EQ.2)THEN

 ICLC=ICLC+1; NCLC=NCLC+1

 N=((ISTOP-ISTART)+1)*2

 CNAME=''; WRITE(CNAME,'(A8,I8.8)') 'ClcFROM:',IB

 IF(ISGDOUBLE.EQ.4)WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,0.0  ,CNAME
 IF(ISGDOUBLE.EQ.8)WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,0.0D0,CNAME

ENDIF

DO IY=ISTART,ISTOP
 DO IC=2,3
  IF(MOD(IC,2).EQ.0)THEN
   WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
   WL=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),1,IU(IIDFZ),ISTEP) 
   !## use backup if no point is found
   IF(WL.EQ.IDF(1)%NODATA.AND.ISUMMER_BACKUP.EQ.1)THEN; WL=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)+1),PNTY(IP(IB-1)+1),6,IU(IIDFZ_BU),ISTEP); ENDIF
  ELSE
   WRITE(CDATE,'(I4.4,A4)') IY,CWINTER
   WL=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),2,IU(IIDFW),ISTEP)
   !## use backup if no point is found
   IF(WL.EQ.IDF(2)%NODATA.AND.IWINTER_BACKUP.EQ.1)THEN; WL=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)+1),PNTY(IP(IB-1)+1),7,IU(IIDFW_BU),ISTEP); ENDIF
  ENDIF
  MXWL_F=MAX(MXWL_F,WL)

  IF(IBOT.EQ.1)THEN; WB=WL-RBOT
  ELSE; WB=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),3,IU(IIDFB),ISTEP); ENDIF
  IF(ICDY.EQ.1)THEN; RS=CDAY
  ELSE; RS=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),4,IU(IIDFC),ISTEP); ENDIF
  IF(IINF.EQ.1)THEN; FC=INFFCT
  ELSE; FC=ISGGEN_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),5,IU(IIDFI),ISTEP); ENDIF

  READ(CDATE,*) ID

  IF(IMODE.EQ.2)THEN
   IREFSD=IREFSD+1
   IF(ISGDOUBLE.EQ.4)THEN
    X_SP(1)=REAL(WL,4)
    X_SP(2)=REAL(WB,4)
    X_SP(3)=REAL(RS,4)
    X_SP(4)=REAL(FC,4)
    WRITE(IU(ISD2),REC=IREFSD+ICF) ID,(X_SP(I),I=1,4)
   ELSEIF(ISGDOUBLE.EQ.8)THEN
    WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
   ENDIF
  ENDIF
  
 ENDDO
END DO

IF(IMODE.EQ.2)THEN

 DSAMPLE=DIST/SAMPLE
 ISAMPLE=INT(DSAMPLE)

 IF(ISAMPLE.GE.1)THEN

  !## stepsize
  DSAMPLE=DIST/REAL(ISAMPLE+1)

  XDIST  =0.0D0
  XSAMPLE=DSAMPLE

  DO I=IP(IB-1)+1,IP(IB)-1
   IF(PNTX(I).NE.PNTX(I-1).OR.PNTY(I).NE.PNTY(I-1))THEN

    D=SQRT((PNTX(I)-PNTX(I-1))**2.0D0+(PNTY(I)-PNTY(I-1))**2.0D0)

    IF(XDIST+D.GT.XSAMPLE)THEN

     DO

      FCT    = (XSAMPLE-XDIST)/D

      XC     = PNTX(I-1)+(PNTX(I)-PNTX(I-1))*FCT
      YC     = PNTY(I-1)+(PNTY(I)-PNTY(I-1))*FCT

      ICLC   = ICLC+1
      NCLC   = NCLC+1
      WRITE(CNAME,'(A4,2I8.8)') 'Clc:',IB,NCLC
     
      IF(ISGDOUBLE.EQ.4)THEN
       X_SP(1)=XSAMPLE
       WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,X_SP(1),CNAME
      ELSEIF(ISGDOUBLE.EQ.8)THEN
       WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,XSAMPLE,CNAME
      ENDIF
     
      DO IY=ISTART,ISTOP
       DO IC=2,3
        IF(MOD(IC,2).EQ.0)THEN
         WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
         WL=ISGGEN_GETIDFVAL(XC,YC,1,IU(IIDFZ),ISTEP)
        ELSE
         WRITE(CDATE,'(I4.4,A4)') IY,CWINTER
         WL=ISGGEN_GETIDFVAL(XC,YC,2,IU(IIDFW),ISTEP)
        ENDIF

        IF(IBOT.EQ.1)THEN; WB=WL-RBOT
        ELSE; WB=ISGGEN_GETIDFVAL(XC,YC,3,IU(IIDFB),ISTEP); ENDIF
        IF(ICDY.EQ.1)THEN; RS=CDAY
        ELSE; RS=ISGGEN_GETIDFVAL(XC,YC,4,IU(IIDFC),ISTEP); ENDIF
        IF(IINF.EQ.1)THEN; FC=INFFCT
        ELSE; FC=ISGGEN_GETIDFVAL(XC,YC,5,IU(IIDFI),ISTEP); ENDIF

        READ(CDATE,*) ID
        IREFSD=IREFSD+1
        IF(ISGDOUBLE.EQ.4)THEN
         X_SP(1)=REAL(WL,4)
         X_SP(2)=REAL(WB,4)
         X_SP(3)=REAL(RS,4)
         X_SP(4)=REAL(FC,4)
         WRITE(IU(ISD2),REC=IREFSD+ICF) ID,(X_SP(J),J=1,4)
        ELSE
         WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
        ENDIF
       END DO
      END DO

      XSAMPLE=XSAMPLE+DSAMPLE
      IF(XSAMPLE.GT.XDIST+D)EXIT

     ENDDO
    ENDIF

    XDIST=XDIST+D
 
   ENDIF
  ENDDO
 ENDIF

ENDIF

IF(IMODE.EQ.2)THEN

 !## to
 ICLC  =ICLC+1
 NCLC  =NCLC+1
 WRITE(CNAME,'(A8,I8.8)') 'ClcTO:  ',IB

 IF(ISGDOUBLE.EQ.4)THEN
  X_SP(1)=REAL(DIST,4)
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,X_SP(1),CNAME
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,DIST,CNAME
 ENDIF

 ENDIF
 
 DO IY=ISTART,ISTOP
  DO IC=2,3
   IF(MOD(IC,2).EQ.0)THEN
    WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
    WL=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),1,IU(IIDFZ),ISTEP)
    !## use backup if no point is found
    IF(WL.EQ.IDF(1)%NODATA.AND.ISUMMER_BACKUP.EQ.1)THEN; WL=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),6,IU(IIDFZ_BU),ISTEP); ENDIF
   ELSE
    WRITE(CDATE,'(I4.4,A4)') IY,CWINTER
    WL=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),2,IU(IIDFW),ISTEP)
    !## use backup if no point is found
    IF(WL.EQ.IDF(2)%NODATA.AND.IWINTER_BACKUP.EQ.1)THEN; WL=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),7,IU(IIDFW_BU),ISTEP); ENDIF
   ENDIF
   MXWL_T=MAX(MXWL_T,WL)

   IF(IBOT.EQ.1)THEN; WB=WL-RBOT
   ELSE; WB=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),3,IU(IIDFB),ISTEP); ENDIF
   IF(ICDY.EQ.1)THEN; RS=CDAY
   ELSE; RS=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),4,IU(IIDFC),ISTEP); ENDIF
   IF(IINF.EQ.1)THEN; FC=INFFCT
   ELSE; FC=ISGGEN_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),5,IU(IIDFI),ISTEP); ENDIF

   IF(IMODE.EQ.2)THEN
    READ(CDATE,*) ID
    IREFSD=IREFSD+1
    IF(ISGDOUBLE.EQ.4)THEN
     X_SP(1)=REAL(WL,4)
     X_SP(2)=REAL(WB,4)
     X_SP(3)=REAL(RS,4)
     X_SP(4)=REAL(FC,4)
     WRITE(IU(ISD2),REC=IREFSD+ICF) ID,(X_SP(J),J=1,4)
    ELSEIF(ISGDOUBLE.EQ.8)THEN
     WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
    ENDIF
   ENDIF
  ENDDO
 END DO

 LCRDFLIP=.FALSE.; IF(ICORDIR.EQ.1.AND.MXWL_F.LT.MXWL_T)LCRDFLIP=.TRUE.

 END SUBROUTINE ISGGEN_CREATEISD1

 !##=====================================================================
 SUBROUTINE ISGGEN_CREATEISD1_SFR(ICLC,NCLC,IREFSD,DIST,IB,LCRDFLIP,IMODE)
 !##=====================================================================
 IMPLICIT NONE
 LOGICAL,INTENT(OUT) :: LCRDFLIP
 INTEGER,INTENT(INOUT) :: ICLC,IREFSD
 INTEGER,INTENT(OUT) :: NCLC
 REAL(KIND=DP_KIND),INTENT(IN) :: DIST
 INTEGER,INTENT(IN) :: IB,IMODE
 REAL(KIND=DP_KIND) :: WLVL,BTML,WD,THCK,HCND,QFLW,QROF,PPTSW,ETSW,MXWL_F,MXWL_T
 INTEGER :: IDATE,UPSG,DWNS,ICALC,IPRI,N,I
 CHARACTER(LEN=32) :: CNAME
 CHARACTER(LEN=8) :: CTIME

 IDATE=19000000
 CTIME='00:00:00'
 QFLW=0.0D0
 QROF=0.0D0
 UPSG=0
 DWNS=IDNSEG(IB)
 !## rectangular profile (becomes 1 in sfr package but second option in dropdown menu)
 ICALC=2
 !## no diversion
 IPRI=1
 PPTSW=0.0D0
 ETSW=0.0D0
 
 MXWL_F=-1.0D0*HUGE(1.0)
 MXWL_T=-1.0D0*HUGE(1.0)

 NCLC=0

 N=1; ICLC=ICLC+1; NCLC=NCLC+1; IREFSD=IREFSD+1              

 !## water level
 WLVL=PROF(1,IB)%BOTTOM
 !## bottom level
 BTML=PROF(2,IB)%BOTTOM
 !## width (rectangular)
 WD=ABS(PROF(1,IB)%DISTANCE)

 MXWL_F=MAX(MXWL_F,BTML)

 THCK=0.10
 HCND=ABS(PROF(2,IB)%DISTANCE)
  
 !## from
 WRITE(CNAME,'(A8,I8.8)') 'ClcFROM:',IB
 IF(ISGDOUBLE.EQ.4)THEN
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,0.0  ,CNAME
  X_SP(1)=REAL(WLVL,4)
  X_SP(2)=REAL(BTML,4)
  X_SP(3)=REAL(WD,4)
  X_SP(4)=REAL(THCK,4)
  X_SP(5)=REAL(HCND,4)
  X_SP(6)=REAL(QFLW,4)
  X_SP(7)=REAL(QROF,4)
  X_SP(8)=REAL(PPTSW,4)
  X_SP(9)=REAL(ETSW,4)
  WRITE(IU(ISD2),REC=IREFSD+ICF) IDATE,CTIME,(X_SP(I),I=1,5),UPSG,DWNS,ICALC,IPRI,(X_SP(I),I=6,9)
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,0.0D0,CNAME
  WRITE(IU(ISD2),REC=IREFSD+ICF) IDATE,CTIME,WLVL,BTML,WD,THCK,HCND,UPSG,DWNS,ICALC,IPRI,QFLW,QROF,PPTSW,ETSW
 ENDIF

 N=1; ICLC=ICLC+1; NCLC=NCLC+1; IREFSD=IREFSD+1              

 !## water level
 WLVL=PROF(4,IB)%BOTTOM
 !## bottom level
 BTML=PROF(3,IB)%BOTTOM
 !## width (rectangular)
 WD=PROF(4,IB)%DISTANCE

 MXWL_T=MAX(MXWL_T,BTML)

 THCK=0.10
 HCND=ABS(PROF(3,IB)%DISTANCE)

 !## calculation option not to be specified here, irrelevant
 ICALC=2
 !## no diversion
 IPRI=1
 
 !## to
 WRITE(CNAME,'(A8,I8.8)') 'ClcTO:',IB
 IF(ISGDOUBLE.EQ.4)THEN
  X_SP(1)=REAL(DIST,4)
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,X_SP(1),CNAME
  X_SP(1)=REAL(WLVL,4)
  X_SP(2)=REAL(BTML,4)
  X_SP(3)=REAL(WD,4)
  X_SP(4)=REAL(THCK,4)
  X_SP(5)=REAL(HCND,4)
  X_SP(6)=REAL(QFLW,4)
  X_SP(7)=REAL(QROF,4)
  X_SP(8)=REAL(PPTSW,4)
  X_SP(9)=REAL(ETSW,4)
  WRITE(IU(ISD2),REC=IREFSD+ICF) IDATE,CTIME,(X_SP(I),I=1,5),UPSG,DWNS,ICALC,IPRI,(X_SP(I),I=6,9)
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,DIST,CNAME
  WRITE(IU(ISD2),REC=IREFSD+ICF) IDATE,CTIME,WLVL,BTML,WD,THCK,HCND,UPSG,DWNS,ICALC,IPRI,QFLW,QROF,PPTSW,ETSW
 ENDIF
 
 LCRDFLIP=.FALSE.; IF(ICORDIR.EQ.1.AND.MXWL_F.LT.MXWL_T)LCRDFLIP=.TRUE.

 END SUBROUTINE ISGGEN_CREATEISD1_SFR

 !##=====================================================================
 SUBROUTINE ISGGEN_CREATEISQ1(IQHR,NQHR,IREFQH,DIST)
 !##=====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(INOUT) :: IQHR,IREFQH
 INTEGER,INTENT(OUT) :: NQHR
 REAL(KIND=DP_KIND),INTENT(IN) :: DIST
 CHARACTER(LEN=32) :: CNAME

 IQHR=IQHR+1; CNAME=''; WRITE(CNAME,'(A6,I6)') 'QWD. ',IQHR

 IF(ISGDOUBLE.EQ.4)THEN
  WRITE(IU(ISQ1),REC=IQHR+ICF) 3,IREFQH+1,REAL(DIST,4)/2.0,CNAME 
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISQ1),REC=IQHR+ICF) 3,IREFQH+1,DIST/2.0D0,CNAME 
 ENDIF
 
 IF(ISGDOUBLE.EQ.4)THEN
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF)  10.0,10.0, 5.0,1.0
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF)  50.0,25.0,10.0,1.0
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF) 150.0,50.0,15.0,1.0
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF)  10.0D0,10.0D0, 5.0D0,1.0D0
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF)  50.0D0,25.0D0,10.0D0,1.0D0
  IREFQH=IREFQH+1
  WRITE(IU(ISQ2),REC=IREFQH+ICF) 150.0D0,50.0D0,15.0D0,1.0D0
 ENDIF
 
 NQHR=1

 END SUBROUTINE ISGGEN_CREATEISQ1

!##=====================================================================
SUBROUTINE ISGGEN_CREATEISC1(ICRS,NCRS,IREFSC,DIST,IB,IPROF,VAR)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(INOUT) :: ICRS,IREFSC
INTEGER,INTENT(IN) :: IB,IPROF
INTEGER,INTENT(OUT) :: NCRS
REAL(KIND=DP_KIND),INTENT(IN) :: DIST
CHARACTER(LEN=*),POINTER,DIMENSION(:,:),INTENT(IN) :: VAR
INTEGER :: I,J,IOS,IL
REAL(KIND=DP_KIND) :: WDEPTH,TL,TR,BB,X
CHARACTER(LEN=32) :: CNAME
CHARACTER(LEN=52) :: CID

ICRS=ICRS+1; CNAME=''; WRITE(CNAME,'(A6,I6)') 'Prof. ',ICRS

!## add cross-section info from dat file
IF(LDAT)THEN

 WDEPTH=10.0D0

 CID=ADJUSTL(CBID(IB))

 CALL UTL_GENLABELSGET(CID,IL,VAR); IF(IL.EQ.0)RETURN

 READ(VAR(DATCOL(5),IL),*,IOSTAT=IOS) TL
 READ(VAR(DATCOL(6),IL),*,IOSTAT=IOS) TR
 READ(VAR(DATCOL(7),IL),*,IOSTAT=IOS) BB
 IF(TL.LE.0.0D0.OR.TR.LE.0.0D0.OR.BB.LE.0.0D0)THEN; WRITE(*,*) ' ERROR'; PAUSE; ENDIF
 TL=MAX(0.0D0,TL); TR=MAX(0.0D0,TR); BB=MAX(0.0D0,BB)
 
 IF(ISGDOUBLE.EQ.4)THEN
  X_SP(1)=REAL(DIST/2.0D0,4)
  WRITE(IU(ISC1),REC=ICRS+ICF) 4,IREFSC+1,X_SP(1),CNAME 
  IREFSC=IREFSC+1
  BB=BB/2.0D0; X=TL*WDEPTH
  X_SP(1)=REAL(-X-BB,4)
  X_SP(2)=REAL(WDEPTH,4)
  X_SP(3)=REAL(0.02D0,4)
  WRITE(IU(ISC2),REC=IREFSC+ICF) (X_SP(I),I=1,3) !-X-BB,WDEPTH,25.0D0
  IREFSC=IREFSC+1
  X_SP(1)=REAL(-BB,4)
  X_SP(2)=REAL(0.0D0,4)
  X_SP(3)=REAL(0.02D0,4)
  WRITE(IU(ISC2),REC=IREFSC+ICF) (X_SP(I),I=1,3) !-BB,0.0D0,25.0D0
  IREFSC=IREFSC+1
  X_SP(1)=REAL(BB,4)
  X_SP(2)=REAL(0.0D0,4)
  X_SP(3)=REAL(0.02D0,4)
  WRITE(IU(ISC2),REC=IREFSC+ICF) (X_SP(I),I=1,3) ! BB,0.0D0,25.0D0
  IREFSC=IREFSC+1
  X=TR*WDEPTH
  X_SP(1)=REAL(X+BB,4)
  X_SP(2)=REAL(WDEPTH,4)
  X_SP(3)=REAL(0.02D0,4)
  WRITE(IU(ISC2),REC=IREFSC+ICF) (X_SP(I),I=1,3) ! X+BB,WDEPTH,25.0D0
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISC1),REC=ICRS+ICF) 4,IREFSC+1,DIST/2.0D0,CNAME 
  IREFSC=IREFSC+1
  BB=BB/2.0D0; X=TL*WDEPTH
  WRITE(IU(ISC2),REC=IREFSC+ICF) -X-BB,WDEPTH,25.0D0
  IREFSC=IREFSC+1
  WRITE(IU(ISC2),REC=IREFSC+ICF) -BB,0.0D0,25.0D0
  IREFSC=IREFSC+1
  WRITE(IU(ISC2),REC=IREFSC+ICF)  BB,0.0D0,25.0D0
  IREFSC=IREFSC+1
  X=TR*WDEPTH
  WRITE(IU(ISC2),REC=IREFSC+ICF)  X+BB,WDEPTH,25.0D0
 ENDIF
 
ELSE

 IF(ISGDOUBLE.EQ.4)THEN
  X_SP(1)=DIST/2.0D0
  WRITE(IU(ISC1),REC=ICRS+ICF) NPROF,IREFSC+1,X_SP(1),CNAME 
 ELSEIF(ISGDOUBLE.EQ.8)THEN
  WRITE(IU(ISC1),REC=ICRS+ICF) NPROF,IREFSC+1,DIST/2.0D0,CNAME 
 ENDIF
 
 IF(ISFR.EQ.1)THEN
  PROF(1,IPROF)%DISTANCE=PROF(1,IPROF)%DISTANCE/2.0D0
  PROF(2,IPROF)%DISTANCE=PROF(1,IPROF)%DISTANCE

  WDEPTH=MAX(PROF(1,IPROF)%BOTTOM-PROF(2,IPROF)%BOTTOM, &
             PROF(4,IPROF)%BOTTOM-PROF(3,IPROF)%BOTTOM)

  PROF(1,IPROF)%BOTTOM=WDEPTH
  PROF(2,IPROF)%BOTTOM=0.0D0
  PROF(3,IPROF)%BOTTOM=0.0D0
  PROF(4,IPROF)%BOTTOM=WDEPTH
  PROF(4,IPROF)%DISTANCE=PROF(4,IPROF)%DISTANCE/2.0D0
  PROF(3,IPROF)%DISTANCE=PROF(4,IPROF)%DISTANCE
 ENDIF
 
 DO I=1,NPROF
  IREFSC=IREFSC+1
  IF(ISGDOUBLE.EQ.4)THEN
   X_SP(1)=REAL(PROF(I,IPROF)%DISTANCE,4)
   X_SP(2)=REAL(PROF(I,IPROF)%BOTTOM,4)
   X_SP(3)=REAL(0.02D0,4)
   WRITE(IU(ISC2),REC=IREFSC+ICF) (X_SP(J),J=1,3) !PROF(I,IPROF)%DISTANCE,PROF(I,IPROF)%BOTTOM,0.0D02
  ELSEIF(ISGDOUBLE.EQ.8)THEN
   WRITE(IU(ISC2),REC=IREFSC+ICF) PROF(I,IPROF)%DISTANCE,PROF(I,IPROF)%BOTTOM,0.0D02
  ENDIF
 END DO

ENDIF

NCRS=1

END SUBROUTINE ISGGEN_CREATEISC1

!##=====================================================================
SUBROUTINE ISGGEN_READGEN() !ISTEP)
!##=====================================================================
IMPLICIT NONE
!INTEGER,INTENT(IN) :: ISTEP
INTEGER :: I,J,K
!CHARACTER(LEN=52) :: CID

DO I=1,SHP%NPOL; NP=NP+SHP%POL(I)%N; ENDDO
NBRCH=SHP%NPOL; ALLOCATE(PNTX(NP),PNTY(NP),IP(0:NBRCH),CBID(NBRCH)) 

IP(0)=1; K=0
DO I=1,SHP%NPOL

 CBID(I)=''
 DO J=1,MIN(52,SHP%LWIDTH(1))
  CBID(I)(J:J)=SHP%POL(I)%LBL(1)%STRING(J)
 ENDDO
 CBID(I)=ADJUSTL(CBID(I))
 
 DO J=1,SHP%POL(I)%N
  K=K+1
  PNTX(K)=SHP%POL(I)%X(J)
  PNTY(K)=SHP%POL(I)%Y(J)
 ENDDO
 IP(I)=K+1
ENDDO

WRITE(*,*) 'Number of Segments Points: ',NP
WRITE(*,*) 'Number of Branches:        ',NBRCH

END SUBROUTINE ISGGEN_READGEN

!#####=================================================================
REAL(KIND=DP_KIND) FUNCTION ISGGEN_GETIDFVAL(XC,YC,I,IU,ISTEP)
!#####=================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: I,IU
INTEGER,INTENT(INOUT) :: ISTEP
REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
INTEGER :: ICOL,IROW,IR,IC

CALL IDFIROWICOL(IDF(I),IROW,ICOL,XC,YC)

IF(ICOL.GT.0.AND.ICOL.LE.IDF(I)%NCOL.AND. &
   IROW.GT.0.AND.IROW.LE.IDF(I)%NROW)THEN

 ISGGEN_GETIDFVAL=IDFGETVAL(IDF(I),IROW,ICOL)

 !## search if no value has been found
 IF(ISGGEN_GETIDFVAL.EQ.IDF(I)%NODATA)THEN
  ISTEP=0
ISTEPLOOP: DO
   ISTEP=ISTEP+1
   IF(REAL(ISTEP)*IDF(I)%DX.GT.XSEARCH)EXIT
   DO IR=MAX(IROW-ISTEP,1),MIN(IROW+ISTEP,IDF(I)%NROW)
    DO IC=MAX(ICOL-ISTEP,1),MIN(ICOL+ISTEP,IDF(I)%NCOL)
     ISGGEN_GETIDFVAL=IDFGETVAL(IDF(I),IR,IC)
     IF(ISGGEN_GETIDFVAL.NE.IDF(I)%NODATA)EXIT ISTEPLOOP
    END DO
   ENDDO
  ENDDO ISTEPLOOP
 ENDIF

ELSE
 ISGGEN_GETIDFVAL=IDF(I)%NODATA
ENDIF

END FUNCTION ISGGEN_GETIDFVAL

END MODULE MOD_ISGGEN