!!  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_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,MROW
 TYPE(WIN_MESSAGE) :: MESSAGE
 CHARACTER(LEN=1) :: YN
 REAL(KIND=DP_KIND) :: X,Y
 
 IF(ALLOCATED(ICOLGXG))THEN
  NGXG=SIZE(ICOLGXG); ALLOCATE(YRGXG(NGXG))
 ENDIF
 
 !## 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 list of all available IDF files 
 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(VTOS(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(VTOS(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)THEN
   IF(IBATCH.EQ.0)THEN
     CALL WINDOWSELECT(0)
     CALL WINDOWOUTSTATUSBAR(4,'Found 0 IDFs within time constraint')
   ELSE
     WRITE(*,*) 'Found 0 IDFs within time constraint'
   ENDIF
   RETURN
 ENDIF    
 DO I=1,SIZE(IDFNAMES); IDFNAMES(I)=TSDIR(:INDEX(TSDIR,'\',.TRUE.)-1)//'\'//TRIM(IDFNAMES(I)); ENDDO

 !## initialize all global array's (using nper) and keywords
 CALL TS_INIT(IBATCH)

 !## 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; MROW=0
 DO I=1,NROW
  
  CALL WMESSAGEPEEK(ITYPE,MESSAGE)

  IF(.NOT.UTL_READCSVENTRY(IU(1),STRING))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(VTOS(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(VTOS(I))//' in file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
  
  IF(LCOL.GT.0)THEN 
   !## read associated file (could be spaces within) column
   CDUM='"'//TRIM(STRING(LCOL))//'"'; READ(CDUM,*,IOSTAT=IOS) CTS
   IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error reading identification in IROW '//TRIM(VTOS(I))//' in file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
  ELSE
   CTS='ts_measure'//TRIM(VTOS(I))
   J=INDEX(IPFNAME2,'\',.TRUE.)+1
   K=INDEX(IPFNAME2,'.',.TRUE.)-1
   CTS=IPFNAME2(J:K)//'\'//TRIM(CTS)
  ENDIF

  !## read what years are to be included
  IF(NGXG.GT.0)THEN
   YRGXG=ABS(YRGXG)  
   DO J=1,NGXG
    CDUM=STRING(ICOLGXG(J)); READ(CDUM,*,IOSTAT=IOS) YN
    IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error reading identification in GXG year '//TRIM(VTOS(I))//' in file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
    IF(YN.EQ.'N'.OR.YN.EQ.'n')YRGXG(J)=-1*YRGXG(J)
   ENDDO
  ENDIF
  
  !## get sample value from idfs
  IF(TS_READ_IDF(X,Y).EQ.0)THEN
   IF(ICLEAN.EQ.1)CYCLE
  ENDIF

  !## read the timeseries, if available
  IF(.NOT.TS_READ_IPFTS(IBATCH))RETURN

  MROW=MROW+1
  
  IF(NGXG.GT.0)YRGXG=ABS(YRGXG)
   
  !## compute residual
  CALL TS_CALRESIDUALS()

  !## write results in associated file
  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.AND.NGXG.EQ.0)LINE=TRIM(LINE)//','//TRIM(CTS)

   IF(ABS(NGXG).GT.0)THEN
    IF(IASSF.GT.0)THEN
     LINE=TRIM(LINE)//','//TRIM(VTOS(OBSERVATION%GHG,'G',7))
     LINE=TRIM(LINE)//','//TRIM(VTOS(OBSERVATION%GLG,'G',7))
    ENDIF
    LINE=TRIM(LINE)//','//TRIM(VTOS(MEASURE%GHG,'G',7))
    LINE=TRIM(LINE)//','//TRIM(VTOS(MEASURE%GLG,'G',7))
   ENDIF
   
   WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(LINE)
   IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing line '//TRIM(VTOS(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

 CLOSE(IU(2)); CALL UTL_MF2005_MAXNO(TRIM(IPFNAME2)//'_',(/MROW/))

 TS1COMPUTE=.TRUE.

 END FUNCTION TS1COMPUTE

 !###====================================================================
 INTEGER FUNCTION TS_READ_IDF(X,Y)
 !###====================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(IN) :: X,Y
 INTEGER :: I,IROW,ICOL
 
 TS_READ_IDF=0

 MEASURE%OBS=TS_NODATA

 !## loop over the data from start- to end date
 DO I=1,MEASURE%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) THEN 
    !## no value assigned no matter what if measurement point in nodata
    IF(IDFGETVAL(IDF(I),IROW,ICOL).NE.IDF(I)%NODATA)THEN
     TS_READ_IDF=TS_READ_IDF+1
     IF(INTVAL.EQ.0)THEN
      MEASURE%OBS(I)=IDFGETVAL(IDF(I),IROW,ICOL)
     ELSE
      MEASURE%OBS(I)=TS_READ_IDF_INT(IDF(I),X,Y,ICOL,IROW)
     ENDIF
     IF(MEASURE%OBS(I).EQ.IDF(I)%NODATA) MEASURE%OBS(I)=TS_NODATA
    ELSE
     MEASURE%OBS(I)=TS_NODATA
    ENDIF
   ENDIF   
  ENDIF
 ENDDO

 IF(TS_READ_IDF.GT.0)THEN
  IF(NGXG.EQ.-1)THEN
   IF(.NOT.UTL_COMPUTE_GXG(MEASURE%OBS,MEASURE%IDATE,MEASURE%NPER,.FALSE.,.TRUE.,TS_NODATA,GHGVAL=MEASURE%GHG,GLGVAL=MEASURE%GLG))THEN
    TS_READ_IDF=0; MEASURE%OBS=-999.99D0
   ENDIF
  ELSEIF(NGXG.GT.0)THEN
   IF(.NOT.UTL_COMPUTE_GXG(MEASURE%OBS,MEASURE%IDATE,MEASURE%NPER,.FALSE.,.TRUE.,TS_NODATA,YRGXG=YRGXG,GHGVAL=MEASURE%GHG,GLGVAL=MEASURE%GLG))THEN
    TS_READ_IDF=0; MEASURE%OBS=-999.99D0
   ENDIF
  ENDIF
 ENDIF
 
 END FUNCTION TS_READ_IDF

 !###====================================================================
 REAL(KIND=DP_KIND) FUNCTION TS_READ_IDF_INT(IDF,X,Y,ICOL,IROW)
 !###====================================================================
 IMPLICIT NONE
 TYPE(IDFOBJ),INTENT(IN) :: IDF
 INTEGER,INTENT(IN) :: ICOL,IROW
 INTEGER :: I,J,IR,IC,JR,JC
 REAL(KIND=DP_KIND),INTENT(IN) :: X,Y
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2
 REAL(KIND=DP_KIND),DIMENSION(3) :: XCRD,YCRD
 REAL(KIND=DP_KIND),DIMENSION(3,3) :: ZCRD
 REAL(KIND=DP_KIND),DIMENSION(1,1) :: XINT
 REAL(KIND=DP_KIND),DIMENSION(0:1) :: XC,YC

 XCRD=0.0D0; YCRD=0.0D0; ZCRD=IDF%NODATA

 J=0; DO IR=IROW-1,IROW+1
  J=J+1; CALL IDFGETEDGE(IDF,IR,ICOL,X1,Y1,X2,Y2)
  IF(IR.LT.1)THEN
   YCRD(J)=Y1 
  ELSEIF(IR.GT.IDF%NROW)THEN
   YCRD(J)=Y2 
  ELSE
   YCRD(J)=(Y1+Y2)/2.0D0 
  ENDIF
 ENDDO
 I=0; DO IC=ICOL-1,ICOL+1
  I=I+1; CALL IDFGETEDGE(IDF,IROW,IC,X1,Y1,X2,Y2)
  IF(IC.LT.1)THEN
   XCRD(I)=X1 
  ELSEIF(IC.GT.IDF%NCOL)THEN
   XCRD(I)=X2 
  ELSE
   XCRD(I)=(X1+X2)/2.0D0 
  ENDIF
 ENDDO
 
 J=0; DO IR=IROW-1,IROW+1
  J=J+1; I=0; DO IC=ICOL-1,ICOL+1
   !## get first active modellayer
   I=I+1; JC=MIN(IDF%NCOL,MAX(1,IC)); JR=MIN(IDF%NROW,MAX(1,IR))
   ZCRD(I,J)=IDFGETVAL(IDF,JR,JC) 
  ENDDO
 ENDDO

 XINT=0.0D0; XC=X; YC=Y
 CALL POL1INTMAIN(1,1,3,3,XCRD,YCRD,ZCRD,XC,YC,XINT,4,IDF%NODATA)

 TS_READ_IDF_INT=XINT(1,1)

 END FUNCTION TS_READ_IDF_INT

 !###====================================================================
 LOGICAL FUNCTION TS_READ_IPFTS(IBATCH)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:) :: XVAL
 CHARACTER(LEN=52),ALLOCATABLE,DIMENSION(:) :: COLNAME
 CHARACTER(LEN=52) :: CDATE
 INTEGER :: I,J,K,IOS,NC,NDATES
 INTEGER(KIND=DP_KIND) :: IDATE
 
 TS_READ_IPFTS = .TRUE.
 
 IF(IASSF.EQ.0)RETURN

 TS_READ_IPFTS = .FALSE.

 IU(3)=UTL_GETUNIT()

 !## extentie is afhankelijk van de ipf, variabele cext dus.
 FNAME=IPFNAME1(:INDEX(IPFNAME1,'\',.TRUE.))//TRIM(STRING(IEXT))//'.'//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
 !## nothing here
 IF(NDATES.LE.0)THEN
  CLOSE(IU(3)); OBSERVATION%NPER=0
  TS_READ_IPFTS = .TRUE.; 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

 ALLOCATE(XVAL(NC-1));ALLOCATE(COLNAME(NC))

 !## right here the nodata values for date and observation are read
 !## first colum is date colum, second is the observation colum
 DO I=1,NC
  IF(I.EQ.1)THEN ; READ(IU(3),*,IOSTAT=IOS) COLNAME(I),DATE_NODATA
            ELSE ; READ(IU(3),*,IOSTAT=IOS) COLNAME(I),XVAL(I-1) ;  ENDIF    
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'ERROR READING FILE, line 3 in  '//TRIM(FNAME)//'. (2A)'); RETURN; ENDIF
 ENDDO
 OBSERVATION%NODATA=XVAL(TXTCOL-1)
 OBSERVATION%NAME=COLNAME(TXTCOL)

 ALLOCATE(OBSERVATION%OBS(NDATES),OBSERVATION%IDATE(NDATES))
 OBSERVATION%OBS=OBSERVATION%NODATA
 
 !## read rest of the file within the range of dates
 J=0; DO I=1,NDATES
  READ(IU(3),*,IOSTAT=IOS) CDATE,(XVAL(K),K=1,NC-1)  !(OBSERVATION%STRING(K,I),K=1,NC-1) !
  IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error reading data in line '//TRIM(VTOS(I))//' in file '//TRIM(FNAME)//'. (3a)'); RETURN; ENDIF
  READ(CDATE,*,IOSTAT=IOS) IDATE
  IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error reading date in line '//TRIM(VTOS(I))//' in file '//TRIM(FNAME)//'. (3b)'); RETURN; ENDIF
  IDATE=UTL_COMPLETEDATE(IDATE)
  IF(IDATE.GE.SDATE.AND.IDATE.LE.EDATE) THEN
   J=J+1
   !## find correct location
   OBSERVATION%IDATE(J)=IDATE
!   READ(OBSERVATION%STRING(K,TXTCOL-1),*,IOSTAT=IOS) OBSERVATION%OBS(J)
!   IF(IOS.NE.0)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error reading data in line '//TRIM(VTOS(I))//' in file '//TRIM(FNAME)//'. (3a)'); RETURN; ENDIF
   OBSERVATION%OBS(J)=XVAL(TXTCOL-1)
  ENDIF
  OBSERVATION%NPER=J
 ENDDO

 CLOSE(IU(3)); DEALLOCATE(XVAL,COLNAME)
 
 IF(OBSERVATION%NPER.GT.0)THEN
  IF(NGXG.EQ.-1)THEN
   IF(.NOT.UTL_COMPUTE_GXG(OBSERVATION%OBS,OBSERVATION%IDATE,OBSERVATION%NPER,.FALSE.,.TRUE.,OBSERVATION%NODATA,GHGVAL=OBSERVATION%GHG,GLGVAL=OBSERVATION%GLG))OBSERVATION%OBS=-999.99D0
  ELSEIF(NGXG.GT.0)THEN
   IF(.NOT.UTL_COMPUTE_GXG(OBSERVATION%OBS,OBSERVATION%IDATE,OBSERVATION%NPER,.FALSE.,.TRUE.,OBSERVATION%NODATA,YRGXG=YRGXG,GHGVAL=OBSERVATION%GHG,GLGVAL=OBSERVATION%GLG))OBSERVATION%OBS=-999.99D0
  ENDIF
 ENDIF

 TS_READ_IPFTS=.TRUE.

 END FUNCTION TS_READ_IPFTS

 !###====================================================================
 LOGICAL FUNCTION TS_WRITE(IBATCH,FNAME,ANAME)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=*),INTENT(IN) :: FNAME,ANAME
 INTEGER :: I,J,NRECS,IOS,N1,N2,NTIME,IYR,IMH,IDY,IHR,IMT,ISC
 INTEGER(KIND=DP_KIND),DIMENSION(:),ALLOCATABLE :: IDATES
 
 TS_WRITE=.FALSE.; IF(ABS(NGXG).GT.0)THEN; TS_WRITE=.TRUE.; RETURN; ENDIF
 
 !## check if output directory exists or create it
 CALL UTL_CREATEDIR(FNAME(:INDEX(FNAME,'\',.TRUE.)-1))

 !## create the file IPF2
 IU(3)=UTL_GETUNIT()
 CALL OSD_OPEN(IU(3),FILE=FNAME,IOSTAT=IOS,STATUS='REPLACE',ACTION='WRITE')
 IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error while creating file '//TRIM(FNAME)//'. (1)'); RETURN; ENDIF
 
 !## count number of records to be written
 IF(IASSF.EQ.0)THEN
  NRECS=MEASURE%NPER
 ELSE
  !## get unique combinations
  ALLOCATE(IDATES(MEASURE%NPER+OBSERVATION%NPER))
  DO I=1,MEASURE%NPER; IDATES(I)=MEASURE%IDATE(I); ENDDO
  I=I-1; DO J=1,OBSERVATION%NPER; I=I+1; IDATES(I)=OBSERVATION%IDATE(J); ENDDO
  CALL UTL_GETUNIQUE_DINT(IDATES,SIZE(IDATES),NRECS,INT(0,8))
 ENDIF
 
 !## write the header of the file. The header will be adjusted at the end of the process.
 WRITE(IU(3),'(I10)',IOSTAT=IOS) NRECS
 IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error while writing to file '//TRIM(FNAME)//'. (2)'); RETURN; ENDIF
 IF(IASSF.EQ.0)THEN
  WRITE(IU(3),*) 2
 ELSE
  WRITE(IU(3),*) 3
 ENDIF 

 WRITE(IU(3),*) 'Date,'//TRIM(VTOS(-999.0D0,'F',0))
 CALL UTL_ADDQUOTES(OBSERVATION%NAME,1)
 IF(IASSF.EQ.1) WRITE(IU(3),*) TRIM(OBSERVATION%NAME)//','//TRIM(VTOS(OBSERVATION%NODATA,'G',7))  
 MEASURE%NAME=TRIM(ANAME)
 WRITE(IU(3),*) TRIM(MEASURE%NAME)//','//TRIM(VTOS(TS_NODATA,'G',7))

 !## write timeseries section of the associated file
 N1=0; N2=0
 IF(IASSF.EQ.0)THEN
  
  NTIME=0; DO I=1,MEASURE%NPER
   CALL UTL_IDATETOGDATE(MEASURE%IDATE(I),IYR,IMH,IDY,IHR,IMT,ISC)
   NTIME=NTIME+IHR+IMT+ISC
  ENDDO
  
  DO I=1,MEASURE%NPER
   IF(NTIME.EQ.0)THEN
    CALL UTL_IDATETOGDATE(MEASURE%IDATE(I),IYR,IMH,IDY,IHR,IMT,ISC)
    WRITE(LINE,'(I4.4,2I2.2)') IYR,IMH,IDY
    LINE=TRIM(LINE)//','//TRIM(VTOS(MEASURE%OBS(I),'G',7))
   ELSE
    LINE=TRIM(VTOS(MEASURE%IDATE(I)))//','//TRIM(VTOS(MEASURE%OBS(I),'G',7))
   ENDIF
   WRITE(IU(3),*) TRIM(LINE)
   N1=N1+1
  ENDDO
 
 ELSE
 
  NTIME=0; DO I=1,SIZE(IDATES)
   CALL UTL_IDATETOGDATE(IDATES(I),IYR,IMH,IDY,IHR,IMT,ISC)
   NTIME=NTIME+IHR+IMT+ISC
  ENDDO
 
  DO I=1,NRECS
   IF(NTIME.EQ.0)THEN
    CALL UTL_IDATETOGDATE(IDATES(I),IYR,IMH,IDY,IHR,IMT,ISC)
    WRITE(LINE,'(I4.4,2I2.2)') IYR,IMH,IDY
   ELSE
    LINE=TRIM(VTOS(IDATES(I)))
   ENDIF
   DO J=1,OBSERVATION%NPER
    IF(OBSERVATION%IDATE(J).EQ.IDATES(I))THEN
     IF(OBSERVATION%OBS(J).NE.OBSERVATION%NODATA)THEN
      LINE=TRIM(LINE)//','//TRIM(VTOS(OBSERVATION%OBS(J),'G',7)); N2=N2+1; EXIT
     ENDIF
    ENDIF
   ENDDO
   !## nothing found
   IF(J.GT.OBSERVATION%NPER)LINE=TRIM(LINE)//','//TRIM(VTOS(OBSERVATION%NODATA,'G',8))
   DO J=1,MEASURE%NPER
    IF(MEASURE%IDATE(J).EQ.IDATES(I))THEN
     IF(MEASURE%OBS(J).NE.TS_NODATA)THEN 
      LINE=TRIM(LINE)//','//TRIM(VTOS(MEASURE%OBS(J),'G',7)); N1=N1+1; EXIT
     ENDIF
    ENDIF
   ENDDO
   !## nothing found
   IF(J.GT.MEASURE%NPER)LINE=TRIM(LINE)//','//TRIM(VTOS(TS_NODATA,'G',8))
   WRITE(IU(3),*) TRIM(LINE)
  ENDDO
 ENDIF
 
 IF(ALLOCATED(IDATES))DEALLOCATE(IDATES); CLOSE(IU(3))
 
 TS_WRITE=.TRUE.

 END FUNCTION TS_WRITE

 !###====================================================================
 LOGICAL FUNCTION TS_INIT_IPF(IBATCH,NROW,NCOL)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER,INTENT(OUT) :: NROW,NCOL
 INTEGER :: IOS,I,NC
 CHARACTER(LEN=256) :: LINE

 TS_INIT_IPF=.FALSE.

 !## read ipf
 IU(1)=UTL_GETUNIT(); CALL OSD_OPEN(IU(1),FILE=IPFNAME1,IOSTAT=IOS,ACTION='READ,DENYWRITE',FORM='FORMATTED')
 IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'File '//TRIM(IPFNAME1)//' cannot be opened. (1)'); RETURN; ENDIF

 !## create outputfile
 CALL UTL_CREATEDIR(IPFNAME2(:INDEX(IPFNAME2,'\',.TRUE.)-1))
 IU(2) = UTL_GETUNIT(); CALL OSD_OPEN(IU(2),FILE=TRIM(IPFNAME2)//'_',ACTION='WRITE',IOSTAT=IOS,STATUS='REPLACE')
 IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'File '//TRIM(IPFNAME2)//'_ cannot be created.'); RETURN; ENDIF

 !## read header
 READ(IU(1),'(A256)',IOSTAT=IOS) LINE
 READ(LINE,*,IOSTAT=IOS) NROW
 IF(IOS.EQ.0) THEN

  WRITE(IU(2),'(A)',IOSTAT=IOS) 'NaN1#' 
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF
  READ(IU(1),*,IOSTAT=IOS) NCOL
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during read NCOL of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
  IF(LCOL.GT.NCOL)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'LCOL should be maximal equal to NCOL of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF

  ALLOCATE(ATTRIB(NCOL)) !## + 1 for new column if needed

  !## skip the fields
  DO I=1,NCOL
   READ(IU(1),*,IOSTAT=IOS) ATTRIB(I)
   IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during read ATTRIBs of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
  ENDDO

  IF(NGXG.GT.0)THEN
   DO I=1,NGXG
    IF(ICOLGXG(I).LT.0.OR.ICOLGXG(I).GT.NCOL)THEN
     CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred icolgxg '//TRIM(VTOS(ICOLGXG(I)))//' incorrect'); RETURN
    ENDIF
    READ(ATTRIB(ICOLGXG(I)),*,IOSTAT=IOS) YRGXG(I)
    IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during read YRGXG of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
   ENDDO
  ENDIF
  
  !## read location of the id that points towards the textfiles
  READ(IU(1),*,IOSTAT=IOS) IEXT,CEXT
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during read IEXT,EXT of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF
  IF(IEXT.EQ.0) IASSF=0  !## overrule if no associated files are available
  !## get id for name new textfiles
  IF(IEXT.GT.0.AND.LCOL.EQ.0)LCOL=IEXT
  NC=NCOL; IF(LCOL.EQ.0.AND.NGXG.EQ.0)NC=NC+1
  IF(ABS(NGXG).GT.0)THEN; NC=NC+2; IF(IASSF.NE.0)NC=NC+2; ENDIF
 
  WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(VTOS(NC))
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF

  DO I=1,SIZE(ATTRIB)
   WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(ATTRIB(I))
   IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF
  ENDDO
  IF(LCOL.EQ.0.AND.NGXG.EQ.0)WRITE(IU(2),*) 'Identifier'
  IF(ABS(NGXG).GT.0)THEN
   IF(IASSF.NE.0)THEN
    WRITE(IU(2),'(A)',IOSTAT=IOS) 'GHG_OBSERVATION'
    WRITE(IU(2),'(A)',IOSTAT=IOS) 'GLG_OBSERVATION'
   ENDIF
   WRITE(IU(2),'(A)',IOSTAT=IOS) 'GHG_COMPUTED'
   WRITE(IU(2),'(A)',IOSTAT=IOS) 'GLG_COMPUTED'
  ENDIF
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF

  IF(NGXG.EQ.0)THEN
   IF(LCOL.EQ.0)THEN
    WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(VTOS(NC))//','//TRIM(CEXT)
   ELSE
    WRITE(IU(2),'(A)',IOSTAT=IOS) TRIM(VTOS(LCOL))//','//TRIM(CEXT)
   ENDIF
  ELSE
   WRITE(IU(2),'(A)',IOSTAT=IOS) '0,TXT'
  ENDIF
  IF(IOS.NE.0) THEN; CALL TS_ERROR_MESSAGE(IBATCH,'Error occurred during writing to file '//TRIM(IPFNAME2)//'.'); RETURN; ENDIF
 
 !## ipf csv style
 ELSE
 
  NCOL=UTL_COUNT_COLUMNS(LINE,' ,;')
  IF(LCOL.GT.NCOL)THEN; CALL TS_ERROR_MESSAGE(IBATCH,'LCOL should be maximal equal to NCOL of file '//TRIM(IPFNAME1)//'.'); RETURN; ENDIF

  ALLOCATE(ATTRIB(NCOL+1))
  READ(LINE,*) (ATTRIB(I),I=1,NCOL)

  IEXT=0; CEXT='TXT'

  IF(IEXT.GT.0.AND.LCOL.EQ.0)LCOL=IEXT
  IF(IEXT.EQ.0)THEN; NC=NCOL+1; ATTRIB(NC)='Identifier'; ENDIF
  
  NROW=0; DO; READ(IU(1),*,IOSTAT=IOS); IF(IOS.NE.0)EXIT; NROW=NROW+1; ENDDO
  REWIND(IU(1)); READ(IU(1),*)

  LINE='"'//TRIM(ATTRIB(1))//'"'
  DO I=2,NC; LINE=TRIM(LINE)//',"'//TRIM(ATTRIB(I))//'"'; ENDDO
  WRITE(IU(2),'(A)') TRIM(LINE)
   
 ENDIF
 
 DEALLOCATE(ATTRIB)

 TS_INIT_IPF=.TRUE.

 END FUNCTION TS_INIT_IPF

 !###====================================================================
 LOGICAL FUNCTION TS_INIT_IDF(IBATCH)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I,J
 INTEGER(KIND=DP_KIND) :: IDATE
 LOGICAL :: LEX

 TS_INIT_IDF=.FALSE.

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

 !## inquire/open all files that are within jd1 and jd2
 J=0; DO I=1,SIZE(IDFNAMES)
  FNAME=IDFNAMES(I)
  INQUIRE(FILE=FNAME,EXIST=LEX)
  IF(LEX)THEN
   IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Found '//TRIM(FNAME)//' ...')
   !## read idf header, open file
   IF(.NOT.IDFREAD(IDF(I),FNAME,0))THEN
    CALL TS_ERROR_MESSAGE(IBATCH,'Error while reading file '//TRIM(FNAME))
    RETURN
   ENDIF

   IDATE=YMDHMSTOITIME(IDF(I)%IYR,IDF(I)%IMH,IDF(I)%IDY,IDF(I)%IHR,IDF(I)%IMT,IDF(I)%ISC)
   IDATE=UTL_COMPLETEDATE(IDATE)
   
   IF(IDATE.GE.SDATE.AND.IDATE.LE.EDATE.AND.IDATE.GT.0)THEN
    J=J+1; MEASURE%IDATE(J)=IDATE 
    IF(IDFREAD(IDF(J),IDF(I)%FNAME,0))THEN ; ENDIF
   ENDIF
   
  ENDIF

 ENDDO
 MEASURE%NPER=J
 
 IF(MEASURE%NPER.EQ.0)THEN
  CALL TS_ERROR_MESSAGE(IBATCH,'No IDF found that is within the given timeselection for the current SOURCEDIR folder.')
 ELSE
  TS_INIT_IDF=.TRUE.
 ENDIF
 IF(IBATCH.EQ.0)THEN
  CALL WINDOWSELECT(0)
  CALL WINDOWOUTSTATUSBAR(4,'Found '//TRIM(VTOS(MEASURE%NPER))//' IDF"s within time constraint')
 ELSE
  WRITE(*,*) 'Found ',MEASURE%NPER,' IDF"s within time constraint'
 ENDIF

 END FUNCTION TS_INIT_IDF

 !###====================================================================
 SUBROUTINE TS_CALRESIDUALS()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I,J

 IF(OBSERVATION%NPER.EQ.0)RETURN

 MEASURE%RES=TS_NODATA
 DO I=1,MEASURE%NPER
  
  DO J=1,OBSERVATION%NPER
   IF(MEASURE%IDATE(I).EQ.OBSERVATION%IDATE(J))THEN
    MEASURE%RES(I)=MEASURE%OBS(I)-OBSERVATION%OBS(J); EXIT
   ENDIF
  ENDDO

 ENDDO

 END SUBROUTINE TS_CALRESIDUALS

 !###====================================================================
 SUBROUTINE TS_ERROR_MESSAGE(IBATCH,TXT)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 CHARACTER(LEN=*),INTENT(IN)   :: TXT

 IF(IBATCH.EQ.0)CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,TRIM(TXT),'Error')
 IF(IBATCH.EQ.1)WRITE(*,'(//1X,A/)') TRIM(TXT)

 END SUBROUTINE TS_ERROR_MESSAGE

 !###====================================================================
 SUBROUTINE TS_INIT(IBATCH)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IBATCH
 INTEGER :: I

 IF(IBATCH.EQ.0) THEN ; LCOL=0 ; TXTCOL=2 ; ENDIF

 CALL TS_END()
 ALLOCATE(IDF(SIZE(IDFNAMES)))
 DO I=1,SIZE(IDF); CALL IDFNULLIFY(IDF(I)); ENDDO
 ALLOCATE(MEASURE%OBS(SIZE(IDFNAMES)))
 ALLOCATE(MEASURE%RES(SIZE(IDFNAMES)))
 ALLOCATE(MEASURE%IDATE(SIZE(IDFNAMES)))
 MEASURE%NPER=0; MEASURE%NODATA=TS_NODATA

 OBSERVATION%NPER=0

 END SUBROUTINE TS_INIT

 !###====================================================================
 SUBROUTINE TS_END()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: I

 DO I=1,SIZE(IU); IF(IU(I).NE.0)CLOSE(IU(I)); ENDDO

 IF(ALLOCATED(IDF))THEN
  CALL IDFDEALLOCATE(IDF,SIZE(IDF)); DEALLOCATE(IDF)
 ENDIF

 IF(ASSOCIATED(MEASURE%OBS))  DEALLOCATE(MEASURE%OBS)
 IF(ASSOCIATED(OBSERVATION%OBS))  DEALLOCATE(OBSERVATION%OBS)
 IF(ASSOCIATED(MEASURE%RES))  DEALLOCATE(MEASURE%RES)
 IF(ASSOCIATED(OBSERVATION%RES))  DEALLOCATE(OBSERVATION%RES)
 IF(ASSOCIATED(MEASURE%IDATE))DEALLOCATE(MEASURE%IDATE)
 IF(ASSOCIATED(OBSERVATION%IDATE))DEALLOCATE(OBSERVATION%IDATE)
 IF(ALLOCATED(STRING))DEALLOCATE(STRING)

 END SUBROUTINE TS_END

END MODULE MOD_TS_CLC