!! Copyright (C) Stichting Deltares, 2005-2017.
!!
!! 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 .
!!
!! Contact: imod.support@deltares.nl
!! Stichting Deltares
!! P.O. Box 177
!! 2600 MH Delft, The Netherlands.
MODULE MOD_TS_CLC
USE WINTERACTER
USE MOD_UTL, ONLY : UTL_GETUNIT,UTL_CAP,UTL_IDATETOJDATE,UTL_JDATETOIDATE,UTL_WAITMESSAGE,ITOS,RTOS,UTL_MESSAGEHANDLE,UTL_CREATEDIR
USE MOD_IDF, ONLY : IDFDEALLOCATE,IDFGETVAL,IDFREAD,IDFIROWICOL,IDFNULLIFY
USE MOD_OSD, ONLY : OSD_OPEN
USE MOD_TS_PAR
CONTAINS
!###======================================================================
LOGICAL FUNCTION TS1COMPUTE()
!###======================================================================
IMPLICIT NONE
INTEGER :: I,J,K,IOS,IRAT,IRAT1,ITYPE !,DC
TYPE(WIN_MESSAGE) :: MESSAGE
REAL :: X,Y
CHARACTER(LEN=MAXLEN) :: CDUM
!## inquire whether org. ipf exists
INQUIRE(FILE=IPFNAME1,EXIST=TS1COMPUTE)
IF(.NOT.TS1COMPUTE)THEN
IF(IBATCH.EQ.0)THEN
CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'File: '//TRIM(IPFNAME1)//' not found.','Error')
ELSEIF(IBATCH.EQ.1)THEN
WRITE(*,*) 'File: '//TRIM(IPFNAME1)//' not found.'
ENDIF
RETURN
ENDIF
TS1COMPUTE=.FALSE.
!## convert to julian date
JD1 =UTL_IDATETOJDATE(JD1)
!## convert to julian date
JD2 =UTL_IDATETOJDATE(JD2)
!## compute number of days in between
NPER=JD2-JD1+1
!## Initialize all global array's - using nper
CALL TS_INIT()
!## if not opened all existing idf's correctly
IF(.NOT.TS_INIT_IDF())RETURN
!## if not opened and read header of ipf
IF(.NOT.TS_INIT_IPF())RETURN !DC))RETURN
ALLOCATE(STRING(NCOL))
!## process all the records in the ipf-files
IRAT=0
DO I=1,NROW
CALL WMESSAGEPEEK(ITYPE,MESSAGE)
READ(IU(1),*,IOSTAT=IOS) (STRING(J),J=1,NCOL)
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('Error occurred during read of file '//TRIM(IPFNAME1)//'.')
RETURN
ENDIF
!## assuming these are the x/y coordinates
CDUM=STRING(1)
READ(CDUM,*,IOSTAT=IOS) X
IF(IOS.NE.0)THEN
CALL TS_ERROR_MESSAGE('Error reading X-coordinate in IROW '//TRIM(ITOS(I))//' in file '//TRIM(IPFNAME1)//'.')
RETURN
ENDIF
CDUM=STRING(2)
READ(CDUM,*,IOSTAT=IOS) Y
IF(IOS.NE.0)THEN
CALL TS_ERROR_MESSAGE('Error reading Y-coordinate in IROW '//TRIM(ITOS(I))//' in file '//TRIM(IPFNAME1)//'.')
RETURN
ENDIF
IASSF=0
IF(IEXT.GT.0)THEN
IASSF=1
!## read associated file (could be spaces within) column
CDUM='"'//TRIM(STRING(IEXT))//'"'
READ(CDUM,*,IOSTAT=IOS) CTS
IF(IOS.NE.0)THEN
CALL TS_ERROR_MESSAGE('Error reading identification in IROW '//TRIM(ITOS(I))//' in file '//TRIM(IPFNAME1)//'.')
RETURN
ENDIF
ENDIF
!## read the timeseries, if available
IF(.NOT.TS_READ_IPF())RETURN
!## read the idfs
IF(.NOT.TS_READ_IDF(X,Y))RETURN
!## compute residual
CALL TS_CALRESIDUALS()
IF(LCOL.EQ.0)THEN
CTS='ts_measure'//TRIM(ITOS(I))
J=INDEX(IPFNAME2,'\',.TRUE.)+1
K=INDEX(IPFNAME2,'.',.TRUE.)-1
CTS=IPFNAME2(J:K)//'\'//TRIM(CTS)
ELSEIF(LCOL.GT.0)THEN
CTS=STRING(LCOL)
ENDIF
!## writing COMMA DELIMITED file
LINE=TRIM(STRING(1))
DO J=2,NCOL; LINE=TRIM(LINE)//','//TRIM(STRING(J)); ENDDO
IF(LCOL.EQ.0)LINE=TRIM(LINE)//',"'//TRIM(CTS)//'"'
WRITE(IU(2),*,IOSTAT=IOS) TRIM(LINE)
IF(IOS.NE.0)THEN
CALL TS_ERROR_MESSAGE('Error occurred during writing line '//TRIM(ITOS(I))//' to file '//TRIM(IPFNAME2)//'.')
RETURN
ENDIF
!## write results
LINE=IPFNAME2(:INDEX(IPFNAME2,'\',.TRUE.))//TRIM(CTS)//'.'//TRIM(CEXT)
IF(.NOT.TS_WRITE(LINE)) RETURN
IF(IBATCH.EQ.0)THEN
CALL WINDOWSELECT(0)
CALL UTL_WAITMESSAGE(IRAT,IRAT1,I,NROW,'Progress Timeserie: ')
ELSEIF(IBATCH.EQ.1)THEN
WRITE(6,'(A,F10.2,A)') '+Progress Timeserie: ',REAL(100*I)/REAL(NROW),'%'
ENDIF
ENDDO
TS1COMPUTE=.TRUE.
END FUNCTION TS1COMPUTE
!###====================================================================
LOGICAL FUNCTION TS_READ_IDF(X,Y)
!###====================================================================
IMPLICIT NONE
REAL,INTENT(IN) :: X,Y
INTEGER :: I,IROW,ICOL
TS_READ_IDF = .FALSE.
!## all dates are valid
IPER=1
OBS%CALC=NODATA
!## loop over de data van start datum tot eind datum
DO I=1,NPER
!## check whether inside period and if idf is opened
IF(IDF(I)%IU.NE.0) THEN
CALL IDFIROWICOL(IDF(I),IROW,ICOL,X,Y)
IF(IROW.NE.0.AND.ICOL.NE.0)OBS(I)%CALC=IDFGETVAL(IDF(I),IROW,ICOL)
ENDIF
ENDDO
TS_READ_IDF = .TRUE.
END FUNCTION TS_READ_IDF
!###====================================================================
LOGICAL FUNCTION TS_READ_IPF()
!###====================================================================
IMPLICIT NONE
REAL :: OBSERVATION
INTEGER :: IDATE,I,J,IOS,NCOLS,NDATES
CHARACTER(LEN=MAXLEN) :: CDUM
TS_READ_IPF = .FALSE.
IF(IASSF.EQ.1)THEN
IU(3)=UTL_GETUNIT()
!## extentie is afhankelijk van de ipf, variabele CEXT dus.
FNAME=IPFNAME1(:INDEX(IPFNAME1,'\',.TRUE.))//TRIM(CTS)//'.'//TRIM(CEXT)
CALL OSD_OPEN(IU(3),FILE=FNAME,IOSTAT=IOS,ACTION='READ,DENYWRITE',FORM='FORMATTED')
IF(IOS.NE.0)THEN
CALL TS_ERROR_MESSAGE('Error while opening file '//TRIM(FNAME)//'. (1)')
RETURN
ENDIF
!## header
READ(IU(3),*,IOSTAT=IOS) NDATES
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('ERROR READING FILE, line 1 in '//TRIM(FNAME)//'. (2)')
RETURN
ENDIF
READ(IU(3),*,IOSTAT=IOS) NCOLS
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('ERROR READING FILE, line 2 in '//TRIM(FNAME)//'. (2)')
RETURN
ENDIF
!## right here the nodata values for date and observation are read
!## first colum is date colum, second is the observation colum
READ(IU(3),*,IOSTAT=IOS) CDUM,NODATA_DAT
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('ERROR READING FILE, line 3 in '//TRIM(FNAME)//'. (2A)')
RETURN
ENDIF
READ(IU(3),*,IOSTAT=IOS) CDUM,NODATA
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('ERROR READING FILE, line 4 in '//TRIM(FNAME)//'. (2B)')
RETURN
ENDIF
!## skip the rest
DO I=1,NCOLS-2
READ(IU(3),*,IOSTAT=IOS) !CDUM,RDUM
IF(IOS.NE.0) THEN
CALL TS_ERROR_MESSAGE('ERROR READING FILE, line >4