 MODULE readforcingk1DV

#ifdef key_1DV

   !&E==========================================================================
   !&E                   ***  MODULE  readforcingk1DV  ***
   !&E
   !&E
   !&E ** Purpose : read tenfon or barotropic courrent in an ASCII file 
   !&E              tenfon : wave induced bottom shear stress (volume in N/m2)
   !&E              ubaro_force_1DV : baroatropic courrent (m/s)
   !&E
   !&E ** Description :
   !&E     subroutine tenfonw_k1dv          ! read tenfon 
   !&E     subroutine ubarotrop_k1dv          ! read U
   !!======================================================================

#include "toolcpp.h"

   !! * Modules used

   USE parameters
   USE comvars2d, ONLY : nbouc,nvalmax,tchrono,t,indchrono, &
                         iscreenlog,ierrorlog,iwarnlog
   USE_MPI toolmpi,   ONLY : MASTER
   
   IMPLICIT NONE

   !! * Interface

   INTERFACE cas1DV_read_forcing
#ifdef key_1DV_force_towfile
   MODULE PROCEDURE tenfonw_file_k1dv
#endif
#ifdef key_1DV_force_ufile
   MODULE PROCEDURE Ubarotrop_file_k1dv
#endif
   END INTERFACE
   
   !! * Accessibility
   ! functions & routines of this module, called outside :
   ! PUBLIC functions                                ! none ?
   PUBLIC cas1DV_read_forcing
   
     PRIVATE

   !! * Shared or public module variables
#if defined key_1DV_force_towfile
   CHARACTER(LEN=lchain),PUBLIC :: file_tenfonw_1DV ! Location of the ascii file
   REAL(kind=rsh),DIMENSION(:),ALLOCATABLE      :: mytauw
   REAL(kind=rsh),PUBLIC                        :: mytauw_out
#elif key_1DV_force_ufile
   CHARACTER(LEN=lchain),PUBLIC :: file_ubarotrop_1DV ! Location of the ascii file
   REAL(kind=rsh),DIMENSION(:),ALLOCATABLE      :: myU_1DV
#endif   
   
      !---------------------------------------------------------

 
   !! * Private variables


CONTAINS
 
   !!===========================================================================
 
  SUBROUTINE tenfonw_file_k1dv
