!!  Copyright (C) Stichting Deltares, 2005-2022.
!!
!!  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_PAR

USE WINTERACTER, ONLY : IOSDIRENTRYTYPE,IOSDIRCOUNT
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_UTL, ONLY : ITOS,RTOS,UTL_GETUNIT,UTL_CAP,IOSDIRMAKE,UTL_DIRINFO,UTL_SUBST
USE IMODVAR, ONLY : DP_KIND,SP_KIND

CHARACTER(LEN=256),DIMENSION(:),POINTER :: GEFNAMES=>NULL()
TYPE GEFOBJ
 CHARACTER(LEN=50) :: CID
 REAL(KIND=DP_KIND) :: X,Y,ZEND,Z
 INTEGER :: NCOL,NROW,ZID,XYID
 CHARACTER(LEN=50),DIMENSION(:),POINTER :: UNIT,NAME !## COLUMNINFO Unit, COLUMNINFO Name
 INTEGER,DIMENSION(:),POINTER :: IATTRIB   !## column in gef file
 REAL(KIND=DP_KIND),DIMENSION(:),POINTER :: NODATA
 REAL(KIND=DP_KIND),DIMENSION(:),POINTER :: FMULT
 CHARACTER(LEN=52),DIMENSION(:,:),POINTER :: VALUES
END TYPE GEFOBJ
TYPE(GEFOBJ) :: GEF

INTEGER,DIMENSION(:),ALLOCATABLE :: IATTRIB   !## column in IPFFILE
CHARACTER(LEN=256) :: GEFDIR,IPFFNAME,GENFNAME
!INTEGER :: N 
INTEGER,DIMENSION(:),ALLOCATABLE :: NCOLLINE

