!! Copyright (C) Stichting Deltares, 2005-2020.
!!
!! 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
USE MOD_IDF
USE MOD_OSD
USE MOD_TS_PAR
CONTAINS
!###======================================================================
LOGICAL FUNCTION TS1COMPUTE(IBATCH)
!###======================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IBATCH
INTEGER :: I,J,K,IOS,IRAT,IRAT1,ITYPE,NROW,NCOL
TYPE(WIN_MESSAGE) :: MESSAGE
REAL(KIND=DP_KIND) :: X,Y
MSR%NPER=0
OBS%NPER=0
!## 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.
!## get them all
IF(IOSDIREXISTS(TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1)))THEN
IF(.NOT.UTL_DIRINFO_POINTER(TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1), &
TRIM(TSDIR(INDEX(TSDIR,'\',.TRUE.)+1:))//'_*_L'//TRIM(ITOS(TSILAY))//'.IDF',IDFNAMES,'F',CORDER='N'))RETURN
IF(.NOT.ASSOCIATED(IDFNAMES))THEN
CALL TS_ERROR_MESSAGE(IBATCH,'Error iMOD cannot find any appropriate files in '//TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1)//CHAR(13)// &
' with wildcard '//TRIM(TSDIR(INDEX(TSDIR,'\',.TRUE.)+1:))//'_*_L'//TRIM(ITOS(TSILAY))//'.IDF'); RETURN
ENDIF
ELSE
CALL TS_ERROR_MESSAGE(IBATCH,'Error iMOD cannot find folder '//TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1)); RETURN
ENDIF
IF(SIZE(IDFNAMES).EQ.0)RETURN
DO I=1,SIZE(IDFNAMES); IDFNAMES(I)=TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1)//'\'//TRIM(IDFNAMES(I)); ENDDO
!## initialize all global array's - using nper
CALL TS_INIT()
!## if not opened all existing idf's correctly
IF(.NOT.TS_INIT_IDF(IBATCH))RETURN
!## if not opened and read header of ipf
IF(.NOT.TS_INIT_IPF(IBATCH,NROW,NCOL))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(IBATCH,'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(IBATCH,'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(IBATCH,'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(IBATCH,'Error reading identification in IROW '//TRIM(ITOS(I))//' in file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
ELSE
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
ENDIF
!## read the timeseries, if available
IF(.NOT.TS_READ_IPF(IBATCH))RETURN
!## read the idfs
IF(.NOT.TS_READ_IDF(X,Y))RETURN
!## compute residual
CALL TS_CALRESIDUALS()
!## write results
LINE=IPFNAME2(:INDEX(IPFNAME2,'\',.TRUE.))//TRIM(CTS)//'.'//TRIM(CEXT)
IF(TS_WRITE(IBATCH,LINE,TSDIR(INDEX(TSDIR,'\',.TRUE.)+1:)))THEN
!## writing comma delimited file
LINE=TRIM(STRING(1))
DO J=2,NCOL
IF(LCOL.EQ.0)THEN
LINE=TRIM(LINE)//','//TRIM(STRING(J))
ELSE
IF(J.EQ.IEXT)LINE=TRIM(LINE)//',"'//TRIM(STRING(J))//'"'
IF(J.NE.IEXT)LINE=TRIM(LINE)//','//TRIM(STRING(J))
ENDIF
ENDDO
IF(LCOL.EQ.0)LINE=TRIM(LINE)//',"'//TRIM(CTS)//'"'
WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(LINE)
IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing line '//TRIM(ITOS(I))//' to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF
ENDIF
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(KIND=DP_KIND),INTENT(IN) :: X,Y
INTEGER :: I,IROW,ICOL
TS_READ_IDF = .FALSE.
MSR%OBS=MSR%NODATA
!## loop over the data from start- to end date
DO I=1,MSR%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)MSR%OBS(I)=IDFGETVAL(IDF(I),IROW,ICOL)
ENDIF
ENDDO
TS_READ_IDF = .TRUE.
END FUNCTION TS_READ_IDF
!###====================================================================
LOGICAL FUNCTION TS_READ_IPF(IBATCH)
!###====================================================================
IMPLICIT NONE
INTEGER,INTENT(IN) :: IBATCH
REAL(KIND=DP_KIND) :: OBSERVATION
INTEGER :: I,J,IOS,NC,NDATES
INTEGER(KIND=DP_KIND) :: IDATE
TS_READ_IPF = .TRUE.
IF(IASSF.EQ.0)RETURN
TS_READ_IPF = .FALSE.
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(IBATCH,'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(IBATCH,'ERROR READING FILE, line 1 in '//TRIM(FNAME)//'. (2)'); RETURN; ENDIF
READ(IU(3),*,IOSTAT=IOS) NC
IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'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,OBS%NODATA
IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'ERROR READING FILE, line 3 in '//TRIM(FNAME)//'. (2A)'); RETURN; ENDIF
READ(IU(3),*,IOSTAT=IOS) CDUM,OBS%NODATA
IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'ERROR READING FILE, line 4 in '//TRIM(FNAME)//'. (2B)'); RETURN; ENDIF
!## skip the rest
DO I=1,NC-2
READ(IU(3),*,IOSTAT=IOS)
IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'ERROR READING FILE, line >4