C ***67***************************************************************72

      SUBROUTINE BCSTD(KD,SECKD,ITER,UBAR,VBAR,III)

C Include file for parameter statements

      INCLUDE 'DCMS.DIM'

C Parameter statements

      PARAMETER (NTBCDIM  = 500)

C Fixed global variables

      INTEGER ITER,III
      INTEGER KD
      REAL    SECKD
      REAL    UBAR(NNDIM),VBAR(NNDIM)

C User-specified local assignments
C Gregorian time at the intervals of the BCS from MOODY.

      integer KDBC(NTBCDIM)
      real    SECBC(NTBCDIM)
      real    DBC(NRDIM,NTBCDIM)
      integer LRVS(NRDIM)

      integer NTBC, NR 
      real    DELTTBC
      integer KD0, SEC0
      save    KDBC, SECBC, DBC, NTBC, NR, DELTTBC, LRVS 

      character*72 FNAME 
      character*72 MESHNAME

      real    BT1, BT2
      integer I, K, P1, P2
      integer II, KK
      integer LI 
      integer NBC
      integer IYEAR, IMONTH, IDAY
C Beginning of executable code

      if (III.eq.0) go to 3
      if (III-2)4,5,6

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C This section may be used for initialization purposes.
C
C We will build the time arrays that go with the input bcs.
C
C It would be better to build the times on the fly but roundoff gets
C in the way of my simple-minded calculation.  But I know that there
C must be a better way.
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    3 CONTINUE

      write (*,*) 'Enter name of file containing time dependent BCS'
      read (*,'(A)') FNAME
      write(*,'(A)') ' read TD bcs from ',FNAME
      do K = 1, NTBCDIM
         KDBC(K) = 0
 	 SECBC(K) = 0.0
      enddo
      do K = 1, NTBCDIM
         do I = 1, NRDIM
            DBC(I,K) = 0.0
         enddo
      enddo
      
      open(11,file=FNAME,status='old',err=31)
      read(11,'(a)') MESHNAME
      read(11,*)
CVL      read(11,*) KD0, SEC0
CFEW  read(11,*) IDAY, IMONTH, IYEAR
      read(11,*) IDAY, IMONTH, IYEAR, SEC0
      call GDAY(IDAY,IMONTH,IYEAR,KD0)
      read(11,*) NTBC, DELTTBC
      read(11,*) NR
      if(NTBC.le.1) then 
         write(*,*)'BCSTD: 1 or fewer time points in bcs. '
         write(*,*)'ntbc ', NTBC
         stop
      endif

      do k = 1, NTBC
         do i = 1, NR
            read(11,*) KK,II,LI,DBC(I,K)
            if(I.eq.II) then 
               LRVS(I) = LI
            else
               write(*,*) 'BCSTD: Not sure of boundary node information'
               write(*,*) KK,II,LI,DBC(I,K)
               write(*,*) 'STOP NOW ' 
               stop
            endif
         enddo
      enddo

      close(BCSTDFN)

      KDBC(1) = KD0
      SECBC(1) = SEC0
      if (SECBC(1).ge.86400.0) then
         KDBC(1) = KDBC(1) + int(SECBC(1)/86400.)
         SECBC(1) = mod(SECBC(1),86400.)
      endif

      do i = 2, NTBC
         KDBC(I) = KDBC(I-1)
         SECBC(I) = SECBC(I-1)+ DELTTBC 
         if(SECBC(I).ge.86400.0) then
            KDBC(I) = KDBC(I) + int( SECBC(I) / 86400.0 )
            SECBC(I) = mod( SECBC(I),86400.0 )
         endif
      enddo

      write(*,*)' BCSTD: nr, ntbc ', NR, NTBC
      write(*,*)' delttbc ', DELTTBC
      write(*,*)' First BCS time ', KDBC(1), SECBC(1)
      write(*,*)' Final BCS time ', KDBC(NTBC), SECBC(NTBC)

      RETURN

C Condition for lack of file

 31   write(*,*) 'File ',FNAME,' does not exist'
      stop

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C Surface Elevation BC's are assigned in this section.  One statement of
C   the form UBAR(I)=ELEV must appear for each specified surface
C   elevation node, where I is the horizontal node number and ELEV is
C   the elevation for node I.  
C
C A return statement must follow the last elevation BC assignment.
C
c  Synthesize the bcs at saco time (kd, seckd) from the time 
C  series of boundary conditions from MOODY which are given at 
C  the time points kdbc, secbc 
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    4 CONTINUE

      if (((kd-kdbc(1))*86400.0+seckd-secbc(1)).lt.0.0) then
	 p1 = 1
	 p2 = 2
	 BT2 = 0. 
      elseif ((kd-kdbc(ntbc))*86400.0+seckd-secbc(ntbc).gt.0.0) then
	 p1 = ntbc - 1
	 p2 = ntbc
	 BT2 = 1.
      else

C  find interval which contains the current time

         DDAY = KD - KD0 
         DSECONDS = DDAY*24*3600 + (SECKD - SEC0)
         DDAY = KD - KDBC(1) 
         DSECONDS = DDAY*24*3600 + (SECKD - SECBC(1))
         P1 = int (DSECONDS/DELTTBC)  + 1

         if(p1.le.0) then 
  	    write(*,*)'problems in bcs2', kd,kdbc(1),seckd,secbc(1),p1
 	    write(*,*)dday,dseconds,DELTTBC
 	    stop 
	 endif
         p2 = p1+1
         
C now calculate the time domain basis functions

         dseconds = (kd - kdbc(p1))*24.*3600. + seckd - secbc(p1)
         BT2 = dseconds/DELTTBC 
      endif
      BT1 =  1.0 - BT2 

      DO I=1,NR 
         NBC = LRVS(I)
         UBAR(NBC) = 0.0
         UBAR(NBC) = BT1*DBC(I,P1) + BT2*DBC(I,P2)
      ENDDO

      RETURN

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C Nonzero normal velocity BC's are assigned in this section.  One 
C   statement of the form UBAR(I)=VNORM must appear for each set nonzero
C   normal velocity node, where I is the horizontal node number and 
C   VNORM is the normal velocity for node I.  
C   Positive normal velocity indicates flow out of the system.  
C
C A return statement must follow the last normal velocity BC assignment.
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    5 CONTINUE
      WRITE(*,*)'SUBROUTINE BCCSTD called in error with III=2'
      STOP
      RETURN

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C Nonzero velocity BC's are assigned in this section.  Two statements
C   of the following form must appear for each nonzero velocity node:
C      UBAR(I)=XVEL
C      VBAR(I)=YVEL
C   I is the horizontal node number, (XVEL,YVEL) are the
C   values of the (X,Y) velocities for node I.  
C
C A return statement must follow the last velocity BC assignment.
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    6 CONTINUE
      WRITE(*,*)'SUBROUTINE BCSTD called in error with III=3'
      STOP
      RETURN

C End of routine

      END
