c
C   program to update data base with existing solutions from s-files
c
c   updates:
c
c   april 14, 1999 jh : -------- version 7.0 check ---------------------
c                       many changes
c   aug   24, 1999 lo : init logfile and epifile
c   nov 2 1999   jh   : recompiled to include new findevin and indata
c   nov 25 2001  jh   : def base (agecy_dir) was still 3 chars, changed to 5
c
      implicit none
      include 'seidim.inc'
c---name of top directory
      character*60 top_directory
c---one event in nordic format, one line of data  
c--- event type, indcator of explosion, indicator of fixing depth  
      character*1 typ,exp
c---directory separator character
      character*1 dchar
c---number of header lines, records, stations in nordic file, help variables
      integer nhead,nrecord,nstat,nphase,i,itp
c---id line indicator
      integer id
c---logfile name when updating
      character*80 logfile
c---flag for indicatin if first month  when updating
      integer first_month
c---line in log file
      character*80 logrecord
      character*80 data(max_data)   ! s-file
c---number of event in one month in data base
      integer nout
c---time of making update
      character*12 p_time
      character*14 proc_time
c---operator id
      character*4 operator
c---data base code
      CHARACTER*5 TBASE
c---first and last event used when updating
      character*12 first_event,last_event
C
C  next for data base operation
C
      character*10 keys                      !next choice key
      character*14 starttime,endtime         ! time interval for location
      character*40 basename                  ! data base or file name
      character*80 eventfile                 ! single event file name
      character*40 outname
      character*5  agency_dir                ! agency used for def. base
      integer status,eventno,newmonth,fstart ! 
c---name of epi file in data base
      CHARACTER*80 EPIFILE
c sei clen
      integer seiclen

c
c---number of arguments and function
c      integer nargs
c


c
c print version
c
      include 'version.inc'
      out_version_date='July 23, 2001'
      if (version_new) out_version_date=version_date
      call print_ver

c                                                           
c   get computer specifics
c
      call dir_char(dchar)         ! dirctory delimiter character
      call get_def_base(agency_dir)

      epifile = ' '

c 
c   get directory structure
c
      call topdir(top_directory)
      itp=index(top_directory,' ')-1
c
c   input data base name and time interval
c
      write(6,*)'Give 1-5 letter data base name, return for default'
      read(*,'(a40)') basename                       
         tbase=basename(1:5)
         IF(TBASE.EQ.'     ') TBASE(1:5)= agency_dir
         WRITE(6,'(A,A)')
     * ' YOU ARE NOW GOING TO UPDATE THE SEISMIC DATA BASE ',TBASE
         WRITE(6,*)
     * 'ARE YOU SURE YOU KNOW WHAT YOU ARE DOING, IF SO, ENTER '
         WRITE(6,*)'OPERATOR ID (max 4 char):'
         READ(5,'(A4)') OPERATOR
         IF(OPERATOR.EQ.'    ') STOP
         WRITE(6,'(a,$)')
     *   ' START TIME(Year-Month)                          : '
         READ(5,'(A14)') STARTTIME
            IF(STARTTIME(7:7).NE.' ') THEN
            WRITE(*,*) ' YOU MUST START WITH BEGINNING OF MONTH'
            WRITE(*,*) ' THIS HAS NOW BEEN CORRECTED'
            STARTTIME(7:14)='        '
         ENDIF
         WRITE(6,'(a,$)')
     *   ' END TIME(Year-Month), RETURN IS TO END OF MONTH : '
         READ(5,'(A14)') ENDTIME
         IF(ENDTIME(7:7).NE.' ') THEN
            WRITE(*,*)' YOU MUST END WITH END OF MONTH'
            WRITE(*,*)' THIS HAS NOW BEEN CORRECTED'
            WRITE(*,*)' THIS HAS NOW BEEN CORRECTED'
            ENDTIME(7:14)='        '
         ENDIF
c
c   make shure base is 5 chars
c
         if(tbase(1:1).ne.',') then
            do i=2,5
              if(tbase(i:i).eq.' ') tbase(i:i)='_'
            enddo
         endif

C
C   open  output files
C
c
      keys(1:4)='NEXT'    ! start with next event

c
c---------------------------------------------------------------------
c  event loop starts here, always come back here after locating one event
c  or to make a new choice in interactive mode
c---------------------------------------------------------------------
c
 50   continue
