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

USE MOD_UTL, ONLY : UTL_GETUNIT,ITOS,UTL_CREATEDIR,UTL_GENLABELSREAD,UTL_GENLABELSGET,NV,NL,VAR,UTL_CAP
USE MOD_OSD, ONLY : OSD_OPEN,ICF
USE MOD_ISG_UTL, ONLY : UTL_GETUNITSISG
USE MOD_IDF_PAR, ONLY : IDFOBJ
USE MOD_IDF, ONLY : IDFREAD,IDFGETVAL,IDFIROWICOL

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 :: NP,NBRCH,DIMXY,SAMPLE,NPROF,ISTART,ISTOP,IBOT,ICDY,IINF,ISUMMER_BACKUP,IWINTER_BACKUP
CHARACTER(LEN=4) :: CWINTER,CSUMMER
REAL :: CDAY,INFFCT,RBOT,XSEARCH
DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: PNTX,PNTY
DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: DUMX,DUMY
DOUBLE PRECISION,DIMENSION(2,2) :: XC,YC
INTEGER,ALLOCATABLE,DIMENSION(:) :: IP,IBID
!CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: IBCID
CHARACTER(LEN=256) :: LINE
TYPE(IDFOBJ),DIMENSION(7) :: IDF
TYPE TYPEPROF
 REAL :: DISTANCE,BOTTOM
END TYPE TYPEPROF
TYPE(TYPEPROF),DIMENSION(:),ALLOCATABLE :: PROF
LOGICAL :: LDAT

CONTAINS

!##=====================================================================
SUBROUTINE GEN2ISG_MAIN(GENFNAME,OUTFILE)
!##=====================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: GENFNAME,OUTFILE
INTEGER :: I,J
LOGICAL :: LEX
REAL :: X,Y
INTEGER,DIMENSION(7) :: ILIST
DATA ILIST/IIDFZ,IIDFW,IIDFB,IIDFC,IIDFI,IIDFZ_BU,IIDFW_BU/

FNAME(1)=GENFNAME
IU(1)=UTL_GETUNIT(); CALL OSD_OPEN(IU(1),FILE=FNAME(1),STATUS='OLD',ACTION='READ,DENYWRITE')

!## allocate memory
ALLOCATE(PNTX(0:1),PNTY(0:1))
CALL PUZZLEREAD(0)
REWIND(IU(1))
DEALLOCATE(PNTX,PNTY)
!## read entire file and initiate groups
ALLOCATE(PNTX(NP),PNTY(NP),IP(0:NP),IBID(NBRCH)) 
CALL PUZZLEREAD(1)

WRITE(*,*) 'Read number of segments=',NBRCH

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))
 REWIND(IU(ICCF))
 READ(IU(ICCF),*)
 WRITE(*,'(/1X,2A10)') 'DISTANCE','BOTTOM'
 DO I=1,NPROF
  READ(IU(ICCF),*,IOSTAT=IOS(ICCF)) PROF(I)%DISTANCE,PROF(I)%BOTTOM
  WRITE(*,'(1X,2F10.2)') PROF(I)%DISTANCE,PROF(I)%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) !3-IBOT
  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 'can not use idf with ieq ne 0'
   ELSE
    WRITE(*,'(A)') 'Can not find '//TRIM(FNAME(J)); STOP
   ENDIF
  ENDIF
 ENDDO

