!!  Copyright (C) Stichting Deltares, 2005-2023.
!!
!!  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 WINTERACTER
USE RESOURCE
USE MOD_GEF2IPF_PAR
USE MOD_UTL, ONLY : UTL_CREATEDIR,UTL_MESSAGEHANDLE,UTL_DIALOGSHOW

CONTAINS

 !###======================================================================
 SUBROUTINE GEF2IPF_MAIN(IBATCH,GEFTYPE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH,GEFTYPE
 INTEGER :: ITYPE,IGEFTYPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 
 IGEFTYPE=GEFTYPE
 
 IF(GEFTYPE.EQ.0)THEN
  CALL WDIALOGLOAD(ID_DGEF)
  CALL WDIALOGPUTRADIOBUTTON(IDF_RADIO1)
  CALL UTL_DIALOGSHOW(-1,-1,0,2)
 
  DO
   CALL WMESSAGE(ITYPE,MESSAGE)
   SELECT CASE(ITYPE) 
    CASE (PUSHBUTTON)
     SELECT CASE (MESSAGE%VALUE1)
      CASE (IDCANCEL)
       EXIT
      CASE (IDOK)
       CALL WDIALOGGETRADIOBUTTON(IDF_RADIO1,IGEFTYPE)
       EXIT
      CASE (IDHELP)
     END SELECT
   END SELECT
  ENDDO
 
  CALL WDIALOGUNLOAD() 
 
 ENDIF 
 
 IF(IGEFTYPE.EQ.1)CALL GEF2IPF_GEFCPT(IBATCH)
 IF(IGEFTYPE.EQ.2)CALL GEF2IPF_GEFBORE(IBATCH)
! IF(IGEFTYPE.EQ.3)CALL GEF2IPF_GEFBORE(IBATCH) !## general - strict conversion
 
 END SUBROUTINE GEF2IPF_MAIN
 
 !###======================================================================
 SUBROUTINE GEF2IPF_GEFCPT(IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,N,ICOL,IROW,IU,KU,JU,IDIR,JCOL,IOS
 CHARACTER(LEN=256) :: LINE,IPFDIR,ESTRING
 REAL(KIND=DP_KIND) :: Z1,Z2
 
 IF(IBATCH.EQ.1)WRITE(*,*) 'Reading GEF-file with probing information'
 
 IF(.NOT.ASSOCIATED(GEFNAMES))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot find any files!','Error'); RETURN
 ELSE
  IF(SIZE(GEFNAMES).EQ.0)THEN
   CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot find any files!','Error'); RETURN
  ENDIF
 ENDIF 
 
 IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(0)
 
 I=INDEX(IPFFNAME,'\',.TRUE.)-1; IPFDIR=IPFFNAME(:I); CALL UTL_CREATEDIR(IPFDIR)
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(IPFDIR)//IPFFNAME(I+1:),STATUS='REPLACE',ACTION='WRITE',FORM='FORMATTED')
 
 WRITE(JU,*) SIZE(GEFNAMES)
 WRITE(JU,*) 5
 WRITE(JU,*) 'X'
 WRITE(JU,*) 'Y'
 WRITE(JU,*) 'ID'
 WRITE(JU,*) 'Z_END'
 WRITE(JU,*) 'I_ERROR'
 WRITE(JU,*) '3,TXT'
 
 IDIR=1
 DO I=1,SIZE(GEFNAMES)
  CALL GEFDEALLOCATE()
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Processing '//TRIM(GEFNAMES(I))//' ...')
  IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Processing '//TRIM(GEFNAMES(I))//' ...'

  !## READ AND CHECK SINGLE GEF CONTENT
  IU=UTL_GETUNIT(); OPEN(IU,FILE=GEFDIR(:INDEX(GEFDIR,'\',.TRUE.))//GEFNAMES(I)//'.GEF',STATUS='OLD',ACTION='READ',IOSTAT=IOS)
  IF(IOS.NE.0)IU=0
  IF(LREADGEF(IU,I,ESTRING))THEN
 
   !## maximal soil type speficied
   N=5; ALLOCATE(IATTRIB(N)); IATTRIB=0      

   !## search correct column
   DO ICOL=1,GEF%NCOL
 
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'GECORRIGEERDEDIEPTE').GT.0)IATTRIB(1)=ICOL  !<--- preferable
    !## try others:
    !## - only 1st column
    IF(IATTRIB(1).EQ.0)THEN
     SELECT CASE (UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'))
      CASE ('PENETRATIONLENGTH','SONDEERLENGTE','DIEPTE:','DIEPTE','LENGTE','DEPTH','LENGTH','SONDEERTRAJECTLENGTE')
       IATTRIB(1)=ICOL
     END SELECT
    ENDIF
 
    !## - only column with MPA/KPA
    IF(INDEX(UTL_CAP(TRIM(GEF%UNIT(ICOL)),'U'),'MPA').GT.0.OR. &
       INDEX(UTL_CAP(TRIM(GEF%UNIT(ICOL)),'U'),'KPA').GT.0)THEN
   
     JCOL=0
     SELECT CASE (UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'))
      CASE ('QC','CONUS','CONUSWEERSTAND','CONERESISTANCE','PUNT','PUNTWEERSTAND','PUNTDRUK', &
            'CONUSWEERSTANDQC','TIP','CONUSWAARDE')
       JCOL=2
      CASE ('FS','KLEEF','WRIJVINGSWEERSTAND','WRIJVING','LOKALEWRIJVING','WRIJVINGSWEERSTANDFS','PLAATSELIJKEWRIJVING')
       JCOL=3
      CASE ('WATERSPANNINGU1','WATERSPANNING','POREPRESSURE','WATERPRESSURE','WATERDRUK','PORIEDRUK', &
            'PORIESPANNING','PIEZOSPANNING','PIEZODRUK','PIEZOPRESSURE','PIEZO','U1','U2','WATERSPANNINGU2')
       JCOL=5
     END SELECT
 
     IF(JCOL.GT.0)THEN
      IATTRIB(JCOL)=ICOL
      GEF%FMULT(JCOL)=1.0D0
      IF(INDEX(UTL_CAP(TRIM(GEF%UNIT(ICOL)),'U'),'KPA').GT.0)GEF%FMULT(JCOL)=0.01D0
     ENDIF
     
    ENDIF
 
    !## - only column with %
    IF(INDEX(UTL_CAP(TRIM(GEF%UNIT(ICOL)),'U'),'%').GT.0)THEN
     SELECT CASE (UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'))
      CASE ('WRIJVINGSGETAL','WRIJVINGSGETALRF','RF','WRIJVINGGETAL','LOCALFRICTION', &
            'FRICTIONRATIO','FRICTIONNUMBER')
       IATTRIB(4)=ICOL; GEF%FMULT(4)=1.0D0
     END SELECT
    ENDIF
    
   END DO !## loop over all columns
 
   IF(MOD(I,1000).EQ.0)IDIR=IDIR+1
   CALL UTL_CREATEDIR(TRIM(IPFDIR)//'\subset'//TRIM(VTOS(IDIR)))
 
   !## write associated file
   KU=UTL_GETUNIT()
   LINE=TRIM(IPFDIR)//'\SUBSET'//TRIM(VTOS(IDIR))//'\'//TRIM(GEF%CID)//'.TXT'
   OPEN(KU,FILE=TRIM(LINE),STATUS='REPLACE',FORM='FORMATTED',ACTION='WRITE')
   LINE=TRIM(VTOS(GEF%NROW))
   WRITE(KU,'(A)') TRIM(LINE)
   LINE=TRIM(VTOS(SIZE(IATTRIB)))//',3'
   WRITE(KU,'(A)') TRIM(LINE)

   DO ICOL=1,SIZE(IATTRIB)
    IF(ICOL.EQ.1)LINE=char(39)//'m,NAP'//char(39)
    IF(ICOL.EQ.2)LINE=char(39)//'MPa,Conusweerstand'//char(39)
    IF(ICOL.EQ.3)LINE=char(39)//'MPa,Kleef'//char(39)
    IF(ICOL.EQ.4)LINE=char(39)//'%,Wrijvingsgetal'//char(39)
    IF(ICOL.EQ.5)LINE=char(39)//'MPa,Waterspanning'//char(39)
    IF(IATTRIB(ICOL).GT.0)THEN
     LINE=TRIM(LINE)//','//TRIM(VTOS(GEF%NODATA(IATTRIB(ICOL)),'*',7))
    ELSE
     LINE=TRIM(LINE)//',-99999'
    ENDIF
    WRITE(KU,'(A)') TRIM(LINE)
   END DO
   DO IROW=1,GEF%NROW
    READ(GEF%VALUES(IATTRIB(1),IROW),*) Z1
    LINE=TRIM(VTOS(GEF%Z-Z1,'F',3))
    DO ICOL=2,SIZE(IATTRIB)
     IF(IATTRIB(ICOL).NE.0)THEN
      READ(GEF%VALUES(IATTRIB(ICOL),IROW),*) Z2
      IF(Z2.NE.GEF%NODATA(IATTRIB(ICOL)))THEN
       LINE=TRIM(LINE)//','//TRIM(VTOS(ABS(Z2)*GEF%FMULT(ICOL),'*',7))
      ELSE
       LINE=TRIM(LINE)//','//TRIM(VTOS(Z2*GEF%FMULT(ICOL),'*',7))
      ENDIF
     ELSE
      LINE=TRIM(LINE)//',-99999.0'
     ENDIF
    END DO
    WRITE(KU,'(A)') TRIM(LINE)
   END DO
   
   CLOSE(KU)

   READ(GEF%VALUES(IATTRIB(2),GEF%NROW),*) Z2; GEF%ZEND=-99999.0D0; IF(IATTRIB(2).NE.0)GEF%ZEND=GEF%Z-Z2
   LINE=TRIM(VTOS(GEF%X,'F',2))//','//TRIM(VTOS(GEF%Y,'F',2))//','//'SUBSET'//TRIM(VTOS(IDIR))//'\'//TRIM(GEF%CID)//','// &
        TRIM(VTOS(GEF%ZEND,'F',2)) //','//TRIM(VTOS(0))

  ELSE

    WRITE(*,'(1X,A)') 'Error reading '//TRIM(GEFNAMES(I))
    LINE='-99999.0,-99999.0,'//TRIM(GEFNAMES(I))//',-99999.0,1'

  ENDIF
  WRITE(JU,'(A)') TRIM(LINE)

  !## close gef-file
  CLOSE(IU)

  IF(IBATCH.EQ.1)WRITE(6,'(A,F10.2,A)') '+Progress ',REAL(I)/REAL(SIZE(GEFNAMES))*100.0D0,'%              '  
 !
 END DO
 
 CLOSE(JU)
 IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(1)

 END SUBROUTINE GEF2IPF_GEFCPT

 !###======================================================================
 SUBROUTINE GEF2IPF_GEFBORE(IBATCH)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,J,N,ICOL,IROW,IU,JU,KU,IDIR,IOS
 CHARACTER(LEN=256) :: IPFDIR,ESTRING
 CHARACTER(LEN=512) :: LINE
 REAL(KIND=DP_KIND) :: Z1,Z2
 
 IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Reading GEF-file with borehole information'
 
 IF(.NOT.ASSOCIATED(GEFNAMES))THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Cannot find any files!','Error'); RETURN
 ENDIF

 IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(0)

 I=INDEX(IPFFNAME,'\',.TRUE.)-1; IPFDIR=IPFFNAME(:I); CALL UTL_CREATEDIR(IPFDIR)
 JU=UTL_GETUNIT(); OPEN(JU,FILE=TRIM(IPFDIR)//IPFFNAME(I+1:),STATUS='REPLACE',ACTION='WRITE',FORM='FORMATTED')
 WRITE(JU,*) SIZE(GEFNAMES)
 WRITE(JU,*) 5 
 WRITE(JU,*) 'X'
 WRITE(JU,*) 'Y'
 WRITE(JU,*) 'ID'
 WRITE(JU,*) 'Z_END'
 WRITE(JU,*) 'I_ERROR'
WRITE(JU,*) '3,TXT'

 IDIR=1
 DO I=1,SIZE(GEFNAMES)

  CALL GEFDEALLOCATE()
  IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Processing '//TRIM(GEFNAMES(I))//' ...')
  IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Processing '//TRIM(GEFNAMES(I))//' ...'

  IU=UTL_GETUNIT()
  OPEN(IU,FILE=GEFDIR(:INDEX(GEFDIR,'\',.TRUE.))//GEFNAMES(I)//'.GEF',STATUS='OLD',ACTION='READ',IOSTAT=IOS)
  IF(IOS.NE.0)IU=0
  
  !## read gef files
  IF(LREADGEF(IU,I,ESTRING))THEN
   !## maximal soil type speficied
   N=MAXVAL(NCOLLINE)-GEF%NCOL
   N=10+N; ALLOCATE(IATTRIB(N)); IATTRIB=0      
   !## search for appropriate columns
   DO ICOL=1,GEF%NCOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'DIEPTEBOVENKANTLAAG').GT.0)IATTRIB(1) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'DIEPTEONDERKANTLAAG').GT.0)IATTRIB(2) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'ZANDMEDIAAN')        .GT.0)IATTRIB(3) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'GRINDMEDIAAN')       .GT.0)IATTRIB(4) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'LUTUMPERCENTAGE')    .GT.0)IATTRIB(5) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'SILTPERCENTAGE')     .GT.0)IATTRIB(6) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'ZANDPERCENTAGE')     .GT.0)IATTRIB(7) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'GRINDPERCENTAGE')    .GT.0)IATTRIB(8) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'ORGANISCHESTOFPERCENTAGE').GT.0)IATTRIB(9) =ICOL
    IF(INDEX(UTL_CAP(TRIM(GEF%NAME(ICOL)),'U'),'LITHOLOGY')          .GT.0)IATTRIB(10)=ICOL
   END DO
   J=10
   DO ICOL=GEF%NCOL+1,MAXVAL(NCOLLINE); J=J+1; IF(TRIM(GEF%NAME(ICOL)).NE.'')IATTRIB(J)=ICOL; ENDDO

   IF(MOD(I,1000).EQ.0)IDIR=IDIR+1; CALL UTL_CREATEDIR(TRIM(IPFDIR)//'\SUBSET'//TRIM(VTOS(IDIR)))

   !## write associated file
   LINE=TRIM(IPFDIR)//'\SUBSET'//TRIM(VTOS(IDIR))//'\'//TRIM(GEF%CID)//'.TXT'
   KU=UTL_GETUNIT(); OPEN(KU,FILE=TRIM(LINE),STATUS='REPLACE',FORM='FORMATTED',ACTION='WRITE')
   LINE=TRIM(VTOS(GEF%NROW+1));          WRITE(KU,'(A)') TRIM(LINE)
   LINE=TRIM(VTOS(SIZE(IATTRIB)))//',2'; WRITE(KU,'(A)') TRIM(LINE)

   DO ICOL=1,SIZE(IATTRIB)
    IF(ICOL.EQ.1) LINE=char(39)//'m,NAP'//char(39)//','
    IF(ICOL.EQ.2) LINE=char(39)//'m,NAP'//char(39)//','
    IF(ICOL.EQ.3) LINE=char(39)//'mm,Zandmediaan'//char(39)//','
    IF(ICOL.EQ.4) LINE=char(39)//'mm,Grindmediaan'//char(39)//','
    IF(ICOL.EQ.5) LINE=char(39)//'%,Lutum percentage'//char(39)//','
    IF(ICOL.EQ.6) LINE=char(39)//'%,Silt percentage'//char(39)//','
    IF(ICOL.EQ.7) LINE=char(39)//'%,Zand percentage'//char(39)//','
    IF(ICOL.EQ.8) LINE=char(39)//'%,Grind percentage'//char(39)//','
    IF(ICOL.EQ.9) LINE=char(39)//'%,Organisch stof percentage'//char(39)//','
    IF(ICOL.EQ.10)LINE=char(39)//'-,Lithology'//char(39)//','
    IF(ICOL.GT.10)THEN
     LINE=char(39)//'-,SoilType'//TRIM(VTOS(ICOL-GEF%NCOL))//char(39)//','
    ENDIF
    IF(IATTRIB(ICOL).NE.0)THEN
     LINE=TRIM(LINE)//','//TRIM(VTOS(GEF%NODATA(IATTRIB(ICOL)),'*',1))
    ELSE
     LINE=TRIM(LINE)//',-99999.0'
    ENDIF
    WRITE(KU,'(A)') TRIM(LINE)
   END DO
    
   DO IROW=1,GEF%NROW
    READ(GEF%VALUES(IATTRIB(1),IROW),*) Z1; Z1=GEF%Z-Z1
    READ(GEF%VALUES(IATTRIB(2),IROW),*) Z2; Z2=GEF%Z-Z2
    LINE=TRIM(VTOS(Z1,'F',2))//','//TRIM(VTOS(Z2,'F',2))
    DO ICOL=3,SIZE(IATTRIB)
     IF(IATTRIB(ICOL).NE.0)THEN
      LINE=TRIM(LINE)//','//TRIM(GEF%VALUES(IATTRIB(ICOL),IROW))
     ELSE
      LINE=TRIM(LINE)//',-99999.0'
     ENDIF
    END DO
    WRITE(KU,'(A)') TRIM(LINE)
   END DO
   
   READ(GEF%VALUES(IATTRIB(2),GEF%NROW),*) Z2; GEF%ZEND=GEF%Z-ABS(Z2)
   LINE=TRIM(VTOS(GEF%ZEND,'F',2))
   DO ICOL=2,SIZE(IATTRIB); LINE=TRIM(LINE)//',-99999.0'; ENDDO
   WRITE(KU,'(A)') TRIM(LINE)
        
   CLOSE(KU)

   READ(GEF%VALUES(IATTRIB(2),GEF%NROW),*) Z2; GEF%ZEND=-99999.0D0; IF(IATTRIB(2).NE.0)GEF%ZEND=GEF%Z-Z2
   LINE=TRIM(VTOS(GEF%X,'F',2))//','//TRIM(VTOS(GEF%Y,'F',2))//','//'SUBSET'//TRIM(VTOS(IDIR))//'\'//TRIM(GEF%CID)//','// &
        TRIM(VTOS(GEF%ZEND,'F',2)) //','//TRIM(VTOS(1))

  ELSE

    WRITE(*,'(1X,A)') 'Error reading '//TRIM(GEFNAMES(I))
    LINE='-99999.0,-99999.0,'//TRIM(GEFNAMES(I))//',-99999.0,1'
  
  ENDIF
  !## close gef file
  CLOSE(IU)

  WRITE(JU,'(A)') TRIM(LINE)
    
  IF(IBATCH.EQ.1)WRITE(6,'(A,F10.2,A)') '+Progress ',REAL(I,8)/REAL(SIZE(GEFNAMES),8)*100.0D0,'%              '  

 END DO

 CLOSE(JU)
 IF(IBATCH.EQ.0)CALL UTL_MESSAGEHANDLE(1)

 END SUBROUTINE GEF2IPF_GEFBORE

END MODULE MOD_GEF2IPF