#ifdef key_1DV_force_towfile
   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE tenfonw_file_k1dv  ***
   !&E
   !&E ** Purpose : reading  wave induced bottom shear stress (volume in N/m2)
   !&E
   !&E ** Description : Used to compute the total bottom shear stress (tenfon)
   !&E
   !&E ** Called by : cas1DV.F90, step.F90
   !&E
   !&E ** Channel : 29, 49
   !&E                
   !&E ** External calls :
   !&E
   !&E ** Used ij-arrays :
   !&E
   !&E ** Modified variables : mytauw
   !&E                        
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !                         Original code
   !&E       !  2015-07  (B. Mengual) issued from river subroutine
   !&E       !  2016-02  (B. Thouvenin) integrated
   !&E---------------------------------------------------------------------


   CHARACTER(LEN=lchain)                      :: rec
   INTEGER                                    :: i,kk,eof,ir,IERR_MPI
   INTEGER                                    :: l,flag
   REAL(KIND=rsh)                             :: val1,val2
   REAL(KIND=rlg)                             :: tool_datosec,tint1,tint2,dt2,dt1,t1
   REAL(kind=rsh)                             :: mytauw_inst
   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter tenfonw_file_k1dv routine, nbouc=',nbouc

   ! ****  Initialization  ****
   !---------------------------

   IF (nbouc == 0) THEN

   ALLOCATE(mytauw(nvalmax))
   
   ! initialize the tenfonw_1dv amount
   ! -------------------------------------
           IF_MPI (MASTER) THEN
           WRITE(iscreenlog,*) 'TENFONW FILE (1DV)        : ',TRIM(file_tenfonw_1DV)
           ENDIF_MPI
           OPEN(29,file = file_tenfonw_1DV,form='formatted')
           print*,'Lecture serie temporelle de tenfonw ',file_tenfonw_1DV
           i=1
   ! check the first available date in tenfonw_1dv file
   ! ------------------------------------------------------
           IF (index(file_tenfonw_1DV,'.dat') /= 0  .OR. index(file_tenfonw_1DV,'.txt') /= 0 ) THEN

             READ(29,*)
             READ(29,*)
             READ(29,*)
             READ(29,*)
             READ(29,'(a)',END=999) rec
             kk=INDEX(rec,'/')-2
             READ(rec(kk+19:),*) val1
             tint1 = tool_datosec(rec(kk:kk+18))
             print*,'tint1 = ',tint1

           ELSE IF (index(file_tenfonw_1DV,'.csv') /= 0) THEN

             READ(29,*)
             READ(29,'(a)',END=999) rec

             l=len_trim(rec)
             DO WHILE (l==0)
                READ(29,'(a)',END=999) rec
                l=len_trim(rec)
             ENDDO
             IF(rec(l:l)<'0'.and.rec(l:l) >'9') l=l-1
             READ(rec(l:l),*)flag
             DO WHILE( flag==9 .OR. flag==4 ) ! pour les mauvaises lignes 
                READ(29,'(a)',END=999) rec
                l=len_trim(rec)
                DO WHILE (l.eq.0)
                   WRITE(*,*) 'ligne blanche'
                   READ(29,'(a)',END=999) rec
                   l=len_trim(rec)
                ENDDO
                IF (rec(l:l)<'0'.and.rec(l:l) >'9') l=l-1
                READ(rec(l:l),*)flag
             ENDDO

             kk=index(rec,'/')-4 ! qd on a une donnee valide lecture de la date
             IF (rec(kk+10:kk+10)==',') THEN
                 tint1 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' 12:00:00')
             ELSE
                 tint1 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' '//rec(kk+11:kk+18))
             ENDIF

             kk=index(rec(1:l-6),',',.true.)
             READ(rec(kk+1:l-6),*)val1

           ELSE

             WRITE(ierrorlog,*) ' '
             WRITE(ierrorlog,*) 'ERROR: In read tenfonw_1DV.F90'
             WRITE(ierrorlog,*) 'file_tenfonw_1DV input file name must end with :'
             WRITE(ierrorlog,*) '     - .txt or .dat for MARS format'
             WRITE(ierrorlog,*) '     - .csv for CDOCO format'
             WRITE(ierrorlog,*) ' look at ',trim(file_tenfonw_1DV)
             WRITE(ierrorlog,*) 'The simulation is stopped'
             CALL_MPI MPI_FINALIZE(IERR_MPI)
             STOP

           END IF

           ! If the simulation starts before the first data record,
           ! the tenfonw value is set to the first available data.
           print*,'i / nvalmax = ',i,'/',nvalmax
           t1=tchrono(i)
           print*,'t1 = ',t1
           DO WHILE (t1 < tint1.AND.i<=nvalmax)
             mytauw(i)=val1
             print*,'mytauw(i)=',mytauw(i)
             i=i+1
             IF (i<=nvalmax) t1=tchrono(i)
           END DO
           IF (i > 1) THEN
             IF_MPI (MASTER) THEN
             WRITE(iwarnlog,*) ' '
             WRITE(iwarnlog,*) 'WARNING: The tenfonw data from ',TRIM(file_tenfonw_1DV)
             WRITE(iwarnlog,*) 'is not available from the beginning of the simulation.'
             WRITE(iwarnlog,*) 'The first available value from the file : ',TRIM(file_tenfonw_1DV)
             WRITE(iwarnlog,*) 'corresponds to the date : ',rec(kk:kk+18)
             WRITE(iwarnlog,*) 'It is equal to : ',val1,' m3/s'
             WRITE(iwarnlog,*) 'and will be used at the beginning of the simulation.'
             ENDIF_MPI
           END IF


          ! time interpolation of tenfonw_1dv data
           IF (i < nvalmax) THEN
             IF (index(file_tenfonw_1DV,'.dat') /= 0  .OR. index(file_tenfonw_1DV,'.txt') /= 0) THEN
               eof=0
               DO WHILE (eof==0)
                  READ(29,'(a)',END=999) rec
                  kk=INDEX(rec,'/')-2
                  READ(rec(kk+19:),*) val2
                  tint2 = tool_datosec(rec(kk:kk+18))
                  DO WHILE ((tchrono(i)-tint1)*(tchrono(i)-tint2) <= 0.0_rlg)
                    dt1=(tchrono(i)-tint1)/(tint2-tint1)
                    dt2=(tint2-tchrono(i))/(tint2-tint1)
                    !print*,'val1 dt2 / val2 dt1',val1,dt2,val2,dt1
                    mytauw(i)=val1*dt2+val2*dt1
                    i=i+1
                    IF (i > nvalmax) GOTO 999
                  END DO
                  tint1=tint2
                  val1=val2
                  !print*,'tint1 / val1 =',tint1,val1
               END DO
             ELSE
               eof=0
               DO WHILE (eof==0)
                  READ(29,'(a)',END=999) rec
                  l=len_trim(rec)
                  DO WHILE (l==0)
                    READ(29,'(a)',END=999) rec
                    l=len_trim(rec)
                  ENDDO
                  IF (rec(l:l)<'0'.AND.rec(l:l) >'9') THEN
                    l=l-1
                  ENDIF
                  READ(rec(l:l),*)flag
                  DO WHILE((flag.EQ.9).or.(flag.EQ.4))
                    READ(29,'(a)',END=999) rec
                    l=len_trim(rec)
                    DO WHILE (l==0)
                       READ(29,'(a)',END=999) rec
                       l=len_trim(rec)
                    ENDDO
                    IF(rec(l:l)<'0'.AND.rec(l:l) >'9') THEN
                       l=l-1
                    ENDIF
                    READ(rec(l:l),*)flag
                 ENDDO
                 ! lecture de la date
                 kk=index(rec,'/')-4
                 IF (rec(kk+10:kk+10)==',') THEN
                    tint2 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' 12:00:00')
                 ELSE
                    tint2 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' '//rec(kk+11:kk+18))
                 ENDIF
                 ! lecture du tenfow
                 kk=index(rec(1:l-6),',',.true.)
                 READ(rec(kk+1:l-6),*)val2

                 DO WHILE ((tchrono(i)-tint1)*(tchrono(i)-tint2) <= 0.0_rlg)
                   dt1=(tchrono(i)-tint1)/(tint2-tint1)
                   dt2=(tint2-tchrono(i))/(tint2-tint1)
                   mytauw(i)=val1*dt2+val2*dt1
                   i=i+1
                   IF (i > nvalmax) GOTO 999
                 END DO
                 tint1=tint2
                 val1=val2
               END DO
             END IF
           END IF
 999       CONTINUE

           ! If the simulation ends after the last data record,
           ! set the tenfonw_1dv to the last available data.
           IF (i < nvalmax) THEN
             IF_MPI (MASTER) THEN
             WRITE(iwarnlog,*) ' '
             WRITE(iwarnlog,*) 'WARNING: The tenfonw_1dv from ',TRIM(file_tenfonw_1DV)
             WRITE(iwarnlog,*) 'is not available to the end of the simulation.'
             WRITE(iwarnlog,*) 'The last available value from the file : ',TRIM(file_tenfonw_1DV)
             WRITE(iwarnlog,*) 'corresponds to the date : ',rec(kk:kk+18)
             WRITE(iwarnlog,*) 'It is equal to : ',val2,' m3/s'
             WRITE(iwarnlog,*) 'and will be used until the end of the simulation.'
             ENDIF_MPI
             mytauw(i:nvalmax)=val2
           END IF

           CLOSE(29)

   END IF ! test nbouc = 0

   ! **** End of initialization part ****
   ! ------------------------------------




   ! ****  Current progress  ****
   ! ----------------------------

   mytauw_inst=0.0_rsh
   dt1=(t-tchrono(indchrono))/(tchrono(indchrono+1)-tchrono(indchrono))
   mytauw_inst=dt1*mytauw(indchrono+1)+(1.d0-dt1)*mytauw(indchrono)
   mytauw_out=mytauw_inst
   !print*,'mytauw_inst',mytauw_inst



   PRINT_DBG*, 'exit read_tenfonw_file_1dv routine'