ELSE

 CALL UTL_GENLABELSREAD(GENFNAME(:INDEX(GENFNAME,'.',.TRUE.)-1)//'.DAT')
 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

CALL ISGCREATE(OUTFILE)

DEALLOCATE(PNTX,PNTY,IP,IBID)

END SUBROUTINE GEN2ISG_MAIN

!##=====================================================================
SUBROUTINE ISGCREATE(OUTFILE)
!##=====================================================================
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: OUTFILE
INTEGER :: ISEG,ICRS,IB,NNP,ICLC,NSEG,NCLC,NCRS,IREFSD,IREFSC,I
REAL :: DIST

FNAME(ISG) =TRIM(OUTFILE)//'.ISG'
FNAME(ISP) =TRIM(OUTFILE)//'.ISP'
FNAME(ISD1)=TRIM(OUTFILE)//'.ISD1'
FNAME(ISD2)=TRIM(OUTFILE)//'.ISD2'
FNAME(ISC1)=TRIM(OUTFILE)//'.ISC1'
FNAME(ISC2)=TRIM(OUTFILE)//'.ISC2'
FNAME(IST1)=TRIM(OUTFILE)//'.IST1'
FNAME(IST2)=TRIM(OUTFILE)//'.IST2'
FNAME(ISQ1)=TRIM(OUTFILE)//'.ISQ1'
FNAME(ISQ2)=TRIM(OUTFILE)//'.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

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

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

 CALL ISPCREATE(IB,ISEG,NNP,NSEG,DIST)
 CALL ISD1CREATE(ICLC,NCLC,IREFSD,DIST,IB)
 CALL ISC1CREATE(ICRS,NCRS,IREFSC,DIST,IB)

 LINE='"SEGMENT'//TRIM(ITOS(IBID(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(0))//','//TRIM(ITOS(0))

 WRITE(IU(ISG),*) TRIM(LINE)

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

WRITE(*,*) '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))//' ',0,0

WRITE(IU(ISP) ,REC=1)  8*256+247
WRITE(IU(ISD1),REC=1) 44*256+247 !42*256+247
WRITE(IU(ISD2),REC=1) 20*256+247
WRITE(IU(ISC1),REC=1) 44*256+247 !42*256+247
WRITE(IU(ISC2),REC=1) 12*256+247
WRITE(IU(IST1),REC=1) 44*256+247 !42*256+247
WRITE(IU(IST2),REC=1) 12*256+247
WRITE(IU(ISQ1),REC=1) 44*256+247 !42*256+247
WRITE(IU(ISQ2),REC=1) 16*256+247
 
END SUBROUTINE

!##=====================================================================
SUBROUTINE ISPCREATE(IB,ISEG,NNP,NSEG,DIST)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IB
INTEGER,INTENT(INOUT) :: ISEG,NNP
INTEGER,INTENT(OUT) :: NSEG
REAL,INTENT(OUT) :: DIST
INTEGER :: I,J

J   =0
DIST=0.0
DO I=IP(IB-1),IP(IB)-1
 IF(I.GT.IP(IB-1))THEN
  IF(PNTX(I).NE.PNTX(I-1).OR.PNTY(I).NE.PNTY(I-1))THEN
   DIST=DIST+SQRT((PNTX(I)-PNTX(I-1))**2.0+(PNTY(I)-PNTY(I-1))**2.0)
   ISEG=ISEG+1
   J   =J+1
   WRITE(IU(ISP),REC=ISEG+ICF) REAL(PNTX(I)),REAL(PNTY(I))
  ENDIF
 ELSE
  ISEG=ISEG+1
  J   =J+1
  WRITE(IU(ISP),REC=ISEG+ICF) REAL(PNTX(I)),REAL(PNTY(I))
 ENDIF
END DO

NSEG=J
NNP =NNP+J

END SUBROUTINE

!##=====================================================================
SUBROUTINE ISD1CREATE(ICLC,NCLC,IREFSD,DIST,IB)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(INOUT) :: ICLC,IREFSD
INTEGER,INTENT(OUT) :: NCLC
REAL,INTENT(IN) :: DIST
INTEGER,INTENT(IN) :: IB
REAL :: WL,WB,RS,FC,XDIST,XSAMPLE,FCT,D,DSAMPLE
INTEGER :: ID,I,ISAMPLE,IC,N,IY,ISTEP,IL,IOS
CHARACTER(LEN=8) :: CDATE
DOUBLE PRECISION :: XC,YC
CHARACTER(LEN=32) :: CNAME

NCLC=0; FC=INFFCT; RS=CDAY

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

 CALL UTL_GENLABELSGET(IBID(IB),IL)
 IF(IL.EQ.0)THEN
  RETURN
 ENDIF

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

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

 !## from
 WRITE(CNAME,'(A8,I4.4)') 'ClcFROM:',IB
 WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,0.0,CNAME
 WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,WL,WB,RS,FC 

 READ(VAR(DATCOL(2),IL),*,IOSTAT=IOS) WL
 READ(VAR(DATCOL(4),IL),*,IOSTAT=IOS) WB

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

 !## to
 WRITE(CNAME,'(A8,I4.4)') 'ClcTO:',IB
 WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD,DIST,CNAME
 WRITE(IU(ISD2),REC=IREFSD+ICF) 19000101,WL,WB,RS,FC 

 RETURN
ENDIF

ICLC=ICLC+1; NCLC=NCLC+1

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

CNAME=''; WRITE(CNAME,'(A8,I8.8)') 'ClcFROM:',IB
WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,0.0,CNAME

DO IY=ISTART,ISTOP
 DO IC=2,3
  IF(MOD(IC,2).EQ.0)THEN
   WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
   WL=GEN2ISG_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),1,IU(IIDFZ),ISTEP) 