c
C----------------------------------------------------------------------
C    next event 
C----------------------------------------------------------------------
C
C
C  GET FILENAME OF NEXT EVENT, save previous if any
C
         last_event=eventfile(fstart:fstart+11) ! for log file
         call findevin
     *   (basename,starttime,endtime,keys,0,eventno,
     *   eventfile,fstart,newmonth,status)
         outname(1:17)=eventfile(fstart:fstart+16)
C
C  CHECK FOR OUTPUT IN CAT DATA BASE IF NEW MONTH
c  or end of time period=end of month
C
      IF((NEWMONTH.EQ.1.or.status.eq.3)) THEN
c
c   get system time
c
         call systime(p_time,proc_time)
c
c   write in log file, latest information is on top
c   write when one month of locations is finished
c
         if(first_month.ne.0) then
c
c   first make log file name, assume that epifile (now cat file) name now known
c
            logfile(1:40) = '                                        '
            logfile(41:80)= '                                        '
            logfile(1:itp)=top_directory(1:itp)
            logfile(itp+1:itp+5)=dchar//'REA'//dchar
            logfile(itp+6:itp+10)=tbase
            logfile(itp+11:itp+15)=dchar//'LOG'//dchar
            logfile(itp+16:itp+28)='01-0000-00L.S'
            logfile(itp+29:itp+34)=epifile(1:6)
            write(6,*)
            write(6,'(1x,a)') logfile(1:seiclen(logfile))
c changed lo 13-08-2002
            open(13,file=logfile,status='unknown',access='append')
c            call indata(13,nstat,nphase,nhead,nrecord,typ,exp,data,id)
c            rewind 13
            do i=1,80
              logrecord(i:i)=' '
            enddo
            logrecord(2:5)=epifile(itp+16:itp+19)
            logrecord(7:8)=epifile(itp+20:itp+21)
            logrecord(10:13)=operator
            logrecord(15:28)=proc_time
            logrecord(30:41)=first_event
            logrecord(43:54)=last_event
            write(logrecord(56:60),'(i5)') nout
            write(13,'(a80)') logrecord

c            if(nrecord.eq.0) write(13,*)'        '
c            write(13,'(a80)')(data(i),i=1,nrecord)
            close(13)
            nout=0
          endif
          first_month=1
          first_event=outname(1:12)
          nout=0
c
c   if not at end of time period, open next epi file
c
          if(status.ne.3) then
c
C
C  CLOSE PREVIOUS EPI BASE FILE IF ANY
C
            CLOSE(31,ERR=3333)
 3333       CONTINUE
C
C  YEAR-MONTH
C
            IF(DATA(1)(2:3).EQ.'  ') DATA(1)(2:3)='19'
            EPIFILE(1:4)=eventfile(fstart-8:fstart-5)
            EPIFILE(5:6)=EVENTFILE(FSTART-3:FSTART-2)
            EPIFILE(7:10)= '.CAT'
            WRITE(6,'(1x,a,a10)') 'CATFILE IS ',EPIFILE(1:10)
C
C  OPEN NEW  cat file
C
            OPEN(UNIT=31,FILE=top_directory(1:itp)//
     &      dchar//'REA'//dchar//tbase//dchar//
     &      'CAT'//dchar//EPIFILE(1:10),STATUS='unknown')
c         
         endif
      endif
c
c   check if  errors or end of time interval, then stop
C     
         if(status.gt.0) then
            write(6,*)' STOP WITH STATUS=',status
            stop   ! stop
         endif
C
C   open data base input single event file and read it
c   set flag for single event nrecord= -1
c
         nrecord=-1
         open(21,file=eventfile,status='old')
         call indata(21,nstat,nphase,nhead,nrecord,typ,exp,data,id)
         close(21)
C
c   event is passed on with no modification to data base
c

C
c   output header line on screen
C
            write(6,2838) eventno,data(1)(1:71)
 2838       format(1x,'#',i5,1x,a71)
C
C
C   UPDATE ID LINE
C
         IF(ID.NE.0) THEN
c
c   check that id line has not changed since first read
c   could happen when adding a new error line
c
            do i=1,nhead+1   
              if(data(i)(80:80).eq.'I') id=i
            enddo
            WRITE(DATA(ID)(31:34),'(A)')OPERATOR
            WRITE(data(id)(13:26),'(A)')PROC_TIME
            WRITE(data(id)(9:11),'(A)')'UPD'
         ENDIF
C
c  write normal output file
C

c
c   write out
c
      WRITE(31,'(A80)') (DATA(i),i=1,nrecord)
      NOUT=NOUT+1

      keys='NEXT'

      go to 50                                        
C
c   this was the end
C
      
      stop
      end                                                               

