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

USE MOD_GEF2IPF_PAR

CONTAINS

 !###======================================================================
 SUBROUTINE GEF2IPF_MAIN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,ICOL,IROW,KU,IDIR,JCOL
 CHARACTER(LEN=256) :: LINE,IPFDIR
 CHARACTER(LEN=52) :: WC
 
 I=INDEX(IPFFNAME,'.',.TRUE.)-1; IPFDIR=IPFFNAME(:I); CALL IOSDIRMAKE(TRIM(IPFDIR))

 I=INDEX(IPFFNAME,'\',.TRUE.)+1
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(IPFDIR)//'\'//IPFFNAME(I:),STATUS='UNKNOWN',ACTION='WRITE',FORM='FORMATTED')

 PREFVAL(1)='.'
 WC=GEFDIR(INDEX(GEFDIR,'\',.TRUE.)+1:)
 CALL IOSDIRMAKE(TRIM(PREFVAL(1))//'\TMP'); CALL IOSDIRENTRYTYPE('F'); CALL IOSDIRCOUNT(GEFDIR(:INDEX(GEFDIR,'\',.TRUE.)-1),WC,N)

 IF(N.EQ.0)STOP 'No gef files found!'

 WRITE(JU,*) N
 WRITE(JU,*) 10
 WRITE(JU,*) 'X'
 WRITE(JU,*) 'Y'
 WRITE(JU,*) 'ID'
 WRITE(JU,*) 'Z_END'
 WRITE(JU,*) 'I_ERROR'
 WRITE(JU,*) 'SONDEERLENGTE'
 WRITE(JU,*) 'CONUSWEERSTAND'
 WRITE(JU,*) 'KLEEF'
 WRITE(JU,*) 'WRIJVINGSGETAL'
 WRITE(JU,*) 'WATERSPANNING'
 WRITE(JU,*) '3,TXT'

 ALLOCATE(GEFNAMES(N))

 CALL UTL_DIRINFO(GEFDIR(:INDEX(GEFDIR,'\',.TRUE.)-1),WC,GEFNAMES,N,'F')

 IDIR=1
 DO I=1,N
  CALL GEFDEALLOCATE()
  GEFNAMES(I)=GEFDIR(:INDEX(GEFDIR,'\',.TRUE.))//GEFNAMES(I)//'.gef'
  IF(LREADGEF(I))THEN

   IATTRIB=0
   DO ICOL=1,NCOL

    IF(INDEX(UTL_CAP(TRIM(ATTRIB2(ICOL)),'U'),'GECORRIGEERDEDIEPTE').GT.0)IATTRIB(1)=ICOL  !<--- preferable
    !## try others
    IF(IATTRIB(1).EQ.0)THEN
     SELECT CASE (UTL_CAP(TRIM(ATTRIB2(ICOL)),'U'))
      CASE ('PENETRATIONLENGTH','SONDEERLENGTE','DIEPTE:','DIEPTE','LENGTE','DEPTH','LENGTH')
       IATTRIB(1)=ICOL
     END SELECT
    ENDIF

    IF(INDEX(UTL_CAP(TRIM(ATTRIB1(ICOL)),'U'),'MPA').GT.0.OR. &
       INDEX(UTL_CAP(TRIM(ATTRIB1(ICOL)),'U'),'KPA').GT.0)THEN
   
     JCOL=0
     SELECT CASE (UTL_CAP(TRIM(ATTRIB2(ICOL)),'U'))
      CASE ('QC','CONUS','CONUSWEERSTAND','CONERESISTANCE','PUNT','PUNTWEERSTAND','PUNTDRUK', &
            'CONUSWEERSTANDQC','TIP','CONUSWAARDE')
       JCOL=2
      CASE ('FS','KLEEF','WRIJVINGSWEERSTAND','WRIJVING','LOKALEWRIJVING','WRIJVINGSWEERSTANDFS')
       JCOL=3
      CASE ('WATERSPANNINGU1','WATERSPANNING','POREPRESSURE','WATERPRESSURE','WATERDRUK','PORIEDRUK', &
            'PORIESPANNING','PIEZOSPANNING','PIEZODRUK','PIEZOPRESSURE','PIEZO','U1','U2')
       JCOL=5
     END SELECT

     IF(JCOL.GT.0)THEN
      IATTRIB(JCOL)=ICOL
          
      FMULT(JCOL)=1.0
      IF(INDEX(UTL_CAP(TRIM(ATTRIB1(ICOL)),'U'),'KPA').GT.0)FMULT(JCOL)=0.001
     ENDIF
     
    ENDIF

    IF(INDEX(UTL_CAP(TRIM(ATTRIB1(ICOL)),'U'),'%').GT.0)THEN
     SELECT CASE (UTL_CAP(TRIM(ATTRIB2(ICOL)),'U'))
      CASE ('WRIJVINGSGETAL','WRIJVINGSGETALRF','RF','WRIJVINGGETAL','LOCALFRICTION', &
            'FRICTIONRATIO','FRICTIONNUMBER')
       IATTRIB(4)=ICOL; FMULT(4)=1.0
     END SELECT
    ENDIF
    
   END DO

   !## write only whenever length is available
   IF(IATTRIB(1).EQ.0)THEN !.OR.(IATTRIB(2).EQ.0.AND.IATTRIB(3).EQ.0))THEN

    DO ICOL=1,NCOL
     WRITE(*,*) ICOL,TRIM(ATTRIB1(ICOL))//','//TRIM(ATTRIB2(ICOL))
    ENDDO

    LINE='"'//TRIM(RTOS(X,'F',2))//'","'//TRIM(RTOS(Y,'F',2))//'","'// &
         TRIM(CID)//'","'//TRIM(RTOS(0.0,'F',2))//'","'//TRIM(ITOS(1))//'"'
    DO ICOL=1,NCOLIPF 
     IF(IATTRIB(ICOL).EQ.0)THEN
      LINE=TRIM(LINE)//',"NotAvailable"'
     ELSE
      LINE=TRIM(LINE)//',"'//TRIM(ATTRIB1(IATTRIB(ICOL)))//'-'//TRIM(ATTRIB2(IATTRIB(ICOL)))//'"'
     ENDIF
    ENDDO
    WRITE(JU,'(A)') TRIM(LINE)

   ELSE

    IF(MOD(I,1000).EQ.0)IDIR=IDIR+1

    CALL IOSDIRMAKE(TRIM(IPFDIR)//'\subset'//TRIM(ITOS(IDIR)))

    ZEND=Z-ABS(GEF(IATTRIB(1),NROW))

    LINE='"'//TRIM(RTOS(X,'F',2))//'","'//TRIM(RTOS(Y,'F',2))//'","subset'//TRIM(ITOS(IDIR))// &
         '\'//TRIM(CID)//'","'//TRIM(RTOS(ZEND,'F',2))//'","'//TRIM(ITOS(0))//'"'
    DO ICOL=1,NCOLIPF 
     IF(IATTRIB(ICOL).EQ.0)THEN
      LINE=TRIM(LINE)//',"NotAvailable"'
     ELSE
      LINE=TRIM(LINE)//',"'//TRIM(ATTRIB1(IATTRIB(ICOL)))//'-'//TRIM(ATTRIB2(IATTRIB(ICOL)))//'"'
     ENDIF
    ENDDO
    WRITE(JU,'(A)') TRIM(LINE)

    !## write associated file
    KU=UTL_GETUNIT()
    OPEN(KU,FILE=TRIM(IPFDIR)//'\subset'//TRIM(ITOS(IDIR))//'\'//TRIM(CID)//'.TXT',STATUS='UNKNOWN',FORM='FORMATTED',ACTION='WRITE')
    LINE=TRIM(ITOS(NROW))
    WRITE(KU,'(A)') TRIM(LINE)
    LINE=TRIM(ITOS(NCOLIPF))//',3'
    WRITE(KU,'(A)') TRIM(LINE)

    DO ICOL=1,NCOLIPF 
!     IF(IATTRIB(ICOL).EQ.0)THEN
     IF(ICOL.EQ.1)LINE='"m,NAP",' !Sondeerlengte",'
     IF(ICOL.EQ.2)LINE='"MPa,Conusweerstand",'
     IF(ICOL.EQ.3)LINE='"MPa,Kleef",'
     IF(ICOL.EQ.4)LINE='"%,Wrijvingsgetal",'
     IF(ICOL.EQ.5)LINE='"MPa,Waterspanning",'
     IF(IATTRIB(ICOL).GT.0)THEN
      LINE=TRIM(LINE)//TRIM(RTOS(NODATA(IATTRIB(ICOL)),'*',7))
     ELSE
      LINE=TRIM(LINE)//'-99999'
     ENDIF
!     ELSE
!      LINE='"'//TRIM(ATTRIB1(IATTRIB(ICOL)))//','//TRIM(ATTRIB2(IATTRIB(ICOL)))//'",'//TRIM(RTOS(NODATA(IATTRIB(ICOL)),'F',3))
!     ENDIF
     WRITE(KU,*) TRIM(LINE)
    END DO

    DO IROW=1,NROW
     LINE=TRIM(RTOS(Z-ABS(GEF(IATTRIB(1),IROW)),'F',3))
     DO ICOL=2,NCOLIPF !3
      IF(IATTRIB(ICOL).NE.0)THEN
       IF(GEF(IATTRIB(ICOL),IROW).NE.NODATA(IATTRIB(ICOL)))THEN
        LINE=TRIM(LINE)//','//TRIM(RTOS(ABS(GEF(IATTRIB(ICOL),IROW))*FMULT(ICOL),'*',7))
       ELSE
        LINE=TRIM(LINE)//','//TRIM(RTOS(GEF(IATTRIB(ICOL),IROW)*FMULT(ICOL),'*',7))
       ENDIF
      ELSE
       LINE=TRIM(LINE)//',-99999.0'
      ENDIF
     END DO
     WRITE(KU,*) TRIM(LINE)
    END DO
    CLOSE(KU)

   ENDIF

   WRITE(6,'(A,F10.2,A)') '+Progress ',REAL(I)/REAL(N)*100.0,'%              '  !FR 20131007

  ELSE

   LINE='"'//TRIM(RTOS(X,'F',2))//'","'//TRIM(RTOS(Y,'F',2))//'","'// &
         TRIM(CID)//'","'//TRIM(RTOS(0.0,'F',2))//'","'//TRIM(ITOS(1))//'"'
   DO ICOL=1,NCOLIPF; LINE=TRIM(LINE)//',"NotAvailable"'; ENDDO
   WRITE(JU,'(A)') TRIM(LINE)

  ENDIF
 END DO

 CLOSE(JU)

 DEALLOCATE(GEFNAMES)

 END SUBROUTINE GEF2IPF_MAIN

END MODULE MOD_GEF2IPF