#endif
  END SUBROUTINE tenfonw_file_k1dv

   !!===========================================================================
 
  SUBROUTINE Ubarotrop_file_k1dv
#if key_1DV_force_ufile

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE Ubarotrop_file_k1dv  ***
   !&E
   !&E ** Purpose : reading  barotropic courrent in a ASCII file
   !&E
   !&E ** Description : Used for forcing cas1DV
   !&E
   !&E ** Called by : cas1DV.F90, step.F90
   !&E
   !&E ** Channel : 29, 49
   !&E                
   !&E ** External calls :
   !&E
   !&E ** Used ij-arrays :
   !&E
   !&E ** Modified variables : ubaro_force_1DV
   !&E                        
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !                         Original code
   !&E       !  2015-07  (B. Mengual) issued from river subroutine
   !&E       !  2016-02  (B. Thouvenin) integrated
   !&E---------------------------------------------------------------------
   USE cometdyn    , ONLY : ubaro_force_1DV

   CHARACTER(LEN=lchain)                      :: rec
   INTEGER                                    :: i,kk,eof,ir,IERR_MPI
   INTEGER                                    :: l,flag
   REAL(KIND=rsh)                             :: val1,val2
   REAL(KIND=rlg)                             :: tool_datosec,tint1,tint2,dt2,dt1,t1
   REAL(kind=rsh)                             :: ubaro_inst
   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter Ubarotrop_file_k1dv routine, nbouc=',nbouc

   ! ****  Initialization  ****
   !---------------------------

   IF (nbouc == 0) THEN

   ALLOCATE(myU_1DV(nvalmax))
   
   ! initialize the U barotrope 
   ! -------------------------------------
           IF_MPI (MASTER) THEN
           WRITE(iscreenlog,*) 'barotropic current FILE (1DV)        : ',TRIM(file_ubarotrop_1DV)
           ENDIF_MPI
           OPEN(29,file = file_ubarotrop_1DV,form='formatted')
           print*,'Lecture serie temporelle de U barotrop ',file_ubarotrop_1DV
           i=1
   ! check the first available date in Ubarotrop_1dv file
   ! ------------------------------------------------------
           IF (index(file_ubarotrop_1DV,'.dat') /= 0  .OR. index(file_ubarotrop_1DV,'.txt') /= 0 ) THEN

             READ(29,*)
             READ(29,*)
             READ(29,*)
             READ(29,*)
             READ(29,'(a)',END=999) rec
             kk=INDEX(rec,'/')-2
             READ(rec(kk+19:),*) val1
             tint1 = tool_datosec(rec(kk:kk+18))
             print*,'tint1 = ',tint1

           ELSE IF (index(file_ubarotrop_1DV,'.csv') /= 0) THEN

             READ(29,*)
             READ(29,'(a)',END=999) rec

             l=len_trim(rec)
             DO WHILE (l==0)
                READ(29,'(a)',END=999) rec
                l=len_trim(rec)
             ENDDO
             IF(rec(l:l)<'0'.and.rec(l:l) >'9') l=l-1
             READ(rec(l:l),*)flag
             DO WHILE( flag==9 .OR. flag==4 ) ! pour les mauvaises lignes 
                READ(29,'(a)',END=999) rec
                l=len_trim(rec)
                DO WHILE (l.eq.0)
                   WRITE(*,*) 'ligne blanche'
                   READ(29,'(a)',END=999) rec
                   l=len_trim(rec)
                ENDDO
                IF (rec(l:l)<'0'.and.rec(l:l) >'9') l=l-1
                READ(rec(l:l),*)flag
             ENDDO

             kk=index(rec,'/')-4 ! qd on a une donnee valide lecture de la date
             IF (rec(kk+10:kk+10)==',') THEN
                 tint1 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' 12:00:00')
             ELSE
                 tint1 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' '//rec(kk+11:kk+18))
             ENDIF

             kk=index(rec(1:l-6),',',.true.)
             READ(rec(kk+1:l-6),*)val1

           ELSE

             WRITE(ierrorlog,*) ' '
             WRITE(ierrorlog,*) 'ERROR: In read Ubarotrop_1DV.F90'
             WRITE(ierrorlog,*) 'file_ubarotrop_1DV input file name must end with :'
             WRITE(ierrorlog,*) '     - .txt or .dat for MARS format'
             WRITE(ierrorlog,*) '     - .csv for CDOCO format'
             WRITE(ierrorlog,*) ' look at ',trim(file_ubarotrop_1DV)
             WRITE(ierrorlog,*) 'The simulation is stopped'
             CALL_MPI MPI_FINALIZE(IERR_MPI)
             STOP

           END IF

           ! If the simulation starts before the first data record,
           ! the Ubarotrop value is set to the first available data.
           print*,'i / nvalmax = ',i,'/',nvalmax
           t1=tchrono(i)
           print*,'t1 = ',t1
           DO WHILE (t1 < tint1.AND.i<=nvalmax)
             myU_1DV(i)=val1
             print*,'myU_1DV(i)=',myU_1DV(i)
             i=i+1
             IF (i<=nvalmax) t1=tchrono(i)
           END DO
           IF (i > 1) THEN
             IF_MPI (MASTER) THEN
             WRITE(iwarnlog,*) ' '
             WRITE(iwarnlog,*) 'WARNING: The Ubarotrop data from ',TRIM(file_ubarotrop_1DV)
             WRITE(iwarnlog,*) 'is not available from the beginning of the simulation.'
             WRITE(iwarnlog,*) 'The first available value from the file : ',TRIM(file_ubarotrop_1DV)
             WRITE(iwarnlog,*) 'corresponds to the date : ',rec(kk:kk+18)
             WRITE(iwarnlog,*) 'It is equal to : ',val1,' m3/s'
             WRITE(iwarnlog,*) 'and will be used at the beginning of the simulation.'
             ENDIF_MPI
           END IF


          ! time interpolation of Ubarotrop_1dv data
           IF (i < nvalmax) THEN
             IF (index(file_ubarotrop_1DV,'.dat') /= 0  .OR. index(file_ubarotrop_1DV,'.txt') /= 0) THEN
               eof=0
               DO WHILE (eof==0)
                  READ(29,'(a)',END=999) rec
                  kk=INDEX(rec,'/')-2
                  READ(rec(kk+19:),*) val2
                  tint2 = tool_datosec(rec(kk:kk+18))
                  DO WHILE ((tchrono(i)-tint1)*(tchrono(i)-tint2) <= 0.0_rlg)
                    dt1=(tchrono(i)-tint1)/(tint2-tint1)
                    dt2=(tint2-tchrono(i))/(tint2-tint1)
                    !print*,'val1 dt2 / val2 dt1',val1,dt2,val2,dt1
                    myU_1DV(i)=val1*dt2+val2*dt1
                    i=i+1
                    IF (i > nvalmax) GOTO 999
                  END DO
                  tint1=tint2
                  val1=val2
                  !print*,'tint1 / val1 =',tint1,val1
               END DO
             ELSE
               eof=0
               DO WHILE (eof==0)
                  READ(29,'(a)',END=999) rec
                  l=len_trim(rec)
                  DO WHILE (l==0)
                    READ(29,'(a)',END=999) rec
                    l=len_trim(rec)
                  ENDDO
                  IF (rec(l:l)<'0'.AND.rec(l:l) >'9') THEN
                    l=l-1
                  ENDIF
                  READ(rec(l:l),*)flag
                  DO WHILE((flag.EQ.9).or.(flag.EQ.4))
                    READ(29,'(a)',END=999) rec
                    l=len_trim(rec)
                    DO WHILE (l==0)
                       READ(29,'(a)',END=999) rec
                       l=len_trim(rec)
                    ENDDO
                    IF(rec(l:l)<'0'.AND.rec(l:l) >'9') THEN
                       l=l-1
                    ENDIF
                    READ(rec(l:l),*)flag
                 ENDDO
                 ! lecture de la date
                 kk=index(rec,'/')-4
                 IF (rec(kk+10:kk+10)==',') THEN
                    tint2 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' 12:00:00')
                 ELSE
                    tint2 = tool_datosec(''//rec(kk+8:kk+9)//'/'//rec(kk+5:kk+6)//'/'//rec(kk:kk+3)//' '//rec(kk+11:kk+18))
                 ENDIF
                 ! lecture du tenfow
                 kk=index(rec(1:l-6),',',.true.)
                 READ(rec(kk+1:l-6),*)val2

                 DO WHILE ((tchrono(i)-tint1)*(tchrono(i)-tint2) <= 0.0_rlg)
                   dt1=(tchrono(i)-tint1)/(tint2-tint1)
                   dt2=(tint2-tchrono(i))/(tint2-tint1)
                   myU_1DV(i)=val1*dt2+val2*dt1
                   i=i+1
                   IF (i > nvalmax) GOTO 999
                 END DO
                 tint1=tint2
                 val1=val2
               END DO
             END IF
           END IF
 999       CONTINUE

           ! If the simulation ends after the last data record,
           ! set the Ubarotrop_1dv to the last available data.
           IF (i < nvalmax) THEN
             IF_MPI (MASTER) THEN
             WRITE(iwarnlog,*) ' '
             WRITE(iwarnlog,*) 'WARNING: The Ubarotrop_1dv from ',TRIM(file_ubarotrop_1DV)
             WRITE(iwarnlog,*) 'is not available to the end of the simulation.'
             WRITE(iwarnlog,*) 'The last available value from the file : ',TRIM(file_ubarotrop_1DV)
             WRITE(iwarnlog,*) 'corresponds to the date : ',rec(kk:kk+18)
             WRITE(iwarnlog,*) 'It is equal to : ',val2,' m3/s'
             WRITE(iwarnlog,*) 'and will be used until the end of the simulation.'
             ENDIF_MPI
             myU_1DV(i:nvalmax)=val2
           END IF

           CLOSE(29)

   END IF ! test nbouc = 0

   ! **** End of initialization part ****
   ! ------------------------------------




   ! ****  Current progress  ****
   ! ----------------------------

   ubaro_inst=0.0_rsh
   dt1=(t-tchrono(indchrono))/(tchrono(indchrono+1)-tchrono(indchrono))
   ubaro_inst=dt1*myU_1DV(indchrono+1)+(1.d0-dt1)*myU_1DV(indchrono)
   ubaro_force_1DV=ubaro_inst
   !print*,'ubaro_inst',ubaro_inst



   PRINT_DBG*, 'exit Ubarotrop_file_k1dv routine'
#endif

  END SUBROUTINE Ubarotrop_file_k1dv

#endif

END MODULE readforcingk1DV