CONTAINS

 !###====================================================================
 LOGICAL FUNCTION LREADGEF(IU,INAME,ESTRING)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU,INAME
 CHARACTER(LEN=*),INTENT(OUT) :: ESTRING
 INTEGER :: I,ICOL,IROW,IOS,N
 CHARACTER(LEN=50) :: STRING
 CHARACTER(LEN=256) :: LINE
 
 LREADGEF=.FALSE.
 
 IF(IU.LE.0)RETURN
 
 IF(.NOT.LREADKEYWORD(IU,'#TESTID=',STRING,0,ESTRING))RETURN
 READ(STRING,*,IOSTAT=IOS) GEF%CID
 IF(IOS.NE.0)THEN; ESTRING='TESTID NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF

 IF(.NOT.LREADKEYWORD(IU,'#COLUMN=',STRING,0,ESTRING))RETURN
 READ(STRING,*,IOSTAT=IOS) GEF%NCOL
 IF(IOS.NE.0)THEN; ESTRING='#COLUMN NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
   
 !# get number of record in gef-file
 IF(.NOT.LREADKEYWORD(IU,'#LASTSCAN=',STRING,0,ESTRING))RETURN
 READ(STRING,*) GEF%NROW
 IF(IOS.NE.0)THEN; ESTRING='#LASTSCAN NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 IF(GEF%NROW.EQ.0)THEN; ESTRING='NO DATA IN FILE '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF

 !## determine maximal number of columns in data block
 IF(.NOT.LREADKEYWORD(IU,'EOH=',STRING,0,ESTRING))THEN
  ESTRING='EOH NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN
 ENDIF
  
 ALLOCATE(NCOLLINE(GEF%NROW)); NCOLLINE=0

 DO IROW=1,GEF%NROW
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)THEN
   ESTRING='Missing records in: '//TRIM(GEFNAMES(INAME)); RETURN
  ENDIF
  !## count number of columns per line and store in a the NCOLLINE variable 
  DO; I=INDEX(LINE,';'); IF(I.EQ.0)EXIT; NCOLLINE(IROW)=NCOLLINE(IROW)+1; LINE(I:I)=','; ENDDO
 ENDDO 
 
 N=MAXVAL(NCOLLINE); ALLOCATE(GEF%UNIT(N),GEF%NAME(N),GEF%NODATA(N),GEF%FMULT(N))
 
 GEF%NAME=''          !## column name of attribute
 GEF%UNIT=''          !## column unit of attribute
 GEF%NODATA=-999.99D0 !## nodata value
 GEF%FMULT=1.0D0      !## multiplication factor (used for cpt)

 !## read specified numerical field labels
 DO I=1,GEF%NCOL
  IF(.NOT.LREADKEYWORD(IU,'#COLUMNINFO='//TRIM(ITOS(I))//',',STRING,0,ESTRING))RETURN
  READ(STRING,*,IOSTAT=IOS) GEF%UNIT(I),GEF%NAME(I)
  IF(IOS.NE.0)THEN; ESTRING='#COLUMNINFO='//TRIM(ITOS(I))//' NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 END DO

 !## option nodata values
 DO I=1,GEF%NCOL
  IF(LREADKEYWORD(IU,'#COLUMNVOID='//TRIM(ITOS(I))//',',STRING,1,ESTRING))THEN
   READ(STRING,*,IOSTAT=IOS) GEF%NODATA(I)
   IF(IOS.NE.0)THEN; ESTRING='#COLUMNVOID='//TRIM(ITOS(I))//' NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
  ENDIF
 END DO

 DO I=GEF%NCOL+1,MAXVAL(NCOLLINE)
  GEF%UNIT(I)='-'; GEF%NAME(I)='SOILTYPE'//TRIM(ITOS(I-GEF%NCOL))
 ENDDO

 IF(.NOT.LREADKEYWORD(IU,'#XYID=',STRING,0,ESTRING))RETURN
 READ(STRING,*,IOSTAT=IOS) GEF%XYID,GEF%X,GEF%Y
 IF(IOS.NE.0)THEN; ESTRING='XY NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 IF(GEF%XYID.NE.31000)THEN
  IF(IOS.NE.0)THEN; ESTRING='#XYID NOT IN RD COORDINATES '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 ENDIF
 !## correct x/y coordinates
 IF(GEF%X.LT.0.0D0)THEN; GEF%X=GEF%X+155000.0D0; GEF%Y=GEF%Y+463000.0D0; ENDIF

 !## read z value
 IF(.NOT.LREADKEYWORD(IU,'#ZID=',STRING,0,ESTRING))RETURN
 IF(INDEX(UTL_CAP(TRIM(STRING),'U'),'NULL').GT.0)THEN
  GEF%Z=0.0D0
 ELSE
  READ(STRING,*,IOSTAT=IOS) GEF%ZID,GEF%Z
  IF(GEF%ZID.NE.31000)THEN
   IF(IOS.NE.0)THEN; ESTRING='#ZID NOT IN NAP '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
  ENDIF
  IF(IOS.NE.0)THEN; ESTRING='#ZID NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 ENDIF

 !## allocate GEF-variable for character valued part IPF-file
 N=MAXVAL(NCOLLINE); ALLOCATE(GEF%VALUES(N,GEF%NROW)); GEF%VALUES='-99999.0'
 
 !## data starts
 IF(.NOT.LREADKEYWORD(IU,'EOH=',STRING,0,ESTRING))THEN
  ESTRING='EOH NOT READ PROPERLY '//TRIM(GEFNAMES(INAME)); RETURN
 ENDIF
 
 NCOLLINE=0
 DO IROW=1,GEF%NROW
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)THEN; ESTRING='File not fully available '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
  !## substitute ; for ,
  DO; I=INDEX(LINE,';'); IF(I.EQ.0)EXIT; NCOLLINE(IROW)=NCOLLINE(IROW)+1; LINE(I:I)=','; ENDDO
  READ(LINE,*,IOSTAT=IOS) (GEF%VALUES(ICOL,IROW),ICOL=1,NCOLLINE(IROW))
  IF(IOS.NE.0)THEN; ESTRING='File not fully available '//TRIM(GEFNAMES(INAME)); RETURN; ENDIF
 END DO
 
 LREADGEF=.TRUE.

 END FUNCTION LREADGEF

 !###====================================================================
 LOGICAL FUNCTION LREADKEYWORD(IU,CKEY,STRING,IOPT,ESTRING)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IOPT,IU
 CHARACTER(LEN=256) :: LINE
 CHARACTER(LEN=*),INTENT(OUT) :: STRING,ESTRING
 CHARACTER(LEN=*),INTENT(IN) :: CKEY
 INTEGER :: I,J,IOS

 LREADKEYWORD=.FALSE.; ESTRING=''

 REWIND(IU)
 DO
  READ(IU,'(A256)',IOSTAT=IOS) LINE
  IF(IOS.NE.0)EXIT
  !## remove spaces
  CALL LCLEAN(LINE)
  I=INDEX(UTL_CAP(LINE,'U'),CKEY)
  IF(I.NE.0)THEN
   J=LEN_TRIM(CKEY)
   STRING=LINE(I+J:)
   LREADKEYWORD=.TRUE.
   EXIT
  ENDIF
 ENDDO

 IF(IOPT.EQ.0.AND..NOT.LREADKEYWORD)THEN
  CLOSE(IU); ESTRING='KEYWORD: [ '//TRIM(CKEY)//' ] not found'
 ENDIF
 
 END FUNCTION LREADKEYWORD

 !###====================================================================
 SUBROUTINE LCLEAN(LINE)
 !###====================================================================
 IMPLICIT NONE
 CHARACTER(LEN=*),INTENT(INOUT) :: LINE
 INTEGER :: I,J

 DO
  J=LEN_TRIM(LINE)
  I=INDEX(LINE(:J),' ')
  IF(I.EQ.0)EXIT
  LINE(I:J-1)=LINE(I+1:J)
  LINE(J:)=' '
 END DO

 END SUBROUTINE LCLEAN

 !###====================================================================
 SUBROUTINE GEFDEALLOCATE()
 !###====================================================================

 IF(ASSOCIATED(GEF%IATTRIB))DEALLOCATE(GEF%IATTRIB)
 IF(ASSOCIATED(GEF%UNIT))   DEALLOCATE(GEF%UNIT)
 IF(ASSOCIATED(GEF%NAME))   DEALLOCATE(GEF%NAME)
 IF(ASSOCIATED(GEF%NODATA)) DEALLOCATE(GEF%NODATA)
 IF(ASSOCIATED(GEF%FMULT))  DEALLOCATE(GEF%FMULT)
 IF(ASSOCIATED(GEF%VALUES)) DEALLOCATE(GEF%VALUES)
 IF(ALLOCATED(NCOLLINE))    DEALLOCATE(NCOLLINE)
 IF(ALLOCATED(IATTRIB))     DEALLOCATE(IATTRIB)

 END SUBROUTINE GEFDEALLOCATE

END MODULE MOD_GEF2IPF_PAR