!   WL=GEN2ISG_GETIDFVAL(PNTX(IP(IB-1)+1),PNTY(IP(IB-1)+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=GEN2ISG_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=GEN2ISG_GETIDFVAL(PNTX(IP(IB-1)),PNTY(IP(IB-1)),2,IU(IIDFW),ISTEP)
!   WL=GEN2ISG_GETIDFVAL(PNTX(IP(IB-1)+1),PNTY(IP(IB-1)+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=GEN2ISG_GETIDFVAL(PNTX(IP(IB-1)+1),PNTY(IP(IB-1)+1),7,IU(IIDFW_BU),ISTEP); ENDIF
  ENDIF

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

  READ(CDATE,*) ID
  IREFSD=IREFSD+1
  WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
 ENDDO
END DO

DSAMPLE=DIST/SAMPLE
ISAMPLE=INT(DSAMPLE)

IF(ISAMPLE.GE.1)THEN

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

 XDIST  =0.0
 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.0+(PNTY(I)-PNTY(I-1))**2.0)

   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
     WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,XSAMPLE,CNAME

     DO IY=ISTART,ISTOP
      DO IC=2,3
       IF(MOD(IC,2).EQ.0)THEN
        WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
        WL=GEN2ISG_GETIDFVAL(XC,YC,1,IU(IIDFZ),ISTEP)
       ELSE
        WRITE(CDATE,'(I4.4,A4)') IY,CWINTER
        WL=GEN2ISG_GETIDFVAL(XC,YC,2,IU(IIDFW),ISTEP)
       ENDIF

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

       READ(CDATE,*) ID
       IREFSD=IREFSD+1
       WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
      END DO
     END DO

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

    ENDDO
   ENDIF

   XDIST=XDIST+D

  ENDIF
 ENDDO
ENDIF

!## to
ICLC  =ICLC+1
NCLC  =NCLC+1
WRITE(CNAME,'(A8,I8.8)') 'ClcTO:  ',IB
WRITE(IU(ISD1),REC=ICLC+ICF) N,IREFSD+1,DIST,CNAME

DO IY=ISTART,ISTOP
 DO IC=2,3
  IF(MOD(IC,2).EQ.0)THEN
   WRITE(CDATE,'(I4.4,A4)') IY,CSUMMER
   WL=GEN2ISG_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=GEN2ISG_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),6,IU(IIDFZ_BU),ISTEP); ENDIF
  ELSE
   WRITE(CDATE,'(I4.4,A4)') IY,CWINTER
   WL=GEN2ISG_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=GEN2ISG_GETIDFVAL(PNTX(IP(IB)-1),PNTY(IP(IB)-1),7,IU(IIDFW_BU),ISTEP); ENDIF
  ENDIF

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

  READ(CDATE,*) ID
  IREFSD=IREFSD+1
  WRITE(IU(ISD2),REC=IREFSD+ICF) ID,WL,WB,RS,FC
 ENDDO
END DO

END SUBROUTINE

!##=====================================================================
SUBROUTINE ISC1CREATE(ICRS,NCRS,IREFSC,DIST,IB)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(INOUT) :: ICRS,IREFSC
INTEGER,INTENT(IN) :: IB
INTEGER,INTENT(OUT) :: NCRS
REAL,INTENT(IN) :: DIST
INTEGER :: I,IOS,IL
REAL :: WDEPTH,TL,TR,BB,X
CHARACTER(LEN=32) :: CNAME

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

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

 WDEPTH=10.0
 CALL UTL_GENLABELSGET(IBID(IB),IL); 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.0.OR.TR.LE.0.0.OR.BB.LE.0.0)THEN
  WRITE(*,*) ' ERROR' 
  PAUSE
 ENDIF
 TL=MAX(0.0,TL); TR=MAX(0.0,TR); BB=MAX(0.0,BB)
 
 WRITE(IU(ISC1),REC=ICRS+ICF) 4,IREFSC+1,DIST/2.0,CNAME 
 IREFSC=IREFSC+1
 BB=BB/2.0; X=TL*WDEPTH
 WRITE(IU(ISC2),REC=IREFSC+ICF) -X-BB,WDEPTH,25.0
 IREFSC=IREFSC+1
 WRITE(IU(ISC2),REC=IREFSC+ICF) -BB,0.0,25.0
 IREFSC=IREFSC+1
 WRITE(IU(ISC2),REC=IREFSC+ICF)  BB,0.0,25.0
 IREFSC=IREFSC+1
 X=TR*WDEPTH
 WRITE(IU(ISC2),REC=IREFSC+ICF)  X+BB,WDEPTH,25.0

ELSE

 WRITE(IU(ISC1),REC=ICRS+ICF) NPROF,IREFSC+1,DIST/2.0,CNAME 
 DO I=1,NPROF
  IREFSC=IREFSC+1
  WRITE(IU(ISC2),REC=IREFSC+ICF) PROF(I)%DISTANCE,PROF(I)%BOTTOM,25.0
 END DO

ENDIF

NCRS=1

END SUBROUTINE

!##=====================================================================
SUBROUTINE PUZZLEREAD(ISTEP)
!##=====================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: ISTEP
INTEGER :: IOS,I,ID,NNP
CHARACTER(LEN=52) :: CID

I =0; NP=0; NBRCH=0
IF(ISTEP.EQ.1)IP(NBRCH)=1

DO
 READ(IU(1),*,IOSTAT=IOS) CID; IF(IOS.NE.0)EXIT
 IF(TRIM(UTL_CAP(CID,'U')).EQ.'END')EXIT
 !## increase groups, store branche id
 NBRCH=NBRCH+1
 READ(CID,*,IOSTAT=IOS) ID; IF(IOS.NE.0)ID=NBRCH
 IF(ISTEP.EQ.1)IBID(NBRCH)=ID
 NNP=0
 DO
  READ(IU(1),*,IOSTAT=IOS) XC(1,1),YC(1,1)
  IF(IOS.NE.0)EXIT
  NNP=NNP+1
  NP =NP+1
  I  =I+ISTEP
  PNTX(I)=XC(1,1); PNTY(I)=YC(1,1)
 ENDDO
 IF(NNP.LE.1)THEN
  WRITE(*,*) 'ERROR: number of points in segment is le 1'
  WRITE(*,*) NNP,' '//TRIM(CID)
  STOP
 ENDIF
 IF(ISTEP.EQ.1)IP(NBRCH)=I+1
ENDDO

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

IF(ISTEP.EQ.1)CLOSE(IU(1))

END SUBROUTINE

!#####=================================================================
REAL FUNCTION GEN2ISG_GETIDFVAL(XC,YC,I,IU,ISTEP)
!#####=================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: I,IU
INTEGER,INTENT(INOUT) :: ISTEP
DOUBLE PRECISION,INTENT(IN) :: XC,YC
INTEGER :: ICOL,IROW,IREC,IR,IC

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

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

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

 !## search if no value has been found
 IF(GEN2ISG_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)
     GEN2ISG_GETIDFVAL=IDFGETVAL(IDF(I),IR,IC)
     IF(GEN2ISG_GETIDFVAL.NE.IDF(I)%NODATA)EXIT ISTEPLOOP
    END DO
   ENDDO
  ENDDO ISTEPLOOP
 ENDIF

ELSE
 GEN2ISG_GETIDFVAL=IDF(I)%NODATA
ENDIF

END FUNCTION GEN2ISG_GETIDFVAL

END MODULE MOD_GEN2ISG