cSTART**************************************************************************
C      PROGRAM SELECT
c
c
c  arguments: If only one argument, it is name of select.inp parameter
c             file. If several arguments (at least 3), all inputs via
c             arguments. The arguments are:
c 
c             -base   : 5 letter data base 
c             -seisweb: if set, input from seisweb, output to seisweb
c             -time   : time interval
c             -web_out: complete path to where data is placed, only
c                        active if seisweb set. 3 filers made: 
c                       web_out.id  : id's, like index.out without # 
c                       web_out.all : like select.out
c                       web_out.head: header lines
c             -area   : lat-lon grid, minlat,maxlat,minlon,maxlon
c             -depth  : depth range, mindepth,maxdepth
c             -mag    : magnitude range, minmag,maxmag
c             -nstat  : range of number of stations, min,max
c             -gap    : range of gap, min,max
c             -rms    : range of rms, min,max
c             -mgtypes  : up to 5 mag types, one string
c             -disttype : -------dist------------------
c             -eventtype: ------event------------------
  
C
C     WRITTEN BY:   C. LINDHOLM
C     MODIFIED BY : J. HAVSKOV
C     LAST REVISED: AUGUST 18, 1987
C     LAST REVISED: DEC 20, 1988.  POSSIBILITY TO RUN ON COMPACT FILES INCLUDED
C     LAST REVISED: jan 6, 1988.  POSSIBILITY TO RUN EVENTS WITH
C                                 DISTANCEID=BLANK
C     LAST REVISED  APRIL 19 -89  POSSIBILITY RUN ON DATABASE INCLUDED
C
C                   1990-01-30,R.N.ARVIDSSON, TO PC-DOS
C     LAST REVISED  1990-01-30,RNA, COMMON BLOCK STRUCTURE CHANGED BECAUSE
C                                   IT IS NOT POSSIBLE TO MIX CHARACTERS
C                                   WITH INTEGER TYPES.
C                   1990-02-16,RNA, COMMON BLOCK STRUCTURE AGAIN THE SAME
c                                   PROBLEM.
C                   1990-02-22,RNA, FILENR.LIS OPTION REMOVED
C                   JUL 27, 90, JH, MAJOR REVISION
C                   AUG 2   90  J.H BUGS
C                       6           BUGS
C                      17           REMOVE REFERENCE TO DCL
c                      24           back to vax, card from 120 to 140 chars
C                   OCT 18  90   J.H: MULTIPLE DATA BASE OPTION
c                   nov 19  90      : I5 for event number in index file
c                   sep 19  91   jh : include call to topdirectory
c                   oct 07          : pc adoption, see vax comments, 12 char time
c                                     main data base is rea not base
c                   nov 4           : findev.. to find_ev...
c                   nov 24          : new version of indata, some clean up
C                   AUG 18, 92    JH: NEW SELECT ON EVENT TYPE
c                   sep 15 92       : select on earthquakes (q) and magnitude type
c                   oct 7,12        : bug with magnitude selection
C                   OCT 29          : ADD OUTPUT OF WAVEFORM FILE NAMES
c                   oct6 30         : bug
c                   nov 15          : check for wrong header lines in episel
C                   MAR 25, 93      : BUG WITH MAG SELECTION
c                   jul 93 by jh    : version 3.0*******************************
c                                     REA to agency, EPI to CAT
c                   aug 20          : bug in episelect when one file only
c                                   : filenames to 80
c                                   : bug with station selection
c                   sep 10          : bug with filnr.lis on pc, put null char
c                   sep 17          : bug wirht index file open, more info
c                       18          : do not select non locate deqs, select no mags
c                       22          ; neg rms means larger than for rms
c                   dec 29          : split question about nag and rms
c                   mar 2, 94       : bug when reading mag-rms limits
c                   mar 21 94       : make filenr.lis in local dir
c                   may 31 94       : write out number of events selected, each
c                                     new data base file
c                   nov 07,94 by Carlos Eduardo Vieira
c                                     routine SELCRIT changed allowing
c                                     choose which defaults are going to be
c                                     changed using menu (routine DRAW_SCREEN)
C!JAB(BGS)Nov94                     : Installed file & error handling (libsei)
c
c                  dec 94           : ********** version 5.0 ****************
c                  dec 13           : last check
c                  jan 11   95 jh   : new call to get base
c                  feb 7            : also use lolat and lolon in def
c                  feb16            : make index file also when searching in
c                                     a file
c                  apr 5    95 jh   : fix selection when no magnitude type
c                  may 8            : bog in above
c                  may 11   95      : select any event types
c                  may 15           : use actual number of station if event file
c                                     instead of number in header
c                  dec 7 95 jh      : if selecting in a file, do not stop if
c                                     data is not in chronological order
c                  feb 8 96         : possible to select in all header lines
c                  feb 16           : fix error limits for hypocneter errors,
c                  feb 20           : put in waveform file select
c                  mar 4 96         : bug
c                  june 10, 96      : do not use event type to make file name
c                                     from a second header line
c                  oct 25, 96       : stop if no data in data base
c                  dec 96           : do not use filenr.lis
c                  feb 27   97      : bug in above
c                  mar 25           : bug in magnitude selection
c                  jan 13, 98       : use century as default,  ***year 2000***
c                                     and a few more improvements
c------------------------------------------------------------------------------
c                  oct-nov 98 by jh :  version 7.0 check, commands input file
c                  jan 99 by bmt    :  initialization of magtypest,disttypet,eventtypet 
c                  jun 16 99 jh     : select.cmd to selec.inp
c                  aug 18,99        :  selection for gap
c                  aug 22,99        : selection for epicenter distance
c                  sep 7            : bug with gap selection
c                  sep 14           : bug with magnitude agency in select.inp
c                                     hypocenter agency
c
c                  sep 22           : bug with start in year 2000
c                  oct 18           : for polarity selection, only select if
c                                     polarity is for P, do not use + and -
c                  oct 21           : century selection wrong, combinaitons
c                                     gap and other not exclusive
c jan 13, 2000 jh : another year 2000 problem, end date not found if after
c                   year 2000, thanks fernando
c mar 13       jh : input with prompt
c mar 22            more of the above
c may 11       jh : always stop if wrong time interval
c nov 8           : do not write out in index file if input form a file,
c                   allow filenames shorter than 6 if containing a .
c jan 10, 2001 lo : init seisweb, since true on Linux
c mar 5   2001 jh : distance to real
c mar 08  2001 lo : change in default area setting
c apr 30  2001 jh : select by phase, individually and by station
c may 10          : distce acan be either epicentral or hypocentral
c may 25          : select did not work with negative magnitudes !!!!!!!
c jun 25          : comment change
c jul 5           : fix so distance type and mag types do not cance each
c                   other, seems to only be a display problem
c nov 7   2001 bm : now can use output file given in the prompt line after 
c                   given "select.inp" (make same output like SEISWEB command)
c                   e.i. select  select.inp  select.out
c nov 7   2001 bm : clear the output file when nothing is found
c nov 23       jh : bug: station selection did not non located events
c mar20           : option to use s-files
c apr 15          : bug in above, did not work with select.inp
c aug 22  2002 jh : select stations, even when all have weight 4
c sep 12  2002 lo : select volcanic sub-classes
c apr 22  2003 jh : small format change
c may 27          : wavefor.out to waveform_names.out
c sep 11  2003 jh : increase fild for number of evets
c feb 20  2007 jh : header_check was not initilized so all headers were
c                   always checked
c sep 30  2008 jh : blank input of time is now between 1980 and 2015
c
      IMPLICIT NONE
      include 'seidim.inc'        ! dimensions
      integer seiclen             ! function
      CHARACTER*1 DISTANCEID,EXP,EVENTID,DEPTHID,MAGTYPES(5),
     *DISTTYPE(5),EVENTTYPE(5),magtype
      character*6 volcanictype(10)   ! volcanic subclasses
      character*3 AGENCY,MAGAGENCY
      CHARACTER*80 DATA(max_data)
      character*80 web_out           ! path and file name for web output
      character*6 basetype           ! type of base CAT or sfile
      logical seisweb                ! true if call from seisweb
      integer narg                   ! number fo arguments
      INTEGER NRECORD,NHEAD
c-- see subroutine find...       
      integer		status,new_month,fstart,event_no 
c-- select key                                       
      character*10     key
c-- event file name                                   
      character*80	evfile
      character*80 choise_file       ! file with choises, none if blank
      integer max_cat_files          ! maximum number of cat files
      real dist                      ! epicentral distance
      parameter(max_cat_files=2000)
      character*80 cat_files(max_cat_files)   ! cat file nemes
      integer ncat_files             ! number of cat_files
C  NUMBER OF STATIONS TO BE PRESENT AND number of stations for event
      INTEGER		stat_present,NSTAT
      logical       all_stat         ! if true,  all must be present
c  number of hypocenter agencies present
      integer           hypa_present
c  number of magnitude agencies present
      integer           maga_present
C  NUMBER OF PHASES FOR ONE EVENT
      INTEGER NPHASE	  
c  id line number
      integer id
C  1: EVENT CONTAIN REQ. STATION, 0: NO
      INTEGER		STATIONOK	
C  STATIONS CODES TO SELCT BY
      CHARACTER*7	STATSELECT(50)
      character*4       stat_phase(50)  ! phases to select with stations
      integer mindist(50),maxdist(50)   ! distance range for station 
      logical hyp_dist                  ! if true, use hypocentral distance
c  hypocenter agencies
      character*3       hypaselect(10)
c  magnitude agencies
      character*3       magaselect(10)
C  ONE STATION CODE and component
      CHARACTER*7	STATIONCODE	
C  INPUT FILE NAME IN DATA BASE 
      CHARACTER*80	SFILE
C  Name of database
      CHARACTER*80	basename
      character*5 agency_loc
c  first and last file in data base
C  starttime for processing data
      CHARACTER*14      starttime
c  century
      CHARACTER*14	endtime
C  NUMBER OF EVENTS IN FILES
      INTEGER		NEVENT		
C  NUMBER OF LOCAL EVENTS IN FILES
      INTEGER		NLOCAL		
C  NUMBER OF REGIONAL EVENTS IN FILES
      INTEGER		NREGIONAL	
C  NUMBER OF DISTANT EVENTS IN FILES
      INTEGER		NDISTANT	
C  NUMBER OF LOC. AND REG. EVENTS SELECTED
      INTEGER           NOUT		
C  NUMBER OF WAVEFORM FILES
      INTEGER NWAVE
c  number of indexes out
      integer nid
c  end and start of time indicator 
      logical end_of_time,start_of_time
c  logical to indicate compact file  
      logical compact
c  logical to indicate fault plane solution found
      logical fpsolutf
c  logical to indicate earthquake felt found
      logical eqfeltf
c  logical to indicate hypocenter error latitude found
      logical helatf
c  logical to indicate hypocenter error longitude found
      logical helonf
c  logical to indicate hypocenter error depth found
      logical hedepthf
c  variable reading from the file
      real filevar
C  OPTION OF INPUT
      INTEGER           inputoption
C  COUNTERS
      integer		j,i,k,n
C  SELECTION CRITERIAS: LATITUDE, LONGITUDE, MAGNITUDE, DEPTH, MAX AND MIN RMS
C                       MAX AND MIN HYPOCENTER ERROR LAT, LONG AND DEPTH
      REAL MAG, HILAT,LOLAT,HILON,LOLON,MAXMAG,MINDEPTH,MAXDEPTH,
     *     maxrms,minrms,maxgap,mingap,
     *     minhelat, maxhelat,
     *     minhelon, maxhelon,
     *     minhedepth, maxhedepth
      integer igap   ! gap read from file
     
C  SELECTION CRITERIAS: TIME INTERVAL,MIN AND MAX # OF STATIONS
      INTEGER MINSTATION, MAXSTATION 
      double precision time1,time2,timcen
C  STATUS PARAMETER, EPIBASE
      INTEGER nstatus
C  EVENT ACCEPTED OR NOT
      LOGICAL  ACCEPTED,default
C  DATE,TIME AND NUMBER OF STAITONS
      integer YEAR,MONTH,DAY,HOUR,MINUTES,NUMBEROFSTATIONS
C  SECOND, LATITUDE,LONGITUDE,DEPTH, TIME, MINUMUM MAG AND RMS
      real    SEC,LATI,LONG,DEPTH,minmag,rmsvalue
      integer isec
c  top directory name
      character*60 top_directory
c   directory delimiter
      character*1 dchar
c   text
      character*80 text
c   dir name for EPI now cat
      character*80 dir
c   fault plane solution
      logical fpsolut
c   earthquake felt
      logical eqfelt
      logical header_check       ! if or not all header lines checked
      logical wave               ! true if correct wave form file name found
      character*40 wave_check    ! string to identify wave from file name
      integer n_header_check     ! number of header lines to check
      real ypol(max_polyn$,2)    ! array defining polygon
      integer iant               ! number of points of the polygon
      integer mnupol             ! minumum number of polarities
      integer cnupol             ! counter for number of polarities
      character*4 phase(6)       ! phase names to select
      logical singleout          ! true if output file is given in the command line
      character*80 outfile       ! output file  name given in the command line
c
      COMMON/EPIVALUE/YEAR,MONTH,DAY,HOUR,MINUTES,SEC,LATI,LONG,DEPTH,
     *                 NUMBEROFSTATIONS,RMSVALUE,MAG,ACCEPTED,nstat
C
      COMMON/EPICHAR/DISTANCEID,EVENTID,DEPTHID,AGENCY,
     *                    MAGTYPE,MAGAGENCY
C
      common/epicrite/hilat,lolat,hilon,
     *                lolon,minmag,maxmag,minrms,maxrms,mindepth,
     *                maxdepth,minhelat,maxhelat,minhelon,maxhelon,
     *                minhedepth,maxhedepth,ypol,iant,mnupol
      common/epicrit2/fpsolut,eqfelt,statselect
      common/epicrit1/mindist,maxdist,
     *                hypaselect,magaselect 
      common/epicrit3/default,eventtype,disttype,magtypes,volcanictype
      common/epicrit4/minstation,maxstation,stat_present,hypa_present,
     *                maga_present,header_check,wave_check
      common/epicrit5/time1,time2,timcen,all_stat,mingap,maxgap,phase,
     *                stat_phase,hyp_dist
C
C    Seisan library inserts and routines...
C    ======================================
C
       include 'libsei.inc'                ! Library definitions & data defns.
       external sei open,                  ! Open file routine.
     &          sei close,                 ! Close file routine.
     &          sei code                   ! Error encoder.
C
       integer  write1,                    ! Output unit 1.
     &          write3,                    ! Ditto 3.
     &          write4,                    ! Ditto 4.
     &          write5,                    ! Ditto 4.
     &          read1,                     ! Input unit1.
     &          code                       ! Local condition.
       logical  b_flag                     ! Flag end of file?.
C
C    ============= end of list ==========
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

      b_f_debug$=.false.                   ! file io debugging
C
C   INITIALIZE 
C
      NEVENT=0
      NLOCAL=0
      NREGIONAL=0
      NDISTANT=0
      NOUT=0
      NWAVE=0
      nid=0
      basetype='CAT'
      do i=1,6
         phase(i)=' '
      enddo
      compact=.false.
      seisweb=.false.
      singleout=.false.
      header_check=.false.      ! 2-2007 jh
      wave_check=' '
      hyp_dist=.false.
      call dir_char(dchar)
      call get_def_base(agency_loc)

C   USE STANDARD DATA BASE BY DEFAULT
C
      BASENAME(1:10)='          ' 
c
c   check if prompt input with file name of input file with choises
c
      choise_file=' '
c
      call get_arguments(narg,data)
c
c     check if  output file is given
c
      if(narg.eq.2) then
        outfile = data(2)
        singleout = .true.
        narg = 1
      endif
c
      if(narg.eq.1) then
         choise_file=data(1)
         write(6,'(a,a)')' Choises from file: ',choise_file
         open(1,file=choise_file,status='old',err=3334)
         goto 3335
 3334    continue
         write(6,'(a,a)')' File does not exist: ',choise_file
         stop
 3335    continue
         read(1,'(32x,a)') basename
         read(1,'(32x,a)') basetype
         close(1)
      endif
c
c   find out if all choises from promt line and get them if true
c
      call selcrit_prompt
     *(narg,data,starttime,endtime,basename,seisweb,
     * web_out)


c
c     INQUIRE TYPE OF INPUT if not from file or argument string
C
 435  CONTINUE
      if(choise_file.eq.' '.and.narg.lt.3) then
         WRITE(*,*)' POSSIBLE INPUT IS: '
         WRITE(*,*)'    STANDARD CAT DATA BASE: RETURN'
         WRITE(*,*)'    ALTERNATIVE DATA BASE, GIVE 1-5 LETTER CODE:'                
         WRITE(*,*)'    FILENAME FOR ONE FILE, ',
     *              'MUST BE 6 OR MORE CHARACTERS OR HAVE A .'
         READ(5,'(A)') BASENAME
c
c   do not ask for type of base if input is a file
c
         i=index(basename,' ')-1
         j=index(basename,'.')
         if(.not.(I.GT.5.or.j.ne.0)) then
            write(6,*) ' Type of base: CAT (Return) or Sfiles (s):'
            read(5,'(a)') text
            if(text(1:1).eq.'s'.or.text(1:1).eq.'S') 
     *      basetype='SFILES'
         endif
      endif
C
C  DETERMINE TYPE OF INPUT
C
      if(.not.seisweb) then
      i=index(basename,' ')-1
      j=index(basename,'.')
      IF(BASENAME(1:5).EQ.'     ') THEN
         INPUTOPTION=1
         BASENAME(1:5)=agency_loc
      ENDIF
c
      IF(I.lt.6.and.j.eq.0) then
         INPUTOPTION=1          ! data base
         do k=2,5
           if(basename(k:k).eq.' ') basename(k:k)='_'
         enddo
      endif
      IF(I.GT.5.or.j.ne.0) INPUTOPTION=2  ! file

c
c   set type of base
c
      if(inputoption.eq.1.and.basetype.eq.'SFILES') inputoption=3
c
C   OPEN FILE
C
      IF(INPUTOPTION.EQ.2) THEN
          call sei open( old$+warn$,       ! Open file & warn of erro.
     &                   ' ',              ! Prompt (n/a).
     &                   BASENAME,         ! Filename.
     &                   read1,            ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )            ! Returned condition.
          if( code .ne. e_ok$ ) then       ! An error or does not exist.
             code = e_ok$                     ! Re-set condition.
             if(choise_file.eq.' ') then
                goto 435                         ! & re-prompt.
             else
                write(6,'(a,a)') ' File does not exist: ',basename
                stop                          ! stop if input from choise file
             endif                           !
           endif
      ENDIF
      else
c         i=seiclen(basename)
c         top_directory=basename(1:i-9)   ! put in path
c         basename(1:5)=basename(i-4:i)   ! put in base name
c         basename(6:80)=' '
c         call put_env_seistop(top_directory) ! put in environment
         inputoption=1      ! only choise from seisweb
c         write(6,'(0x,a24)')'Content-type: text/plain' ! needed for seisweb'
c         write(6,'(0x,a0)') ''     
      endif

c
c   data base indexing
c
      IF(INPUTOPTION.EQ.1) THEN
c
         write(6,'(a,a)')' Updating data base ',basename(1:5)
c
c   get top dir name and make cat dir name
c
         call topdir(top_directory)
         i=index(top_directory,' ')-1
         dir(1:i)=top_directory(1:i)
         dir(i+1:i+1)=dchar
         dir(i+2:i+4)='REA'
         dir(i+5:i+5)=dchar
         dir(i+6:i+10)=basename(1:5)
         dir(i+11:i+11)=dchar
         dir(i+12:i+14)='CAT'
c
c   make listing of files in  CAT
c
         call getfiles(dir,i+14,cat_files,max_cat_files,n)
c
         k=0
c
c   sort out non cat files
c
         do i=1,n
            if(cat_files(i)(7:10).eq.'.CAT') then
               k=k+1
               cat_files(k)=cat_files(i)
            endif
         enddo
c
c   stop if no files
c
         if(k.lt.1) then
           write(6,'(a,a)')
     *     ' No data in data base specified: ', basename(1:5)
           if(seisweb) write(6,*)
     *     'select_terminated: error no data in base'
           stop
         endif
c
         write(6,'(a,a5,a,i4,a)')
     *' The data base ',basename(1:5),' has ',k,' files'
         write(6,'(a,a)')' The first file starts: ',cat_files(1)(1:6) 
         write(6,'(a,a)')' The  last file starts: ',cat_files(k)(1:6)
         write(6,*)
         ncat_files=k
      ENDIF
c
c   open output files
c
      if(singleout) then
        seisweb=.true.
        web_out = outfile
      endif

      if(seisweb) then

           call sei open( unknown$,        ! Open file (default stop on error).
     &               ' ',                  ! Prompt (n/a).
     &               web_out(1:seiclen(web_out))//'.all',  ! Filename.
     &               write1,               ! Unit opened on.
     &               b_flag,               ! Flag (n/a).
     &               code )                ! Returned condition (n/a).
           endfile write1                  ! need to be clear up
           rewind write1
         call sei open( unknown$,         ! Open file (default=stop on error)
     &                  ' ',              ! Prompt (n/a).
     &       web_out(1:seiclen(web_out))//'.id',      
     &                  write3,           ! Unit opened on.
     &                  b_flag,           ! Flag (n/a).
     &                  code )            ! Returned condition (n/a).
           endfile write3                 ! need to be clear up
           rewind write3
c
c   file with header lines
c
         call sei open( unknown$,         ! Open file (default=stop on error)
     &                  ' ',              ! Prompt (n/a).
     &       web_out(1:seiclen(web_out))//'.head',      
     &                  write5,           ! Unit opened on.
     &                  b_flag,           ! Flag (n/a).
     &                  code )            ! Returned condition (n/a).
           endfile write5                 ! need to be clear up
           rewind write5
      else
C
             call sei open( unknown$,      ! Open file (default stop on error).
     &               ' ',                  ! Prompt (n/a).
     &               'select.out',         ! Filename.
     &               write1,               ! Unit opened on.
     &               b_flag,               ! Flag (n/a).
     &               code )                ! Returned condition (n/a).
c
c   open and make sure it is empty
c
             call sei open( unknown$,      ! Open file (default=stop on error)
     &                  ' ',              ! Prompt (n/a).
     &                  'index.out',      ! Filename.
     &                  write3,           ! Unit opened on.
     &                  b_flag,           ! Flag (n/a).
     &                  code )            ! Returned condition (n/a).
             call sei close(delete$,write3,code)  ! delete
             call sei open( unknown$,      ! Open file (default=stop on error)
     &                  ' ',              ! Prompt (n/a).
     &                  'index.out',      ! Filename.
     &                  write3,           ! Unit opened on.
     &                  b_flag,           ! Flag (n/a).
     &                  code )            ! Returned condition (n/a).
      endif
C
C   GET SELECTON CRITERIA
C

         CALL SELCRIT(STARTTIME,ENDTIME,basename,basetype,
     *   choise_file,narg)
c
c   open file with waveform file names
c
       call sei open( unknown$,         ! Open file (default=stop on error)
     &                ' ',              ! Prompt (n/a).
     &                'waveform_names.out',   ! Filename.
     &                write4,           ! Unit opened on.
     &                b_flag,           ! Flag (n/a).
     &                code )            ! Returned condition (n/a).
C
C     INPUT IS NORDIC COMPACT FILE OR NORDIC FILE
C
      if(inputoption.eq.2) then
c
c   find if compact or not
c
          call nortype(read1,compact)
          if(compact) THEN
             write(6,*)
             write(6,*)' File type is compact'
             write(6,*)
          endif
          GOTO 10
      endif


C---------------------------------------------------------------------
C  MAIN READING LOOP STARTS HERE 
C---------------------------------------------------------------------
c
10    CONTINUE
      nstat=0
C
C    CAT DATA BASE
C
      IF(INPUTOPTION.EQ.1) THEN
         call epibase(basename,starttime,endtime,
     *   nstat,nphase,nhead,nrecord,distanceid,exp,data,id,nstatus,
     *   compact,nout,ncat_files,cat_files)
         IF(NSTATUS.EQ.1) GOTO 999
      ENDIF	  
C
C   single file
C
      IF(INPUTOPTION.EQ.2)THEN	
         if(compact) then
            nhead=1
            read(read1,'(a80)',iostat=code ) data(1) ! Read record.
            call sei code(fort$,                     ! Stop on error.
     &                    code,                      ! Condition code.
     &                    read1,                     ! For fortran unit.
     &                    b_flag )                   ! Flag end of file.
            if( b_flag ) goto 999                    ! End of file, skip.
            DISTANCEID=DATA(1)(22:22)
            NRECORD=1
         else
            CALL INDATA(read1,nstat,NPHASE,NHEAD,NRECORD, !
     *      DISTANCEID,EXP,DATA,ID)
c            write(6,*)DATA(1)
            if(nrecord.eq.0) goto 999
         endif
      ENDIF

c
c  s-file data base
c

      if(inputoption.eq.3) then
         key=' '        ! always use next event
         CALL findevin                                                       
     *   (basename,starttime,endtime,key,0,
     *   event_no,evfile,fstart,new_month,status)                                 
         if(status.eq.0) then                                                     
            nrecord=-1
            open(97,file=evfile,status='unknown')
            call indata(97,nstat,nphase,nhead,nrecord,
     *      distanceid,exp,data,id)
            close(97)
         else
            goto 999
         endif
      endif
 
c
c	  
C------------------------------------------------------------------------
C   HERE STARTS EVENT CHECKING
C------------------------------------------------------------------------
C
C   CHECK FOR INFO IN HEADERS
C
      data(1)(80:80)='1'       ! older data might not have a 1 in first line
      if(header_check) then    ! find if all header are checked
         n_header_check=nhead
      else
         n_header_check=1
      endif
      do i=1,n_header_check
         if(data(i)(80:80).eq.'1') then
            CALL EPISELEC(DATA(i),start_of_time,end_of_time)
            if(accepted) goto 6968    ! jump out of loop if selected
         endif
      enddo
 6968 continue
c
c   if end of time, no more data input unless a single file is used
c   and the data is mixed up chronologically
c
      if(end_of_time.and.inputoption.eq.2) goto 10
      if(end_of_time) goto 999
c
c   if not yet at start of time interval, get next event
c
      if(start_of_time) goto 10
C
C   EVENT COUNTING only for events within time interval
C
      NEVENT=NEVENT+1
C
C   COUNT LOCAL EVENTS
C	  			
      IF(DISTANCEID.EQ.'L'.OR.DISTANCEID.EQ.' ') THEN
          IF(DISTANCEID.EQ.'L') NLOCAL=NLOCAL+1
      ENDIF
C	  	  	
C  COUNT REGIONAL  EVENTS
C
      IF(DISTANCEID.EQ.'R') NREGIONAL=NREGIONAL+1	
C
C   COUNT DISTANT EVENTS
C
      IF(DISTANCEID.EQ.'D') NDISTANT=NDISTANT+1
c
c   check for gap
c
      if(accepted) then
      if(mingap.ne.0.0.or.maxgap.ne.360.0) then
         igap=-1                ! initailly no gap
         accepted=.false.
         if(.not.compact) then
            do i=1, nhead
              if(data(i)(80:80).eq.'E'.and.data(i)(2:4).eq.'GAP') 
     *           then
                 read(data(i)(6:8),'(i3)') igap
                 if(float(igap).le.maxgap.and.float(igap).ge.mingap)
     *           accepted=.true.
              endif
            enddo
         endif
      endif
      endif

c
c check for volcanic subclass
c
      if (accepted) then
        if (seiclen(volcanictype(1)).gt.0) then
          accepted=.false.
          do i=1,nhead
            if (data(i)(1:10).eq.' VOLC MAIN') then
              do j=1,10
                if (data(i)(12:17).eq.volcanictype(j)) then
                  accepted=.true.
                endif
              enddo          
            endif
          enddo
        endif
      endif
C
C   CHECK FOR REQUIRED STATIONS IF WANTED, AT LEAST ONE OF STATIONS IN
C   STATSELECT MUST BE PRESENT TO SELECT EVENT, skip if compact file
C
C  CHECK IF DEFAULT OR ALL STATIONS INCLUDED, ELSE CHECK WHICH STATION
c  also check distance range. If no distance, reject station
C
      if(accepted) then
      STATIONOK=1
c     write(6,*)'nstat=',nstat,' stat_pr',stat_present
      IF(.not.compact.AND.STAT_present.GT.0) THEN
         STATIONOK=0
         if(nstat.ge.0) then
            DO I=1,STAT_PRESENT
                DO J=NHEAD+1,NRECORD-1
                   READ(DATA(J),'(1X,A7)') STATIONCODE
                   if(data(j)(71:75).ne.' ') then
                       read(data(j)(71:75),'(f5.0)') dist
                   else
                       dist=-1   ! indicate no distance available
                   endif
c
c   case of both station and component  and phase
c
c
c
c   if hypocentral distance, calculate here
c
                   if(hyp_dist) then
c                     write(88,*) dist,depth
                      if(dist.gt.-0.1) dist=sqrt(dist*dist+depth*depth)
c                     write(88,*) dist
                   endif
c
c   case of station and component
c
                   IF( statselect(i)(1:5).ne.'     '.and.
     *                 statselect(i)(6:7).ne.'  '   .and.
     *                 STATSELECT(I).EQ.STATIONCODE .and.
     *                 ((dist.ge.mindist(i).and.dist.le.maxdist(i))
     *                  .or.dist.lt.0).
     *                 and.((data(j)(11:14).eq.stat_phase(i).and.
     *                 stat_phase(i).ne.' ').or.(stat_phase(i).eq.
     *                 '____'.and.data(j)(11:14).eq.' ')
     *                 .or.stat_phase(i).eq.' ')) then
                          STATIONOK=stationok+1
                          goto 1616             ! only count first occurrence
                   endif
c
c   case of only station
c
                   IF( statselect(i)(1:5).ne.'     '.and.
     *                 statselect(i)(6:7).eq.'  '   .and.
     *                 STATSELECT(I)(1:5).EQ.STATIONCODE(1:5).and. 
     *                 ((dist.ge.mindist(i).and.dist.le.maxdist(i))
     *                  .or.dist.lt.0).
     *                 and.((data(j)(11:14).eq.stat_phase(i).and.
     *                 stat_phase(i).ne.' ').or.(stat_phase(i).eq.
     *                 '____'.and.data(j)(11:14).eq.' ')
     *                 .or.stat_phase(i).eq.' ')) then

                          STATIONOK=stationok+1
                          goto 1616
                   endif
c
c   case of only component
c
                   IF( statselect(i)(1:5).eq.'     '.and.
     *                 statselect(i)(6:7).ne.'  '   .and.
     *                 STATSELECT(I)(6:7).EQ.STATIONCODE(6:7).and.
     *                 ((dist.ge.mindist(i).and.dist.le.maxdist(i))
     *                  .or.dist.lt.0).
     *                 and.((data(j)(11:14).eq.stat_phase(i).and.
     *                 stat_phase(i).ne.' ').or.(stat_phase(i).eq.
     *                 '____'.and.data(j)(11:14).eq.' ')
     *                 .or.stat_phase(i).eq.' ')) then
                          STATIONOK=stationok+1
                          goto 1616
                   endif
                enddo
 1616           continue
            enddo
         endif
      ENDIF
c
c   case of all stations and components must be present
c
      IF(all_stat.and.STATIONOK.NE.stat_present)  ACCEPTED = .FALSE.
c
c   case of any one of stations and components must be present
c
      IF(.not.all_stat.and.STATIONOK.eq.0      )  ACCEPTED = .FALSE.
c
      endif
c
c  polarity
c
       if (accepted) then
          if (.not. compact .and. mnupol .gt. 0) then
              cnupol = 0
              do j = 1,nrecord
                 if ((data(j) (80:80) .eq. ' ' .or. 
     *               data(j) (80:80) .eq. '4').and.
     *               data(j)(11:11).eq.'P') then
                     if (data(j) (17:17) .eq. 'C' .or.
     *                   data(j) (17:17) .eq. 'D') 
c    *                   data(j) (17:17) .eq. '-' .or.
c    *                   data(j) (17:17) .eq. '+') 
     *                   cnupol = cnupol + 1
                 end if
              end do
              if (cnupol .lt. mnupol) accepted = .false.
          end if
      end if

c
c------------------------------------------------------------
c  phases
c------------------------------------------------------------
c
        if (accepted) then
           if (phase(1).ne.' ') then
              do j = nhead+1,nrecord-1
                  do k=1,6
                     if((data(j)(11:14).eq.phase(k).and.
     *               phase(k).ne.' ').or.
     *               (data(j)(11:14).eq.' '.and.phase(k).eq.'____'))
     *               goto 3746
                   enddo
              end do
              accepted=.false.  ! went through whole loop without finding phase
 3746         continue
            end if
        end if

      fpsolutf = .false.
      eqfeltf = .false.
      helatf = .false.
      helonf = .false.
      hedepthf = .false.
      if (accepted) then
          if (.not. compact .and. (minhelat .ne. 0.0 .or. 
     *        maxhelat .ne. 99999.)) then
              do j = 1,nrecord
                 if (data(j) (80:80) .eq. 'E' .or.
     *               data(j) (80:80) .eq. 'e') then
                     read (data(j) (24:30),'(f7.0)') filevar
                     if (filevar .ge. minhelat .and.
     *                   filevar .le. maxhelat) then
                         helatf = .true.
                     end if
                 end if
              end do
              if (.not. helatf) accepted = .false.
          end if
      end if
      if (accepted) then
          if (.not. compact .and. (minhelon .ne. 0. .or. 
     *        maxhelon .ne. 99999.)) then
              do j = 1,nrecord
                 if (data(j) (80:80) .eq. 'E' .or.
     *               data(j) (80:80) .eq. 'e') then
                     read (data(j) (31:38),'(f8.0)') filevar
                     if (filevar .ge. minhelon .and.
     *                   filevar .le. maxhelon) then
                         helonf = .true.
                     end if
                 end if
              end do
              if (.not. helonf) accepted = .false.
          end if
      end if
      if (accepted) then
          if (.not. compact .and. (minhedepth .ne. -99 .or. 
     *        maxhedepth .ne. 99999.0)) then
              do j = 1,nrecord
                 if (data(j) (80:80) .eq. 'E' .or.
     *               data(j) (80:80) .eq. 'e') then
                     read (data(j) (39:43),'(f5.0)') filevar
                     if (filevar .ge. minhedepth .and.
     *                   filevar .le. maxhedepth) then
                         hedepthf = .true.
                     end if
                 end if
              end do
              if (.not. hedepthf) accepted = .false.
          end if
      end if
      if (accepted) then
          if (.not. compact .and. fpsolut) then
              do j = 1,nrecord
                 if (data(j) (80:80) .eq. 'F' .or.
     *               data(j) (80:80) .eq. 'f') then 
                    fpsolutf = .true.
                 end if
              end do
              if (.not. fpsolutf) accepted = .false.
          end if
      end if
      if (accepted) then
          if (.not. compact .and. eqfelt) then
              do j = 1,nrecord
                 if (data(j) (80:80) .eq. '2') then
                     eqfeltf = .true.
                 end if
              end do
              if (.not. eqfeltf) accepted = .false.
          end if
      end if
c
c   wave form file names
c
      if (accepted) then
          if (.not.compact.and.wave_check.ne.' ') then
              wave=.false.
              k=sei clen(wave_check)
              do j = 2,nhead
                 if (data(j) (80:80) .eq. '6') then
                    if(wave_check(1:1).eq.'*') then ! any wave form
                       wave=.true.
                    else      ! loook for part of string
                       read(data(j)(2:79),'(a)') text    ! wave form name
                       do i=1,sei clen(text)-k+1
                         if(text(i:i+k-1).eq.wave_check(1:k))wave=.true.
                       enddo
                    endif
                 end if
              end do
              if (.not. wave) accepted = .false.
          end if
      end if


C
C
C   WRITE OUT EVENT IF SELECTED
C
      IF (ACCEPTED)THEN
C
C   FIND WAVEFORM FILE NAMES IF A WHOLE FILE IS USED
C
         IF(.not.compact) THEN
            DO I=2,NHEAD
               IF(DATA(I)(80:80).EQ.'6') THEN
               K=INDEX(DATA(I)(2:79),' ')
C
               write(write4,'(i5,2x,A)',iostat=code)
     *         nwave,DATA(I)(2:k)
               call sei code(fort$,              ! stop on error.
     &                       code,               ! Error condition.
     &                       write4,             ! For fortran unit.
     &                       b_flag )            ! Flag (n/a).
c
               NWAVE=NWAVE+1
               ENDIF
            ENDDO
         ENDIF	  
C
         write(write1,'(A80)',iostat=code)(DATA(I),I=1,NRECORD)
         call sei code(fort$,                    ! stop on error.
     &                 code,                     ! Error condition.
     &                 write1,                   ! For fortran unit.
     &                 b_flag )                  ! Flag (n/a).
c
c  if input from data base, both compact and full nordic files can
c  be input, therefore always have a blank line between events
c
         if(compact.and.inputoption.eq.1)
     &   write(write1,'(a5)',iostat=code)'     '
         call sei code(fort$,                    ! stop on error.
     &                 code,                     ! Error condition.
     &                 write1,                   ! For fortran unit.
     &                 b_flag )                  ! Flag (n/a).
c
c   if seisweb option, also make a compact file
c
         if(seisweb) then
            write(write5,'(a80)',iostat=code) data(1)
         endif
C
C   COUNT SELECTED EVENTS AND WRITE INDEXES IF id is PRESENT 
c   if input is not from data base, no data base reference
c   can be made
C
         NOUT=NOUT+1		
         IF(.not.compact)THEN
            if(id.ne.0) then
               nid=nid+1
               read(data(id)(61:74),'(i4,5i2)') 
     *         year,month,day,hour,minutes,isec
               call sfilname
     *         (year,month,day,hour,minutes,isec,basename(1:5),
     *          distanceid,sfile,k)
C
               if(seisweb) then
                  write(write3,'(a)') sfile(1:k)
               else
                  if(inputoption.ne.2) then   ! only write out if from data base
                    write(write3,'(I5,2X,A)',iostat=code) !
     &              NID,SFILE(1:k)                  !
                    call sei code(fort$,               ! stop on error.
     &                       code,                   ! Error condition.
     &                       write3,                 ! For fortran unit.
     &                       b_flag )                ! Flag (n/a).
                  endif
               endif
            endif
         ENDIF
      ENDIF

998   CONTINUE

C
C   BACK TO GET NEXT EVENT
C
      id=0
      GO TO 10		
c
C-------------------------------------------------------------------
C   FINISHED, WRITE OUT STATISTICS
C-------------------------------------------------------------------
999   CONTINUE
c
c   write last file statisitcs if from epibase
c
      if(inputoption.eq.1.and.nstatus.ne.1) then
         nstatus=-1
         call epibase(basename,starttime,endtime,
     *   nstat,nphase,nhead,nrecord,distanceid,exp,data,id,nstatus,
     *   compact,nout,ncat_files,cat_files)
      endif

      write(6,*)' '
      WRITE(6,*)' TOTAL NUMBER OF EVENTS IN TIME INTERVAL ',NEVENT
      WRITE(6,*)' NUMBER OF DISTANT EVENTS   - - - - -    ',NDISTANT
      WRITE(6,*)' NUMBER OF REGIONAL EVENTS  - - - - -    ',NREGIONAL
      WRITE(6,*)' NUMBER OF LOCAL EVENTS     - - - - -    ',NLOCAL
      write(6,*)' ---------------------------------------------------'
      WRITE(6,*)' NUMBER OF EVENTS SELECTED ************* ',NOUT
      WRITE(6,*)' NUMBER OF WAVEFORM FILES SELECTED       ',NWAVE
      write(6,*)' NUMBER OF INDEXES SELECTED              ',NID
      WRITE(6,*)' SELECTED EARTHQUAKES ARE IN FILE: select.out '
      WRITE(*,*)' LOCAL INDEX FILE IN:              index.out'
      WRITE(6,*)
     *' NAMES FOR WAVEFORM FILES IN FILE: waveform_names.out'
      write(6,*)' SELECT COMMANDS IN FILE:          select.inp'
      write(6,*) ' '
c
c   message for seisweb
c
      if(seisweb) then
         write(6,*)  'select_terminated: ok ',nout 
      endif

      STOP
      END
C -------------------------------------------------------------------
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     ROUTINE INQUIRES EPICENTER SELECTION CRITERIA
C     AND RETURN THESE PARAMETERS TO CALLING PROGRAM
C     PARAMETERS TO RETURN IN COMMON BLOCK: EPICRITE , EPICRIT2
C                                           EPICRIT3 AND EPICRIT4
C     THE ROUTINE IS INTENDED TO BE USED TOGETHER WITH
C     ROUTINE EPISELECT AND ROUTINE INDATA
C     WRITTEN BY: C. LINDHOLM
C     MODIFIED BY J. HAVSKOV TO INCLUDE STATION SELECTION and a lot more
C     LAST REVISED:  AUGUST 18, 1987
c                    may -89. Poosibility to run on database facilitated c.l.
C     CHANGED:       1990-01-30, R.N.ARVIDSSON TO PC-DOS.
C     LAST REVISED:  1990-01-30, RNA, COMMON BLOCK STRUCTURE.
C     LAST REVISED:  1990-02-01, RNA, INPUT OF YYYMMDDHHMM CHANGED.
C                    1990-02-16, RNA, COMMON BLOCK STRUCTURE.
C                    1990-04-27, JH,  SPECIAL SEISNOR STATION Q REMOVED
C                    1991-04-03, CL,  FACILITATE USE OF BLANK ENDTIME
C                    1991-19-09  JH   MAJOR CLEANUP WITH START AND STOP TIMES
C                    OCT 91           MORE CLEANUP
C
C     OUTPUT: ALL PARAMETERS IN COMMON BLOCK:'CRITERIA'
C             TIME1,TIME2 :  TIME-LIMITS
C             HILON,LOLON,HILAT,LOLAT: LONGITUDE/LATITUDE -LIMITS
C             MINSTATION: MINIMUM NUMBER OF STATIONS
C             MAXSTATION: MAXIMUM NUMBER OF STATIONS
C             MINMAG,MAXMAG: MAGNITUDE LIMITS
C             MINDEPTH,MAXDEPTH: DEPTH LIMITS
C             MINRMS: MINIMUM RMSVALUE
C             MAXRMS: MAXIMUM RMSVALUE
c             minhelat, maxhelat: hypocenter error lat limits
c             minhelon, maxhelon: hypocenter error long limits
c             minhedepth, maxhedepth: hypocenter error depth limits
C             DEFAULT: LOGICAL WITH VALUE=.TRUE. IF NO SELECTION
C                                         -PARAMETERS ARE SET
C             STAT_present:  NUMBER OF STATIONS THAT MUST BE PRESENT
C                      IF ZERO, NO IMPORTANCE
C             hypa_present:  NUMBER OF HYPOCENTER AGENCIES THAT MUST BE PRESENT
C                      IF ZERO, NO IMPORTANCE
C             maga_present:  NUMBER OF MAGNITUDE AGENCIES THAT MUST BE PRESENT
C                      IF ZERO, NO IMPORTANCE
C             STATSELECT: STATIONS WHICH MUST BE PRESENT TO SELECT EVENT
C             HYPASELECT: HYPOCENTER AGENCIES WHICH MUST BE PRESENT
C             MAGASELECT: MAGNITUDE AGENCIES WHICH MUST BE PRESENT
C     

		
c-this subroutine reads the starttime and endtime for the selction
c-from the database and calls the subroutine which shows the screen
c-with the opitions to be changed.
c
      subroutine selcrit(starttime,endtime,basename,basetype,
     *choise_file,narg)
      implicit none
      include 'seidim.inc'
      include 'libsei.inc'
      character*14 starttime, endtime,stime
      character*6 basetype  ! type of data base, CAT or SFILES
      character*80 choise_file  ! file with choises, if blank, no file
c  start time and end time inc. century
c  abs times
      double precision time1,time2,timcen
c  century
      integer cen1,cen2,month,day,year
c  number of stations to be present
      integer           stat_present
      integer           narg         ! number of arguments
      logical       all_stat         ! if true,  all must be present
c  number of hypocenter agencies to be present
      integer           hypa_present
c  number of magnitude agencies to be present
      integer           maga_present
      logical default
      character*80 option
      real minmag, minrms, maxrms, hilat, lolat, hilon, lolon, maxmag,
     *     mindepth, maxdepth,maxgap,mingap,
     *     minhelat, maxhelat,
     *     minhelon, maxhelon,
     *     minhedepth, maxhedepth
      integer minstation, maxstation, i
      character*1 eventtype(5), disttype(5), magtypes(5)
      character*7 statselect(50)
      character*4 stat_phase(50)
      integer mindist(50),maxdist(50)  ! distance range for station	
      character*3 hypaselect(10), magaselect(10)
      character*80 basename      ! data base of file name of input
c   fault plane solution
      logical fpsolut
c   earthquake felt
      logical eqfelt
      character*40 wave_check    ! string to identify wave form file name
      character*80 text
      logical header_check
      real ypol(max_polyn$,2)    ! array defining polygon
      integer iant               ! number of points of the polygon
      integer mnupol             ! minumum number of polarities
      integer w1                 ! file unit
      integer code               ! for sei open
      logical hyp_dist           ! if true, use hypocentral distance
      logical b_flag             ! ------------
      character*4 phase(6)       ! phase names to select
      character*6 volcanictype(10)   ! volcanic subclasses

      common/epicrite/hilat,lolat,hilon,
     *                lolon,minmag,maxmag,minrms,maxrms,mindepth,
     *                maxdepth,minhelat,maxhelat,minhelon,maxhelon,
     *                minhedepth,maxhedepth,ypol,iant,mnupol
      common/epicrit2/fpsolut,eqfelt,statselect
      common/epicrit1/mindist,maxdist,
     *                hypaselect,magaselect 
      common/epicrit3/default,eventtype,disttype,magtypes,volcanictype
      common/epicrit4/minstation,maxstation,stat_present,hypa_present,
     *                maga_present,header_check,wave_check
      common/epicrit5/time1,time2,timcen,all_stat,mingap,maxgap,phase,
     *                stat_phase,hyp_dist

      option(1:3) = '000'

c
c   if input of choises is from a file, open and read from that file
c
       if(choise_file.ne.' ') then
c
c   read choises
c
      call sei open( unknown$,             ! Open file (default stop on error).
     &               ' ',                  ! Prompt (n/a).
     &               choise_file,         ! Filename.
     &               w1,                   ! Unit opened on.
     &               b_flag,               ! Flag (n/a).
     &               code )                ! Returned condition (n/a).
      read(w1,'(31x,1x,a)')  text          ! is base name, read before
      read(w1,'(31x,1x,a)') basetype
      read(w1,'(31x,1x,a)')  starttime     
      read(w1,'(31x,1x,a)') endtime
      read(w1,'(31x,i15)')  minstation           
      read(w1,'(31x,i15)')   maxstation         
      read(w1,'(31x,f15.3)') lolat
      read(w1,'(31x,f15.3)') hilat               
      read(w1,'(31x,f15.3)') lolon
      read(w1,'(31x,f15.3)') hilon  
      read(w1,'(31x,f15.3)') minmag   
      read(w1,'(31x,f15.3)') maxmag   
      maga_present=0
      hypa_present=0
      read(w1,'(31x,1x,10a3)')  magaselect
      read(w1,'(31x,1x,10a3)')  hypaselect
      do i=1,10
        if(magaselect(i).ne.'   ') maga_present=maga_present+1
        if(hypaselect(i).ne.'   ') hypa_present=hypa_present+1
      enddo
      read(w1,'(31x,f15.3)') minrms 
      read(w1,'(31x,f15.3)') maxrms
      read(w1,'(31x,f15.3)') mindepth   
      read(w1,'(31x,f15.3)') maxdepth 
      read(w1,'(31x,f15.3)') minhelat
      read(w1,'(31x,f15.3)') maxhelat
      read(w1,'(31x,f15.3)') minhelon 
      read(w1,'(31x,f15.3)') maxhelon 
      read(w1,'(31x,f15.3)') minhedepth 
      read(w1,'(31x,f15.3)') maxhedepth
      read(w1,'(31x,1x,5a1)')magtypes
      read(w1,'(31x,1x,5a1)')disttype
      read(w1,'(31x,1x,5a1)')eventtype
      read(w1,'(31x,i15)')   mnupol           
      read(w1,'(31x,14x,l1)')eqfelt 
      read(w1,'(31x,14x,l1)')fpsolut 
      read(w1,'(31x,14x,l1)')header_check 
      read(w1,'(31x,1x,a)')  wave_check
      read(w1,'(31x,f15.3)') mingap
      read(w1,'(31x,f15.3)') maxgap
      read(w1,'(31x,1x,6a4)')   phase
      read(w1,'(31x,1x,10a6)') volcanictype
      read(w1,'(a)') text                      ! explanation line
      read(w1,'(31x,13x,2l1)') all_stat,hyp_dist        
c
c   read and find how many stations present
c
      
      do i=1,9999
         read(w1,'(1x,a7,2i7,1x,a4)')statselect(i),mindist(i),
     *   maxdist(i),
     *   stat_phase(i)
         if(statselect(i).eq.'       ') goto 2999
      enddo
 2999 continue
      stat_present=i-1
c
      read(w1,'(a)') text                      ! explanation line
c      write(6,*) basename
c      write(6,'(1x,a,a)') starttime,endtime
      do i=1,9999
        read(w1,'(2f10.3)',end=9876) ypol(i,2),ypol(i,1)
      enddo
 9876 continue
      iant=i-1

c
c      write(6,*)' max',maxhedepth
      call sei close(close$,w1,code ) ! Close but stop on error.
      endif


C
C     NOW INQUIRE BOUNDARY VALUES
C

 111   continue
       if(choise_file.eq.' '.and.narg.lt.3) then
          write(6,'(1x,a,$)')  
     *  ' Start time (blank is 1980), yyyymmddhhmmss:'
          read(5,'(a14)') starttime
          if(starttime.eq.' ') then
             write(6,'(1x,a,$)')
     *     ' End time, enter for  2015                 :'
          else 
             write(6,'(1x,a,$)')
     *  ' End time, enter for end of month          :'
          endif
          read(5,'(a14)') endtime
       endif
c
c   if start time has ny year, put in 1980
c
       if(starttime(1:4).eq.' ') then
          starttime(1:4)='1980'
          if(endtime(1:4).eq.' ') endtime(1:4)='2015'
       endif
c
c   if start time has no month, put in january
c
      if(starttime(5:6).eq.'  ') starttime(5:6)='01'
      do i=7,14
        if(starttime(i:i).eq.' ') starttime(i:i)='0'
      enddo
c
c   if end time year is blank, must be to end of month, put in
c   same year-month as start time
c
c-- end of month
      if(endtime(1:4).eq.'    ')  endtime(1:6)=starttime(1:6)
c
c   make sure end time is to end of month, day etc if left blank
c
      if(endtime(5:6).eq.'  ') endtime(5:6)='12'
      if(endtime(7:8).eq.'  ') then
         read(endtime(1:6),'(i4,i2)') year,month
         call month_day(year,month,day)
         write(endtime(7:8),'(i2)') day
         if(endtime(7:7).eq.' ') endtime(7:7)='0'
      endif
      if(endtime(9:10).eq.'  ') endtime(9:10)='23'
      if(endtime(11:12).eq.'  ' ) endtime(11:12)='59'
      if(endtime(13:14).eq.'  ') endtime(13:14)='59'
ctest      write(6,*) endtime
c
c   get century
c
         read(starttime,'(i2)') cen1
         read(endtime, '(i2)') cen2
c
c   check if time interval is valid, get abs time from 1900 if time later
c   then 1900
c
CC2000   if(cen1.lt.19) then
            stime=starttime
            stime(1:2)='19'      ! make sure calculation goes from 1900,
            call abstim(stime,0,time1)    ! - century corrected for below
CC       else
CC          call abstim(starttime,0,time1)
CC       endif
c
CC       if(cen2.lt.19) then
            stime=endtime
            stime(1:2)='19'
            call abstim(stime,0,time2)
CC       else
CC          call abstim(endtime,0,time2)
CC       endif
ctest            WRITE(6,'(a,a)') STARTTIME,ENDTIME
ctest            WRITE(6,*) TIME1,TIME2
c
c   add century
c
         call abstim('19991231235960',0,timcen)  ! time of one century
         time1=time1+cen1*timcen
         time2=time2+cen2*timcen
ctest            write(6,*) 'C1,C2,TC,T1,T2', CEN1,CEN2,TIMCEN,TIME1,TIME2
c
c   check interval
c
         if(time1.ge.time2) then
            write(6,*)' ********* wrong time interval *************'
c            if(choise_file.ne.' ') then
               stop
c           else
c              goto 111
c           endif
         endif
c
c   return if input from choise file or argument string
c
         if(choise_file.ne.' '.or.narg.gt.2) return
c
c-calling the subroutine which draws the screen with options
c
         call draw_screen(option)

c-if enter, default is choosen
         if (option(1:1).eq.' ') then
            default = .true.
         end if

      do while (option(1:3) .ne. '000')

      if (option(1:3) .eq. '1  ' .or. option(1:3) .eq. '2  ' .or.
     *    option(1:3) .eq. '3  ' .or. option(1:3) .eq. '4  ' .or.
     *    option(1:3) .eq. '5  ' .or. option(1:3) .eq. '6  ' .or.
     *    option(1:3) .eq. '7  ' .or. option(1:3) .eq. '8  ' .or.
     *    option(1:3) .eq. '9  ' .or. option(1:3) .eq. '10 ' .or.
     *    option(1:3) .eq. '11 ' .or. option(1:3) .eq. '12 ' .or.
     *    option(1:3) .eq. '13 ' .or. option(1:3) .eq. '14 ' .or.
     *    option(1:3) .eq. '15 ' .or. option(1:3) .eq. '16 ' .or.
     *    option(1:3) .eq. '17 ' .or. option(1:3) .eq. '18 ' .or.
     *    option(1:3) .eq. '19 ' .or. option(1:3) .eq. '20 ' .or.
     *    option(1:3) .eq. '21 ' .or. option(1:3) .eq. '22 ' .or.
     *    option(1:3) .eq. '23 ' .or. option(1:3) .eq. '24 ') then
         call draw_screen(option)
      else if (option(1:1) .eq. ' ') then 
           option(1:3) = '000'
      else if (option(1:3) .ne. '1  ' .and.
     *         option(1:3) .ne. '2  ' .and.
     *         option(1:3) .ne. '3  ' .and.
     *         option(1:3) .ne. '4  ' .and.
     *         option(1:3) .ne. '5  ' .and.
     *         option(1:3) .ne. '6  ' .and.
     *         option(1:3) .ne. '7  ' .and.
     *         option(1:3) .ne. '8  ' .and.
     *         option(1:3) .ne. '9  ' .and.
     *         option(1:3) .ne. '10 ' .and.
     *         option(1:3) .ne. '11 ' .and.
     *         option(1:3) .ne. '12 ' .and.
     *         option(1:3) .ne. '13 ' .and.
     *         option(1:3) .ne. '14 ' .and.
     *         option(1:3) .ne. '15 ' .and.
     *         option(1:3) .ne. '16 ' .and.
     *         option(1:3) .ne. '17 ' .and.
     *         option(1:3) .ne. '18 ' .and.
     *         option(1:3) .ne. '19 ' .and.
     *         option(1:3) .ne. '20 ' .and.
     *         option(1:3) .ne. '21 ' .and.
     *         option(1:3) .ne. '22 ' .and.
     *         option(1:3) .ne. '23 ' .and.
     *         option(1:3) .ne. '24'        ) then
           option(1:1) = '?'
         call draw_screen(option)
      end if    
      end do
c
c   write out choices
c
      call sei open( unknown$,             ! Open file (default stop on error).
     &               ' ',                  ! Prompt (n/a).
     &               'select.inp',         ! Filename.
     &               w1,                   ! Unit opened on.
     &               b_flag,               ! Flag (n/a).
     &               code )                ! Returned condition (n/a).
      write(w1,'(a,1x,a)')   ' Base or file name            :',
     *basename
      write(w1,'(a,1x,a)')   ' Base type                    :',
     *basetype
      write(w1,'(a,1x,a  )') ' Start time                   :',
     *starttime     
      write(w1,'(a,1x,a)')   ' End time                     :',
     *endtime
      write(w1,'(a,i15)')    ' Minimum number of stations   :',
     *minstation           != 0
      write(w1,'(a,i15)')    ' Maximum number of stations   :',
     *maxstation           != 999
      write(w1,'(a,f15.3)')  ' Minimum latitude             :',
     *lolat                != -90.0 
      write(w1,'(a,f15.3)')  ' Maximum latitude             :',
     * hilat               != 90.0
      write(w1,'(a,f15.3)')  ' Minimum longitude            :',
     *lolon                != -360.0
      write(w1,'(a,f15.3)')  ' Maximum longitude            :',
     * hilon               != 360.0
      write(w1,'(a,f15.3)')  ' Minimum magnitude            :',
     *minmag               != -990.0
      write(w1,'(a,f15.3)')  ' Maximum magnitude            :',
     *maxmag               != +999.0
      write(w1,'(a,1x,10a3)')   ' Magnitude agencies           :',
     *magaselect
      write(w1,'(a,1x,10a3)')   ' Hypocenter agencies          :',
     *hypaselect
      write(w1,'(a,f15.3)')  ' Minimum rms                  :',
     *minrms               != 0
      write(w1,'(a,f15.3)')  ' Maximum rms                  :',
     *maxrms               != 999.0
      write(w1,'(a,f15.3)')  ' Minimum depth                :',
     *mindepth             != -99.0
      write(w1,'(a,f15.3)')  ' Maximum depth                :',
     *maxdepth             != 99999.0 
      write(w1,'(a,f15.3)')  ' Minimum error in latitude    :',
     *minhelat              != .0
      write(w1,'(a,f15.3)')  ' Maximum error in latitude    :',
     *maxhelat              != 99999.0
      write(w1,'(a,f15.3)')  ' Minimum error in longitude   :',
     *minhelon             != .0
      write(w1,'(a,f15.3)')  ' Maximum error in longitude   :',
     *maxhelon              != 99999.0
      write(w1,'(a,f15.3)')  ' Minimum error in depth       :',
     *minhedepth            != -99.0
      write(w1,'(a,f15.3)')  ' Maximum error in depth       :',
     *maxhedepth            != 99999.0
      write(w1,'(a,1x,5a1)') ' Magnitude types (L,C,B,S,W)  :',
     *magtypes
      write(w1,'(a,1x,5a1)') ' Distance (ID) types (L,R,D)  :',
     *disttype
      write(w1,'(a,1x,5a1)') ' Event types (e.g. E,V,P)     :',
     *eventtype

      write(w1,'(a,i15)')    ' Minimum number of polarities :',
     *mnupol           
c      default = .false.
c      fpsolut = .false.
      write(w1,'(a,14x,l1)') ' Felt earthquakes             :',
     *eqfelt 
      write(w1,'(a,14x,l1)') ' Fault plane solution         :',
     *fpsolut 
      write(w1,'(a,14x,l1)') ' Check all header lines       :',
     *header_check 
      write(w1,'(a,1x,a)')   ' Waveform files to check      :',
     *wave_check
      write(w1,'(a,f15.3)')  ' Minimum gap                  :',
     *mingap               != 0
      write(w1,'(a,f15.3)')  ' Maximum gap                  :',
     *maxgap               != 999.0
      write(w1,'(a,1x,6a4)') ' Phases                       :',
     *phase
      write(w1,'(a,1x,10a6)')' Volcanic subclasses          :',
     *volcanictype
      write(w1,'(a,a)') 
     *' Stat., comp. dist range, phase (1x,a5,a2,2i7,1x,a4)',
     *' one pr line, end blank line:'
      write(w1,'(a,2l1)') 
     *' STAT CO Mindis Maxdis Phas All stat hdist->',
     * all_stat,hyp_dist
      if(stat_present.gt.0) then
         do i=1,stat_present
           write(w1,'(1x,a7,2i7,1x,a4)')statselect(i),mindist(i),
     *                                  maxdist(i),stat_phase(i)
         enddo
      endif
      write(w1,*)
      write(w1,'(a,a)')        ' Polygon points (lat,lon), one pair pr',
     *' line, end with blank line :'
      do i=1,iant
        write(w1,'(2f10.3)') ypol(i,2),ypol(i,1)
      enddo

      return
      end 
   

 
c-this subroutine checks which option was selected and makes
c-all the questions necessaries for the selection depending of
c-the option. By CARLOS EDUARDO VIEIRA
      subroutine draw_screen(option)
c
      implicit none
      include 'seidim.inc'
      include 'libsei.inc'
      real minmag, maxmag         ! minimum and maximum magnitude
      real lolat, hilat           ! lower and upper latitude
      real lolon, hilon           ! lower and upper longitude
      real mindepth, maxdepth     ! minimum and maximum depth
      real minrms                 ! minimum rms
      real maxrms                 ! maximum rms
      real maxgap,mingap          ! gap range
      integer minstation          ! minimum number of stations
      integer maxstation          ! maximum number of stations
      real minhelat               ! minimum hypocenter error lat
      real maxhelat               ! maximum hypocenter error lat
      real minhelon               ! minimum hypocenter error long
      real maxhelon               ! maximum hypocenter error long
      real minhedepth             ! minimum hypocenter error depth
      real maxhedepth             ! maximum hypocenter error depth
      logical fpsolut             ! fault plane solution
      logical eqfelt              ! earthquake felt
      character*1 eventtype(5)    ! event id
      character*1 disttype(5)     ! distance id
      character*1 magtypes(5)     ! magnitude type
      character*7 statselect(50)  ! station code
      character*4 stat_phase(50)  ! phase to select with station
      integer mindist(50),maxdist(50)  ! distance range for station	
      character*3 hypaselect(10)  ! hypocenter agencies
      character*3 magaselect(10)  ! magnitude agencies
      character*80 option         ! option
      integer stat_present        ! number of stations codes
      logical       all_stat         ! if true,  all must be present
      integer hypa_present        ! number of hypocenter agencies
      integer maga_present        ! number of magnitude agencies
      real ypol(max_polyn$,2)     ! array defining polygon
      integer iant                ! number of points of the polygon
      integer idist               ! indicator if distances requred
      integer mnupol              ! minumum number of polarities
      integer status, statusaux   ! iostatus
      character*1 eventtypet(5)   ! aux screen for event id
      character*1 disttypet(5)    ! aux screen for distance id
      character*1 magtypest(5)    ! aux screen for magnitude type
      character*80 reading        ! aux for read integer/real variable
      character*3 minstationa     ! aux char for minimum number of stations
      character*3 maxstationa     ! aux char for maximum number of stations
      character*4 minrmsa         ! aux char for minimum rms
      character*4 maxrmsa         ! aux char for maximum rms
      character*5 mindeptha, maxdeptha ! aux char for min and max depth
      character*6 minmaga, maxmaga ! aux char for min and max magnitude
      character*7 lolata, hilata  ! aux char for lower and upper latitude
      character*8 lolona, hilona  ! aux char for lower and upper longitude
      character*8 maxgapa, mingapa  ! aux char for lower and upper gap
      character*5 minhedeptha     ! aux char for minimum hypocenter error depth
      character*5 maxhedeptha     ! aux char for maximum hypocenter error depth
      character*7 minhelata       ! aux char for minimum hypocenter error lat
      character*7 maxhelata       ! aux char for maximum hypocenter error lat
      character*8 minhelona       ! aux char for minimum hypocenter error long
      character*8 maxhelona       ! aux char for maximum hypocenter error long
      character*5 mnupola         ! aux char minumum number of polarities
      integer stcodes             ! status codes
      integer count               ! counter for blank input
      integer index, inde1,       
     *        inde2, inde3        ! aux index
      character*1 fpsolutin       ! reading for ftpsolut
      character*1 eqfeltin        ! reading for eqfelt
      character*40 wave_check    ! string to identify wave form file name
      logical header_check        ! checking all headers
      logical found               ! aux for loop
      logical default             ! Previously undefined (JAB).
      integer ind                 ! Indicator            (JAB).
      integer  i,code
      logical hyp_dist           ! if true, use hypocentral distance

      character*4 phase(6)       ! phase names to select
      character*6 volcanictype(10)   ! volcanic subclasses
      integer seiclen

      double precision time1,time2,timcen
C
      common/epicrite/hilat,lolat,hilon,
     *                lolon,minmag,maxmag,minrms,maxrms,mindepth,
     *                maxdepth,minhelat,maxhelat,minhelon,maxhelon,
     *                minhedepth,maxhedepth,ypol,iant,mnupol
      common/epicrit2/fpsolut,eqfelt,statselect
      common/epicrit1/mindist,maxdist,
     *                hypaselect,magaselect 
      common/epicrit3/default,eventtype,disttype,magtypes,volcanictype
      common/epicrit4/minstation,maxstation,stat_present,hypa_present,
     *                maga_present,header_check,wave_check
      common/epicrit5/time1,time2,timcen,all_stat,mingap,maxgap,phase,
     *                stat_phase,hyp_dist


      idist=0
c      do i=1,5  
c  5-7-200 jh    magtypest(i)=' '
c  ----------    disttypet(i)=' '
c  ---------    eventtypet(i)=' '
c      end do                        ! not sure why it was here

c-formats used in the subroutine

 900  format ('  SELECT NUMBER TO CHANGE PARAMETER, RETURN TO SEARCH: '
     *,$)
 901  format ('  Maximum RMS, return for default: ',$)
 902  format ('  Minimum Number of Stations, return for default: ',$)
 903  format ('  Magnitude Type. Any combinations of C, L, B, S, E.G. ' 
     *        ,'CB for CODA and MB.'
     *       /,'  Return for all types.',
     *        ' Enter with the value for Magnitude Type: ',$)
 904  format ('  Distance ID. Any combinations of L, R, D, E.G. LR '
     *        ,'for Local and Regional.'
     *       /,'  Return for all types.',
     *        ' Enter with the value(s) for Distance ID: ',$)
 905  format ('  Event ID. Any combinations of E, P, V, S, Q, E.G. '
     *        ,'QE for Quakes and Explosions.'
     *       /,'  Return for all types.',
     *        ' Enter with the value(s) for Event ID: ',$)
 906  format ('  Minimum Magnitude, return for default: ',$)
 907  format ('  Maximum Magnitude, return for default: ',$)
 908  format ('  Lower Latitude Limit, return for default: ',$)
 909  format ('  Upper Latitude Limit, return for default: ',$)
 910  format ('  Lower Longitude Limit, return for default: ',$)
 911  format ('  Upper Longitude Limit, return for default: ',$)
 912  format ('  Minimum Depth Limit, return for default: ',$)
 913  format ('  Maximum Depth Limit, return for default: ',$)
 914  format ('            ',$)
 915  format ('  Something wrong. Default value assumed.')
 916  format ('  Some wrong value not considerated.')
 917  format ('  Default value assumed.')
 918  format ('  Ok. Input realized successfully.')
 919  format 
     *       ('  Station, component, distance range and phase',
     *        ' which at least one '
     *        ,'should be present.'
     *       /, '  Example is BERG LZ, BERGE,     LZ'
     *       /,'  One per line, end with return, or return for '
     *        ,'defaults: '
     *       /,'            STAT CO MINDIS MAXDIS PHAS') 
 920  format (6x,'10  - RMS Limits',30x,f5.1,6x,f5.1)
 921  format (6x,'6   - Magnitude Limits',23x,f6.1,5x,f6.1)
 922  format (6x,'7   - Latitude Limits',23x,f7.3,4x,f7.3)
 923  format (6x,'8   - Longitude Limits',21x,f8.3,3x,f8.3)
 924  format (6x,'9   - Depth Limits',25x,f8.1,3x,f8.1)
 925  format ('  Fault Plane Solution. Yes or No: ',$)
 926  format ('  Earthquake Felt. Yes or No: ',$)
 927  format ('  Minimum RMS, return for default: ',$)
 928  format ('  Maximum Number of Stations, return for default: ',$)
 929  format (6x,'12  - Hypocenter Errors Latitude Limits',5x,f9.2,
     *        4x,f9.2)
 930  format (6x,'13  - Hypocenter Errors Longitude Limits',4x,f9.2,
     *        4x,f9.2)
 931  format (6x,'14  - Hypocenter Errors Depth Limits',10x,f8.1,
     *        6x,f8.1)
 932  format ('  Minimum hypocenter error latitude, return for  
     *        default: ',$)
 933  format ('  Maximum hypocenter error latitude, return for  
     *        default: ',$)
 934  format ('  Minimum hypocenter error longitude, return for  
     *        default: ',$)
 935  format ('  Maximum hypocenter error longitude, return for  
     *        default: ',$)
 936  format ('  Minimum hypocenter error depth, return for  
     *        default: ',$)
 937  format ('  Maximum hypocenter error depth, return for  
     *        default: ',$)
 938  format
     *(6x,'18  - Station Codes, components, distance range and phase')
 939  format (6x,'18  - Stat-comp Codes: ',6(a7,1x))
 940  format (29x,6(a7,1x))
 941  format ('  Hypocenter agencies for agencies of which at least '
     *        ,'one should be present.'
     *       /,'  One per line, end with return, or return for '
     *        ,'defaults: ')
 942  format ('  Magnitude agencies for agencies of which at least '
     *        ,'one should be present.'
     *       /,'  One per line, end with return, or return for '
     *        ,'defaults: ')
 943  format (6x,'16  - Hypocenter Agencies')
 944  format (6x,'16  - Hypocenter Agencies: ',10a4)
 945  format (6x,'17  - Magnitude Agencies')
 946  format (6x,'17  - Magnitude Agencies:  ',10a4)
 947  format (6x,'19  - Polygon')
 948  format ('  Minimum number of polarities, return for  
     *        default: ',$)
 949  format (6x,'15  - Minimum Number of Polarities')
 950  format (6x,'15  - Minimum Number of Polarities: ',10x,i5)
 951  format ('  Points of polygon where events should be inside. '
     *        ,'Minimum of 3 points required.'
     *       /,'  One (lat-lon) pair per line, end with return,',
     *          ' or return for '
     *        ,'defaults: ')
 952  format ('  Some wrong point not considered.') 
 953  format ('  Less than 3 points defined. Default value assumed.')
 954  format (14x,'Latitude:  ',f7.1,1x,f7.1,1x,f7.1,1x,f7.1,1x,f7.1,1x)
 955  format (14x,'Longitude: ',f7.1,1x,f7.1,1x,f7.1,1x,f7.1,1x,f7.1,1x)
 956  format ('  Check all header lines. Yes or No: ',$)
 957  format ('  Give waveform file name chars, * for any name ',$)
 958  format ('  Minimum gap, return for default: ',$)
 959  format ('  Maximum gap, return for default: ',$)
 960  format
     *('  Phases, max 6 phases of 4 chars each ( e.g. P   SSS S): ',$)
 961  format ('  Volcanic subclasses, max 10 classes of 6 char, press en
     *ter after each type: ')


c-variables inicialization

      stcodes = 9
      statusaux = 0

c-for each option where the reading variable is integer or real,
c-it checks iostatus. if iostatus not equal 0, sets variable 
c-stcodes for an error message and current variable reading with default.
c-checks if the current variable reading is blank. If yes, sets variable
c-stcodes for a default message and current variable reading with default.
c-If not, sets variable stcodes for a succesfully input.

c-checking if option equal 1 
         if (option(1:3) .eq. '1  ') then
c-writing message and reading value for fault plane solution
             fpsolut = .false.
             write (6,*) ' '
             write (6,925)
             read (5,'(a)') reading
             call aligncha(reading)
             fpsolutin(1:1) = reading(1:1)
             if (fpsolutin .eq. 'y' .or. fpsolutin .eq. 'Y') then
                 fpsolut = .true.
                 stcodes = 0
             else if (fpsolutin .eq. 'n' .or. fpsolutin .eq. 'N') then 
                 stcodes = 0
             else 
                 stcodes = 2
             end if
         else if (option(1:3) .eq. '20 ') then
c-writing message and reading value for checking all header lines
             header_check = .false.
             write (6,*) ' '
             write (6,956)
             read (5,'(a)') reading
             call aligncha(reading)
             fpsolutin(1:1) = reading(1:1)
             if (reading(1:1) .eq. 'y' .or. reading(1:1) .eq. 'Y') then
                 header_check = .true.
                 stcodes = 0
             else if (reading(1:1) .eq. 'n' .or. reading(1:1) .eq. 'N')
     *       then 
                 stcodes = 0
             else 
                 stcodes = 2
             end if
         else if (option(1:3) .eq. '21 ')then
c-writing message and reading value for getting events with given wave file 
c name
             wave_check = ' '
             write (6,*) ' '
             write (6,957)
             read (5,'(a)') wave_check
             stcodes = 0

c-checking if option equal 2
         else if (option(1:3) .eq. '2  ') then
c-writing message and reading value for earthquake felt
             eqfelt = .false.
             write (6,*) ' '
             write (6,926)
             read (5,'(a)') reading
             call aligncha(reading)
             eqfeltin = reading
             if (eqfeltin .eq. 'y' .or. eqfeltin .eq. 'Y') then
                 eqfelt = .true.
                 stcodes = 0
             else if (eqfeltin .eq. 'n' .or. eqfeltin .eq. 'N') then
                 stcodes = 0
             else 
                 stcodes = 2
             end if

c-checking if option equal 3
         else if (option(1:3) .eq. '3  ') then
c-writing message and reading value for magnitude type
             count = 0
             write (6,*) ' '
             write (6,903)
             read (5,'(a)') reading
             call aligncha(reading)
             do ind = 1,5
                magtypes(ind) = reading(ind:ind)
             end do
c             read (5,'(5a1)') magtypes
             do ind = 1,5
                magtypest(ind) = ' '
c-checking if some wrong value was typed
                if (magtypes(ind) .ne. ' ' .and.
     *              magtypes(ind) .ne. '_' .and.    ! blank magnitudes
     *              magtypes(ind) .ne. 'C' .and. 
     *              magtypes(ind) .ne. 'c' .and.
     *              magtypes(ind) .ne. 'N' .and.    ! no magnitude
     *              magtypes(ind) .ne. 'n' .and.
     *              magtypes(ind) .ne. 'B' .and.
     *              magtypes(ind) .ne. 'b' .and.
     *              magtypes(ind) .ne. 'L' .and.
     *              magtypes(ind) .ne. 'l' .and. 
     *              magtypes(ind) .ne. 'S' .and.
     *              magtypes(ind) .ne. 's' .and.
     *              magtypes(ind) .ne. 'W' .and.
     *              magtypes(ind) .ne. 'w') then
                    stcodes = 3
                    magtypes(ind) = ' '
                else 
c-making upper case for valid values
                    if (magtypes(ind) .eq. 'c') then
                        magtypes(ind) = 'C'
                    else if (magtypes(ind) .eq. 'b') then
                        magtypes(ind) = 'B'
                    else if (magtypes(ind) .eq. 'l') then
                        magtypes(ind) = 'L'
                    else if (magtypes(ind) .eq. 'n') then
                        magtypes(ind) = 'N'
                    else if (magtypes(ind) .eq. 's') then
                        magtypes(ind) = 'S'
                    else if (magtypes(ind) .eq. 'w') then
                        magtypes(ind) = 'W'
                    end if
                end if
             end do
             index = 5
             do ind = 5,1,-1
                if (magtypes(ind) .ne. ' ') then
                    magtypest(index) = magtypes(ind)
                    index = index - 1
c-counting blank magnitude types
                else if (magtypes(ind) .eq. ' ') then
                    count = count + 1
                end if
             end do
c-checking if number of magnitude type equal 5. If yes, sets 
c-variable stcodes for default message. If no, checks if stcodes
c-still has the original value (9) avoiding to overwrite stcodes
c-in case of different value.
             if (count .eq. 5) then
                 stcodes = 2
             else 
                  if (stcodes .eq. 9) stcodes = 0
             end if
c
c  replace blank types with a *
c
             do i=2,5
               if(magtypes(i).eq.' ') magtypes(i)='*'
             enddo

c-checking if option equal 4
         else if (option(1:3) .eq. '4  ') then
             count = 0 
c-writing message and reading value for distance id
             write (6,*) ' '
             write (6,904)
             read (5,'(a)') reading
             call aligncha(reading)
             do ind = 1,5
                disttype(ind) = reading(ind:ind)
             end do
c             read (5,'(5a1)') disttype
             do ind = 1,5
                disttypet(ind) = ' '
c-checking if some wrong value was typed
                if (disttype(ind) .ne. ' ' .and.
     *              disttype(ind) .ne. 'L' .and.
     *              disttype(ind) .ne. 'l' .and.
     *              disttype(ind) .ne. 'R' .and.
     *              disttype(ind) .ne. 'r' .and.
     *              disttype(ind) .ne. 'D' .and.
     *              disttype(ind) .ne. 'd') then
                    stcodes = 3 
                    disttype(ind) = '%'
                else 
c-making upper case for valid values
                    if (disttype(ind) .eq. 'l') then
                        disttype(ind) = 'L'
                    else if (disttype(ind) .eq. 'r') then
                        disttype(ind) = 'R'
                    else if (disttype(ind) .eq. 'd') then
                        disttype(ind) = 'D'
                    end if
                end if
             end do
             index = 5
             do ind = 5,1,-1
                if (disttype(ind) .ne. ' ' .and. 
     *              disttype(ind) .ne. '%') then
                    disttypet(index) = disttype(ind)
                    index = index - 1
c-counting blank distance id
                else if (disttype(ind) .eq. ' ' .or.
     *                   disttype(ind) .eq. '%') then
                    count = count + 1
                end if
             end do

c-checking if number of magnitude type equal 5. If yes, sets
c-variable stcodes for default message. If no, checks if stcodes
c-still has the original value (9) avoiding to overwrite stcodes
c-in case of different value.
             if (count .eq. 5) then
                 stcodes = 2
             else
                  if (stcodes .eq. 9) stcodes = 0
             end if
             if (disttype(1) .ne. ' ') then
                 do ind = 1,5
c-if blank, making sure the type is set with something not used
                   if (disttype(ind) .eq. ' ') then
                       disttype(ind) = '%'
                   end if
                 end do 
             end if

c-checking if option equal 5
         else if (option(1:3) .eq. '5  ') then
             count = 0
c-writing message and reading value for event id
             write (6,*) ' '
             write (6,905)
             read (5,'(a)') reading
             call aligncha(reading)
             do ind = 1,5
                eventtype(ind) = reading(ind:ind)
             end do
c             read (5,'(5a1)') eventtype
             do ind = 1,5
                eventtypet(ind) = ' '
c-checking if some wrong value was typed
c               if (eventtype(ind) .ne. ' ' .and.
c    *              eventtype(ind) .ne. 'E' .and.
c    *              eventtype(ind) .ne. 'e' .and.
c    *              eventtype(ind) .ne. 'P' .and.
c    *              eventtype(ind) .ne. 'p' .and.
c    *              eventtype(ind) .ne. 'V' .and.
c    *              eventtype(ind) .ne. 'v' .and.
c    *              eventtype(ind) .ne. 'S' .and.
c    *              eventtype(ind) .ne. 's' .and.
c    *              eventtype(ind) .ne. 'Q' .and.
c    *              eventtype(ind) .ne. 'q') then
c                   stcodes = 3
c                   eventtype(ind) = '%'
c               else
c-making upper case for valid values
                    if (eventtype(ind) .eq. 'e') then
                        eventtype(ind) = 'E'
                    else if (eventtype(ind) .eq. 'p') then
                        eventtype(ind) = 'P'
                    else if (eventtype(ind) .eq. 'v') then
                        eventtype(ind) = 'V'
                    else if (eventtype(ind) .eq. 's') then
                        eventtype(ind) = 'S'
                    else if (eventtype(ind) .eq. 'q') then
                        eventtype(ind) = 'Q'
                    end if
c               end if
             end do
             index = 5
             do ind = 5,1,-1
                if (eventtype(ind) .ne. ' ' .and.
     *              eventtype(ind) .ne. '%') then
                    eventtypet(index) = eventtype(ind)
                       index = index - 1
c-counting blank event id
                else if (eventtype(ind) .eq. ' ' .or.
     *                   eventtype(ind) .eq. '%') then
                    count = count + 1
                end if
             end do
c-checking if number of magnitude type equal 5. If yes, sets
c-variable stcodes for default message. If no, checks if stcodes
c-still has the original value (9) avoiding to overwrite stcodes
c-in case of different value.
             if (count .eq. 5) then
                 stcodes = 2
             else
                  if (stcodes .eq. 9) stcodes = 0
             end if
             if (eventtype(1) .ne. ' ') then
                 do ind = 1,5
c-if blank, making sure the type is set with something not used
                   if (eventtype(ind) .eq. ' ') then
                       eventtype(ind) = '%'
                   end if
                 end do
             end if


c-checking if option equal 23            ! phase names
         else if (option(1:3) .eq. '23  ') then
             count = 0
c-writing message and reading value for phases
             write (6,*) ' '
             write (6,960)
             read (5,'(6a4)') phase
         else if (option(1:3) .eq. '24  ') then
             write (6,*) ' '
             write (6,961)
             ind=0
1961         continue
             ind=ind+1
             read(5,'(a6)') volcanictype(ind)
             if (seiclen(volcanictype(ind)).gt.0) goto 1961

c-------------------------------------------------------------------------



c-checking if option equal 6
         else if (option(1:3) .eq. '6  ') then
c-writing message and reading value for minimum magnitude 
             write (6,*) ' '
             write (6,906)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:6),'(a6)') minmaga 
             read (reading (1:6),'(f6.0)',err=103,iostat=status) minmag
 103         continue
             if (status .ne. 0) then  
                 stcodes = 1
                 statusaux = status
                 minmag = -990.0
             else
                  if (ichar(minmaga(1:1)) .eq. 32) then
                      minmag = -990.0
                      stcodes = 2
                  else if (ichar(minmaga(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum magnitude
             write (6,*) ' '
             write (6,907)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:6),'(a6)') maxmaga 
             read (reading (1:6),'(f6.0)',err=104,iostat=status) maxmag
 104         continue
             if (status .ne. 0) then  
                 maxmag = 999.0
                 stcodes = 1
             else
                  if (ichar(maxmaga(1:1)) .eq. 32) then
                      maxmag = 999.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxmaga(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 7
         else if (option(1:3) .eq. '7  ') then
c-writing message and reading value for minimum latitude
             write (6,*) ' '
             write (6,908)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:7),'(a7)') lolata 
             read (reading (1:7),'(f7.0)',err=105,iostat=status) lolat
 105         continue
             if (status .ne. 0) then    
                 statusaux = status
                 lolat = -90.0
                 stcodes = 1
             else
                  if (ichar(lolata(1:1)) .eq. 32) then
                      lolat = -90.0
                      stcodes = 2
                  else if (ichar(lolata(1:1)) .ne. 32) then
                           stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum latitude
             write (6,*) ' '
             write (6,909)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:7),'(a7)') hilata 
             read (reading (1:7),'(f7.0)',err=106,iostat=status) hilat
 106         continue
             if (status .ne. 0) then    
                 hilat = 90.0
                 stcodes = 1
             else
                  if (ichar(hilata(1:1)) .eq. 32) then
                      hilat = 90.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(hilata(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0 
                      end if
                  end if
             end if


c-checking if option equal 22
         else if (option(1:3) .eq. '22 ') then
c-writing message and reading value for minimum gap
             write (6,*) ' '
             write (6,958)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') mingapa
             read (reading (1:8),'(f8.0)',err=1077,iostat=status) mingap
 1077        continue
             if (status .ne. 0) then    
                 statusaux = status
                 mingap = 0.0
                 stcodes = 1
             else
                  if (ichar(mingapa(1:1)) .eq. 32) then
                      mingap = 0.0
                      stcodes = 2
                  else if (ichar(mingapa(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum longitude
             write (6,*) ' '
             write (6,959)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') maxgapa 
             read (reading (1:8),'(f8.0)',err=1088,iostat=status) maxgap
 1088        continue
             if (status .ne. 0) then     
                 maxgap = 360.0
                 stcodes = 1
             else
                  if (ichar(maxgapa(1:1)) .eq. 32) then
                      maxgap = 360.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxgapa(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if


c-checking if option equal 8
         else if (option(1:3) .eq. '8  ') then
c-writing message and reading value for minimum longitude
             write (6,*) ' '
             write (6,910)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') lolona 
             read (reading (1:8),'(f8.0)',err=107,iostat=status) lolon
 107         continue
             if (status .ne. 0) then    
                 statusaux = status
                 lolon = -360.0
                 stcodes = 1
             else
                  if (ichar(lolona(1:1)) .eq. 32) then
                      lolon = -360.0
                      stcodes = 2
                  else if (ichar(lolona(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum longitude
             write (6,*) ' '
             write (6,911)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') hilona 
             read (reading (1:8),'(f8.0)',err=108,iostat=status) hilon
 108         continue
             if (status .ne. 0) then     
                 hilon = 360.0
                 stcodes = 1
             else
                  if (ichar(hilona(1:1)) .eq. 32) then
                      hilon = 360.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(hilona(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if


c-checking if option equal 9
         else if (option(1:3) .eq. '9  ') then
c-writing message and reading value for minimum depth
             write (6,*) ' '
             write (6,912)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:5),'(a5)') mindeptha 
             read (reading (1:5),'(f5.0)',err=109,iostat=status) 
     *             mindepth
 109         continue
             if (status .ne. 0) then   
                 statusaux = status
                 mindepth = -99.0
                 stcodes = 1
             else
                  if (ichar(mindeptha(1:1)) .eq. 32) then
                      mindepth = -99.0
                      stcodes = 2
                  else if (ichar(mindeptha(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum depth
             write (6,*) ' '
             write (6,913)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:5),'(a5)') maxdeptha 
             read (reading (1:5),'(f5.0)',err=110,iostat=status) 
     *             maxdepth
 110         continue
             if (status .ne. 0) then    
                 maxdepth = 99999.0
                 stcodes = 1
             else
                  if (ichar(maxdeptha(1:1)) .eq. 32) then
                      maxdepth = 99999.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxdeptha(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 10
         else if (option(1:3) .eq. '10 ') then
c-writing message and reading value for minimum rms
             write (6,*) ' '
             write (6,927)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:4),'(a4)') minrmsa
             read (reading (1:4),'(f4.0)',err=112,iostat=status) minrms
 112         continue
             if (status .ne. 0) then
                stcodes = 1
                statusaux = status
                minrms = 0
             else
                  if (ichar(minrmsa(1:1)) .eq. 32) then
                      minrms = 0
                      stcodes = 2
                  else if (ichar(minrmsa(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum rms
             write (6,*) ' '
             write (6,901)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:4),'(a4)') maxrmsa
             read (reading (1:4),'(f4.0)',err=101,iostat=status) maxrms
 101         continue
             if (status .ne. 0) then
                stcodes = 1
                maxrms = 999
             else
                  if (ichar(maxrmsa(1:1)) .eq. 32) then
                      maxrms = 999
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxrmsa(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 11
         else if (option(1:3) .eq. '11 ') then
c-writing message and reading value for minimum number of stations
             write (6,*) ' '
             write (6,902)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:3),'(a3)') minstationa
             read (reading (1:3),'(i3)',err=102,iostat=status)
     *             minstation
 102         continue
             if (status .ne. 0) then
                 stcodes = 1
                 minstation = 0
             else
                  if (ichar(minstationa(1:1)) .eq. 32) then
                      minstation = 0
                      stcodes = 2
                  else if (ichar(minstationa(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum number of stations
             write (6,*) ' '
             write (6,928)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:3),'(a3)') maxstationa
             read (reading (1:3),'(i3)',err=113,iostat=status)
     *             maxstation
 113         continue
             if (status .ne. 0) then
                 stcodes = 1
                 statusaux = status
                 maxstation = 999
             else
                  if (ichar(maxstationa(1:1)) .eq. 32) then
                      maxstation = 999
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxstationa(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 12 
         else if (option(1:3) .eq. '12 ') then
c-writing message and reading value for minimum hypocenter error latitude
             write (6,*) ' '
             write (6,932)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:7),'(a7)') minhelata
             read (reading (1:7),'(f7.0)',err=114,iostat=status) 
     *             minhelat
 114         continue
             if (status .ne. 0) then
                 statusaux = status
                 minhelat = .0
                 stcodes = 1
             else
                  if (ichar(minhelata(1:1)) .eq. 32) then
                      minhelat = .0
                      stcodes = 2
                  else if (ichar(minhelata(1:1)) .ne. 32) then
                      stcodes=0
                  end if
             end if
c-writing message and reading value for maximum hypocenter error latitude
             write (6,*) ' '
             write (6,933)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:7),'(a7)') maxhelata
             read (reading (1:7),'(f7.0)',err=115,iostat=status) 
     *             maxhelat
 115         continue
             if (status .ne. 0) then
                 maxhelat = 99999.0
                 stcodes = 1
             else
                  if (ichar(maxhelata(1:1)) .eq. 32) then
                      maxhelat = 99999.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxhelata(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 13 
         else if (option(1:3) .eq. '13 ') then
c-writing message and reading value for minimum  hypocenter error longitude
             write (6,*) ' '
             write (6,934)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') minhelona
             read (reading (1:8),'(f8.0)',err=116,iostat=status) 
     *             minhelon
 116         continue
             if (status .ne. 0) then
                 statusaux = status
                 minhelon = .0
                 stcodes = 1
             else
                  if (ichar(minhelona(1:1)) .eq. 32) then
                      minhelon = .0
                      stcodes = 2
                  else if (ichar(minhelona(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum hypocenter error longitude
             write (6,*) ' '
             write (6,935)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:8),'(a8)') maxhelona
             read (reading (1:8),'(f8.0)',err=117,iostat=status) 
     *             maxhelon
 117         continue
             if (status .ne. 0) then
                 maxhelon = 99999.0
                 stcodes = 1
             else
                  if (ichar(maxhelona(1:1)) .eq. 32) then
                      maxhelon = 99999.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxhelona(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 14 
         else if (option(1:3) .eq. '14 ') then
c-writing message and reading value for minimum  hypocenter error depth
             write (6,*) ' '
             write (6,936)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:5),'(a5)') minhedeptha
             read (reading (1:5),'(f5.0)',err=118,iostat=status)
     *             minhedepth
 118         continue
             if (status .ne. 0) then
                 statusaux = status
                 minhedepth = -99.0
                 stcodes = 1
             else
                  if (ichar(minhedeptha(1:1)) .eq. 32) then
                      minhedepth = -99.0
                      stcodes = 2
                  else if (ichar(minhedeptha(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if
c-writing message and reading value for maximum hypocenter error depth
             write (6,*) ' '
             write (6,937)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:5),'(a5)') maxhedeptha
             read (reading (1:5),'(f5.0)',err=119,iostat=status)
     *             maxhedepth
 119         continue
             if (status .ne. 0) then
                 maxhedepth = 99999.0
                 stcodes = 1
             else
                  if (ichar(maxhedeptha(1:1)) .eq. 32) then
                      maxhedepth = 99999.0
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 2
                      end if
                  else if (ichar(maxhedeptha(1:1)) .ne. 32) then
                      if (stcodes .ne. 1 .and. stcodes .ne. 2) then
                          stcodes = 0
                      end if
                  end if
             end if

c-checking if option equal 15
         else if (option(1:3) .eq. '15 ') then
c-writing message and reading value for minimum number of polarities
             write (6,*) ' '
             write (6,948)
             read (5,'(a)') reading
             call alignnum(reading)
             read (reading (1:5),'(a5)') mnupola
             read (reading (1:5),'(i5)',err=126,iostat=status) mnupol
 126         continue
             if (status .ne. 0) then
                 stcodes = 1
                 statusaux = status
                 mnupol = 0
             else
                  if (ichar(mnupola(1:1)) .eq. 32) then
                      mnupol = 0
                      stcodes = 2
                  else if (ichar(mnupola(1:1)) .ne. 32) then
                      stcodes = 0
                  end if
             end if

c-checking if option equal 16
         else if (option(1:3) .eq. '16 ') then
             do ind = 1,10
                hypaselect(ind) = ' '
             end do
c-writing message and reading value for hypocenter agencies
             hypa_present = 0
             write (6,*) ' '
             write (6,941)
 120  continue
             write (6,914)
             read (5,'(a)') reading
             call aligncha(reading)
             hypaselect(hypa_present + 1) = reading
c             read (5,'(a3)') hypaselect(hypa_present + 1)
             if (hypaselect(hypa_present + 1) .ne. '    ') then
                 hypa_present = hypa_present + 1
                 if (hypa_present .lt. 10) then
                    goto 120
                 else
                    write (6,*) ' '
                    write (6,*) '  Array completed'
                 end if
             end if
             if (hypa_present .eq. 0) then
                 stcodes = 2
             else
                 stcodes = 0
             end if

c-checking if option equal 17
         else if (option(1:3) .eq. '17 ') then
             do ind = 1,10
                magaselect(ind) = ' '
             end do
c-writing message and reading value for hypocenter agencies
             maga_present = 0
             write (6,*) ' '
             write (6,942)
 121  continue
             write (6,914)
             read (5,'(a)') reading
             call aligncha(reading)
             magaselect(maga_present + 1) = reading
c             read (5,'(a3)') magaselect(maga_present + 1)
             if (magaselect(maga_present + 1) .ne. '    ') then
                 maga_present = maga_present + 1
                 if (maga_present .lt. 10) then
                    goto 121
                 else
                    write (6,*) ' '
                    write (6,*) '  Array completed'
                 end if
             end if
             if (maga_present .eq. 0) then
                 stcodes = 2
             else
                 stcodes = 0
             end if

c-checking if option equal 18
         else if (option(1:3) .eq. '18 ') then
             do ind = 1,50
                statselect(ind) = ' '
                mindist(ind)=0
                maxdist(ind)=99999
                stat_phase(ind)=' '
             end do
c-writing message and reading value for station codes
             stat_present = 0
             write (6,*) ' '
             write (6,919)
 100  continue
             write (6,914)
             read (5,'(a)') reading
c             call aligncha(reading)
             statselect(stat_present + 1) = reading(1:7)
             if(reading(8:14).ne.' ') then
                 read(reading(8:14),'(i7)') mindist(stat_present+1) 
                 idist=idist+1    ! count if any distance required
             endif
             if(reading(15:21).ne.' ')  then
                read(reading(15:21),'(i7)') maxdist(stat_present+1) 
                idist=idist+1
             endif
             stat_phase(stat_present+1)=reading(23:26)
c             read (5,'(a5)') statselect(stat_present + 1)
c
             if (statselect(stat_present + 1) .ne. '       ') then
                 stat_present = stat_present + 1
                 if (stat_present .lt. 50) then
                    goto 100
                 else
                    write (6,*) ' '
                    write (6,*) '  Array completed'
                 end if
             end if
             if (stat_present .eq. 0) then
                 stcodes = 2
             else
c
c   enter if all must be present
c
                 write(6,'(a)')
     *           ' Must all stat-comps be present (y/n=return)'
                 read(5,'(a)') reading
                 all_stat=.false.
                 if(reading(1:1).eq.'Y'.or.reading(1:1).eq.'y')
     *           all_stat=.true.
                 stcodes = 0
c
c  if distances used, ask if epicentral or hypocentreal
c
                if(idist.gt.0) then
                    write(6,'(a)')
     *             ' Epecentral (Return) or hypocentral distance (h) ?'
                    read(5,'(a)') reading
                    hyp_dist=.false.
                    if(reading(1:1).eq.'h'.or.reading(1:1).eq.'H')
     *              hyp_dist=.true.
                endif
             end if

c-checking if option equal 19
         else if (option(1:3) .eq. '19 ') then
             do ind = 1,20
                ypol(ind,1) = 0
                ypol(ind,2) = 0
             end do
             count = 0
c-writing message and reading value for polygon points
             write (6,*) ' '
             write (6,951)
 124  continue
             inde1 = 0
             inde2 = 0
             inde3 = 0
             found = .false.
             count = count + 1
             write (6,914)
             read (5,'(a)') reading
             if(reading(1:5).eq.'     ') go to 888   ! end of input
             call sei get values(2,reading,code)
             ypol(count,2)=array$(1)
             ypol(count,1)=array$(2)
             goto 124

ccccccccccccccc skipped, some problems
             
c-finding the exactly position for x, (,), y in the variable
             do while (.not. found .and. inde1 .ne. 80)
               inde1 = inde1 + 1
c               write(6,*) inde1
               if (reading (inde1:inde1) .ne. ' ') found = .true.
             end do
             inde2 = inde1
             if (reading (inde1:inde1) .eq. ',') then

ccc in following section, all 81 has been replaced by 80 feb 98
                 inde1 = 80
             else
                 found = .false.
             end if
             do while (.not. found .and. inde2 .ne. 80)
               inde2 = inde2 + 1
               if (reading (inde2:inde2) .eq. ',' .or.
     *             reading (inde2:inde2) .eq. ' ') found = .true.
             end do
             found = .false.
             inde3 = inde2
             do while (.not. found .and. inde3 .ne. 80)
               inde3 = inde3 + 1
               if (reading (inde3:inde3) .ne. ',' .and.
     *             reading (inde3:inde3) .ne. ' ') found = .true.
             end do
c-reading from the auxiliary variable to the array
             read (reading (inde1:inde2 - 1),'(f5.0)',err=125,
     *             iostat=status) ypol(count,2)   
             read (reading (inde3:inde3 + 5),'(f5.0)',err=125,
     *             iostat=status) ypol(count,1)
 125  continue
c-checking iostatus. if not zero, goes 1 position back in the array
             if (status .ne. 0 .and. (inde1 .ne. 80 .or.
     *           inde2 .ne. 80 .or. inde3 .ne. 80)) then
                 stcodes = 4
                 ypol(count,1) = 0
                 ypol(count,2) = 0
                 count = count - 1
             end if
             if (count .lt. 20) then
c-if inde1/2/3 not 80 means that return was not pressed for end of reading
                 if (inde1 .ne. 80 .or. inde2 .ne. 80 .or.
     *               inde3 .ne. 80) go to 124
             else
                 if (inde1 .ne. 80 .or. inde2 .ne. 80 .or.
     *               inde3 .ne. 80) then
                     write (6,*) ' '
                     write (6,*) '  Array completed'
                     count = count + 1
                 end if
             end if
 888         continue                  ! to jump section not working
             iant = count - 1
             if (iant .eq. 0) then
c-no points were written
                stcodes = 2
             else
                  if (iant .lt. 3) then
c-less than 3 points were written
                      do ind = 1,20
                        ypol(ind,1) = 0
                        ypol(ind,2) = 0
                      end do
                      stcodes = 5
                      iant = 0
                  else 
c-input ok 
                       if (stcodes .ne. 4) stcodes = 0
                  end if
             end if
         end if

c-writing main screen. When default, value is not printed

         write (6,*) ' '
         write (6,*) '            PARAMETERS'
         write (6,*) ' '
         if (fpsolut) then
             write (6,'(6x,a,21x,a)') '1   - Fault Plane Solution',
     *                                ' Yes'
         else
             write (6,'(6x,a)') '1   - Fault Plane Solution'
         end if
         if (eqfelt) then
             write (6,'(6x,a,27x,a)') '2   - Earthquake Felt','Yes' 
         else
             write (6,'(6x,a)') '2   - Earthquake Felt'
         end if
         write (6,'(6x,a,23x,5a1)') '3   - Magnitude Type(s)',
     *                            magtypest
         write (6,'(6x,a,26x,5a1)') '4   - Distance ID(s)',disttypet
         write (6,'(6x,a,29x,5a1)') '5   - Event ID(s)',eventtypet
         if (minmag .ne. -990 .or. maxmag .ne. 999) then
             write (6,921) minmag, maxmag
         else
             write (6,'(6x,a)') '6   - Magnitude Limits'
         end if
         if (lolat .ne. -90 .or. hilat .ne. 90) then
             write (6,922) lolat, hilat
         else 
             write (6,'(6x,a)') '7   - Latitude Limits'
         end if
         if (lolon .ne. -360.0 .or. hilon .ne. 360.0) then
             write (6,923) lolon, hilon
         else
             write (6,'(6x,a)') '8   - Longitude Limits'
         end if
         if (mindepth .ne. -99 .or. maxdepth .ne. 99999) then
             write (6,924) mindepth, maxdepth
         else 
             write (6,'(6x,a)') '9   - Depth Limits'
         end if
         if (minrms .ne. 0 .or. maxrms .ne. 999) then
             write (6,920) minrms, maxrms
         else
             write (6,'(6x,a)') '10  - RMS Limits'
         end if  
         if (minstation .ne. 0 .or. maxstation .ne. 999) then
             write (6,'(6x,a,a,17x,i3,8x,i3)') '11  - Number of '
     *              ,'Stations Limits', minstation, maxstation
         else
             write (6,'(6x,a)') '11  - Number of Stations Limits'
         end if
         if (minhelat .ne. 0. .or. maxhelat .ne. 99999.) then
             write (6,929) minhelat, maxhelat
         else
             write (6,'(6x,a,a)') '12  - Hypocenter Errors Latitude',
     *                          ' Limits'
         end if
         if (minhelon .ne. 0. .or. maxhelon .ne. 99999.) then
             write (6,930) minhelon, maxhelon
         else
             write (6,'(6x,a,a)') '13  - Hypocenter Errors Longitude',
     *                          ' Limits'
         end if
         if (minhedepth.ne. -99 .or. maxhedepth .ne. 99999) then
             write (6,931) minhedepth, maxhedepth
         else
             write (6,'(6x,a,a)') '14  - Hypocenter Errors Depth Limits'
         end if
         if (mnupol .eq. 0) then
             write (6,949)
         else
             write (6,950) mnupol
         end if
         if (hypa_present .eq. 0) then
             write (6,943)
         else 
             write (6,944) (hypaselect(ind),ind = 1,10)
         end if
         if (maga_present .eq. 0) then
             write (6,945)
         else
             write (6,946) (magaselect(ind),ind = 1,10)
         end if
         if (stat_present .eq. 0) then
             write (6,938)
         else if (stat_present .ge. 1 .and.
     *            stat_present .le. 6) then
             write (6,939) (statselect(ind),ind = 1,6)
         else if (stat_present .ge. 7 .and.
     *            stat_present .le. 12) then
             write (6,939) (statselect(ind),ind = 1,6)
             write (6,940) (statselect(ind),ind = 7,12)
         else if (stat_present .ge. 13 .and.
     *            stat_present .le. 16) then
             write (6,939) (statselect(ind),ind = 1,6)
             write (6,940) (statselect(ind),ind = 7,12)
             write (6,940) (statselect(ind),ind = 13,18)
         else if (stat_present .ge. 19 .and.
     *            stat_present .le. 24) then
             write (6,939) (statselect(ind),ind = 1,6)
             write (6,940) (statselect(ind),ind = 7,12)
             write (6,940) (statselect(ind),ind = 13,18)
             write (6,940) (statselect(ind),ind = 19,24)
         else if (stat_present .ge. 25 .and.
     *            stat_present .le. 30) then
             write (6,939) (statselect(ind),ind = 1,6)
             write (6,940) (statselect(ind),ind = 7,12)
             write (6,940) (statselect(ind),ind = 13,18)
             write (6,940) (statselect(ind),ind = 19,24)
             write (6,940) (statselect(ind),ind = 25,30)
         end if
         if (iant .eq. 0) then
             write (6,947)
         else if (iant .le. 5) then
              write (6,947)
              write (6,954) (ypol(ind,2),ind = 1,iant)
              write (6,955) (ypol(ind,1),ind = 1,iant)
         else if (iant .le. 10) then
              write (6,947)
              write (6,954) (ypol(ind,2),ind = 1,5)
              write (6,955) (ypol(ind,1),ind = 1,5)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 6,iant)
              write (6,955) (ypol(ind,1),ind = 6,iant)
         else if (iant .le. 15) then
              write (6,947)
              write (6,954) (ypol(ind,2),ind = 1,5)
              write (6,955) (ypol(ind,1),ind = 1,5)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 6,10)
              write (6,955) (ypol(ind,1),ind = 6,10)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 11,iant)
              write (6,955) (ypol(ind,1),ind = 11,iant)
         else if (iant .le. 20) then
              write (6,947)
              write (6,954) (ypol(ind,2),ind = 1,5)
              write (6,955) (ypol(ind,1),ind = 1,5)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 6,10)
              write (6,955) (ypol(ind,1),ind = 6,10)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 11,15)
              write (6,955) (ypol(ind,1),ind = 11,15)
              write (6,*) ' '
              write (6,954) (ypol(ind,2),ind = 16,iant)
              write (6,955) (ypol(ind,1),ind = 16,iant)
         end if
         if (header_check) then
            write (6,'(6x,a,27x,a)') '20  - Use all header lines','Yes' 
         else
             write (6,'(6x,a)') '20  - Use all header lines'
         end if
         if(wave_check.ne.' ') then
            write(6,'(6x,a,a,7x,a)') '21  - Look for wave form file',
     *      ' names ',wave_check
         else
            write(6,'(6x,a,a,7x)')    '21  - Look for wave form file',
     *      ' names'
         endif

         if(maxgap.ne.360.0.or.mingap.ne.0.0) then
            write(6,'(6x,a,a,7x,f6.1,6x,f6.1)') 
     *      '22  - Gap range               ',
     *      '       ',mingap,maxgap
         else
            write(6,'(6x,a,a,7x)')    '22  - Gap range              ',
     *      '     '
         endif
         write(6,'(6x,a,a,7x,6a4)')   '23  - Phases                 ',
     *      '     ',phase
         write(6,'(6x,a,a,7x,10a6)')   '24  - Volcanic subclasses    ',
     *      '     ',volcanictype


         write (6,*) ' '

c-checkins status codes and printing messages.
c-stcodes equal 0 - everything is ok
c-stcodes equal 1 - status not equal 0
c-stcodes equal 2 - default assumed
c-stcodes equal 3 - some wrong value
c-stcodes equal 4 - wrong polygon point not considerated 
c-stcodes equal 5 - less then 3 points defined
         if (stcodes .eq. 0) then
             if (statusaux .ne. 0) then
                 write (6,915)
                 statusaux = 0 
             else if (statusaux .eq. 0) then
                 write (6,918)
             end if
         else if (stcodes .eq. 1) then
             write (6,915)
         else if (stcodes .eq. 2) then
             write (6,917)
         else if (stcodes .eq. 3) then
             write (6,916)
         else if (stcodes .eq. 4) then
             write (6,952)
         else if (stcodes .eq. 5) then
             write (6,953)
         end if
         if (option(1:1) .eq. '?') then
             write (6,*) '  Invalid Option.'
         end if
         write (6,900)
         read (5,'(a)') option
         call alignnum(option)

      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     SUBROUTINE THAT SELECTS EVENTS AFTER GIVEN
C     CRITERIAS GIVEN IN COMMON BLOCKS
C
C     INPUT: STRING.  FIRST LINE IN THE FILE (NORDIC FORMAT)
C     OUTPUT: ALL PARAMETERS OF EVENT IN COMMON BLOCKS:'EPIVALUES'
C             AND 'EPICHAR'
C             ACCEPTED: LOGICAL THAT CAN BE TESTED ON IN THE CALLING PROGRAM
C             TIME,YEAR,MONTH,DAY,HOUR,MINUTES,SEC: TIME OF THE EVENT
C             LATI,LONG,DEPTH: LOCATION OF EVENT
C             MAG1,MAG2,MAG3,RMSVALUE,NUMBEROFSTATIONS,
C             AGENCY,MAGAGENCY,MAGTYPE
C             DEPTHID :  OTHER EVENT CHARACTERISTICS
c             start_of_time: true if not yet at start of time interval
c             end_of_time: true if behind end  of time interval
C
      SUBROUTINE EPISELEC(STRING,start_of_time,end_of_time)
      implicit none
      include 'seidim.inc'
      CHARACTER*80 STRING
	  CHARACTER*1 EVENTTYPE(5),DISTTYPE(5),MAGTYPES(5)
C--MAGNITUDE TYPE AND AGENCY
      CHARACTER*1 MAGT(3),MAGA(3)
C--MAGNITUDE IN ASCII
      CHARACTER*4 XMAG(3)
C--COUNTER FOR MAGNITUDES
      INTEGER IMAG
      CHARACTER DISTANCEID*1,EVENTID*1,DEPTHID*1,AGENCY*3,
     *           MAGTYPE*1,MAGAGENCY*3
      character*1 distanceid_local   ! for use inside routine

C  NUMBER OF STATIONS TO BE PRESENT
      INTEGER 		STAT_present		
      logical       all_stat         ! if true,  all must be present
c  number of hypocenter agencies to be present
      integer           hypa_present
c  number of magnitude agencies to be present
      integer           maga_present
C  STATION CODES FOR ABOVE
      CHARACTER*7 	STATSELECT(50)
      character*4       stat_phase(50)
      integer mindist(50),maxdist(50)  ! distance range for station	
c  hypocenter agencies
      character*3       hypaselect(10)
c  magnitude agencies
      character*3       magaselect(10)
      logical start_of_time,end_of_time
      INTEGER YEAR,MONTH,DAY,MINUTES,NUMBEROFSTATIONS,HOUR,
     *          MINSTATION,MAXSTATION,century
      double precision time1,time2,timcen,time
      REAL SEC,LATI,LONG,DEPTH,RMSVALUE,SMAG,LOLAT,
     *        HILAT,LOLON,HILON,MINMAG,MINRMS,MAXRMS,MAXMAG,
     *        MAXDEPTH,MINDEPTH,mag,maxgap,mingap,
     *     minhelat, maxhelat,
     *     minhelon, maxhelon,
     *     minhedepth, maxhedepth
      LOGICAL ACCEPTED,DEFAULT,MGT
      integer i,ind,nstat
c   fault plane solution
      logical fpsolut
c   earthquake felt
      logical eqfelt
      character*40 wave_check    ! string to identify wave form file name
      logical header_check        ! checking all headers
      real ypol(max_polyn$,2)    ! array defining polygon
      integer iant               ! number of points of the polygon
      logical insidepol          ! true - event is inside polygon
      logical hyp_dist           ! if true, use hypocentral distance

      integer mnupol             ! minumum number of polarities
      character*4 phase(6)       ! phase names to select
      character*6 volcanictype(10)   ! volcanic subclasses

      COMMON/EPIVALUE/YEAR,MONTH,DAY,HOUR,MINUTES,SEC,LATI,LONG,DEPTH,
     *                 NUMBEROFSTATIONS,RMSVALUE,MAG,ACCEPTED,nstat
C
      COMMON/EPICHAR/DISTANCEID,EVENTID,DEPTHID,AGENCY,
     *                    MAGTYPE,MAGAGENCY
C
      common/epicrite/hilat,lolat,hilon,
     *                lolon,minmag,maxmag,minrms,maxrms,mindepth,
     *                maxdepth,minhelat,maxhelat,minhelon,maxhelon,
     *                minhedepth,maxhedepth,ypol,iant,mnupol
      common/epicrit2/fpsolut,eqfelt,statselect
      common/epicrit1/mindist,maxdist,
     *                hypaselect,magaselect 
      common/epicrit3/default,eventtype,disttype,magtypes,volcanictype
      common/epicrit4/minstation,maxstation,stat_present,hypa_present,
     *                maga_present,header_check,wave_check
      common/epicrit5/time1,time2,timcen,all_stat,mingap,maxgap,phase,
     *                stat_phase,hyp_dist
C
      READ(STRING,10,ERR=20)
     *CENTURY,YEAR,MONTH,DAY,HOUR,MINUTES,SEC,DISTANCEID_LOCAL,
     *           EVENTID,LATI,LONG,DEPTH,DEPTHID,AGENCY,
     *           NUMBEROFSTATIONS,RMSVALUE,XMAG(1),MAGT(1),MAGA(1),
     *           XMAG(2),MAGT(2),MAGA(2),XMAG(3),MAGT(3),MAGA(3)
10    FORMAT(1X,2I2,1x,2I2,1X,I2,I2,1X,F4.0,1X,A1,A1,F7.0,F8.0,F5.0,
     *      A1,1X,A3,I3,F4.1,A4,A1,A3,A4,A1,A3,A4,A1,A3)
c
c   if number of stations is there, there might be stations since there will
c   only be a number in the header if the event could be located, therefore
c   check with nstat
c
      if(numberofstations.eq.0) numberofstations=nstat
      goto 25
c
c  give error message and try next record
c
20    CONTINUE
         write(6,*)'Something wrong with input record'
         write(6,'(1x,a)') string
         accepted=.false.
         goto 9999                        ! Return to caller.
25    continue


      ACCEPTED=.FALSE.
      end_of_time=.false.
      start_of_time=.false.
c                                                                               
c   convert to seconds since 1900, even if century is not 1900
c   since this is corrected for below. 
c                                                                               
c
c   add century, assume 1900 if not there 
c
      if(century.eq.0) century=19
      year=year+1900
      call timsec(year,month,day,hour,minutes,sec,time)                        
      time=time+century*timcen
ctest     write(6,*)'temcen,century',timcen,century
ctest             write(6,*)'time,time1,time2',time,time1,time2
         if(time.gt.time2) end_of_time=.true.
         if(time.lt.time1) start_of_time=.true.
         if(end_of_time.or.start_of_time) goto 99
C
C
C     RETURN EPIVALUESPARAMETERS IF NO SELECTION PARAMETERS
C     EXCEPT TIME ARE ACTIVE
C    
      IF(DEFAULT)THEN
            ACCEPTED=.TRUE.
            goto 9999                        ! Return to caller.
      ENDIF
C
C     MAGNITUDE SELECTION, TYPE MUST BE CORRECT OR DEFAULT INDICATED
C     BY MAGTYPES(1).EQ.' '. IF TYPE IS OK, LARGEST MAGNITUDE IS SELECTED
C     OF THE TYPES PERMITTED. IF XMAG IS BLANK, THERE IS NO MAGNITUDE
C
c
c   special option, if magtype is N, only events with no magnitude in 
c   first position is chosen
c
      if(magtypes(1).eq.'N'.and.xmag(1).eq.'    ') goto 501
      if(magtypes(1).eq.'_') magtypes(1)='_'
   
      MAG=-1000.0
C
C   FIRST CHECK IF MAG TYPE OK
C
      MGT=.FALSE.
      IF(MAGTYPES(1).EQ.' ') MGT=.TRUE.
      IF(.NOT.MGT) THEN
         DO IMAG=1,3
            IF(XMAG(IMAG).NE.'    ') THEN
               DO I=1,5
                  IF(MAGT(IMAG).EQ.MAGTYPES(I)) MGT=.TRUE.
                  if(magt(imag).eq.' '.and.magtypes(i).eq.'_') 
     *            mgt=.true.   ! magnitudes with no magnitude type
               ENDDO
            ENDIF
         ENDDO
      ENDIF
      IF(.NOT.MGT) GOTO 99
C
C   SELECT FOR MAGNITUDE SIZE, IF MINMAG IS -990, and
c   maxmag is 999.0, NO SELECTION ON MAG
C
      IF(.not.(MINMAG.eq.-990.0.and.maxmag.eq.999.0)) then
         DO IMAG=1,3
            IF(XMAG(IMAG).NE.'    ') THEN
               DO I=1,5
                  IF(MAGT(IMAG).EQ.MAGTYPES(I).OR.MAGTYPES(1).EQ.' ')
     *            THEN
                     READ(XMAG(imag),'(F4.1)') SMAG
                     IF(SMAG.GT.MAG) THEN
                        MAG=SMAG
                        MAGAGENCY=MAGA(IMAG)
                        MAGTYPE=MAGT(IMAG)
                     ENDIF
                  ENDIF
               ENDDO
            ENDIF
         ENDDO
         IF (MAG.LT.MINMAG.OR.MAG.GT.MAXMAG)GO TO 99
      ENDIF
C
  501 continue                  ! enter here if special mag selection
c
      if (numberofstations .lt. minstation .or.
     *    numberofstations .gt. maxstation) go to 99
C	  
C   SELECT FOR EVENT TYPES
C
      if(disttype(1).eq.'_'.or.disttype(1).eq.'%') then
         disttype(1)='L' 
         disttype(2)='R'
         disttype(3)='D'
      endif
      IF(DISTTYPE(1).NE.' ') THEN
         DO I=1,5
           IF(DISTANCEID_LOCAL.EQ.DISTTYPE(I)) GOTO 50
         ENDDO
         GOTO 99
      ENDIF
 50   CONTINUE
C
C   SELECT ON EVENTTYPE, A BLANK IN NORDIC FILE MEANS EARTHQUAKE,
C   WHICH IS INDICATED BY Q IN SELECTION CRITERIAS. IF EVENTTYPE(1)
C   IS BLANK, ALL EVENT TYPES ARE USED
c
c   if eventtype(1) is '_', is same as blank
C
      if(eventtype(1).eq.'_') eventtype(1)=' '
	  
      IF(EVENTTYPE(1).NE.' ') THEN
	     DO I=1,5
		    IF(EVENTID.EQ.EVENTTYPE(I)) GOTO 55
            IF(EVENTID.EQ.' '.AND.EVENTTYPE(I).EQ.'Q') 
     *      GOTO 55
         ENDDO
         GOTO 99
      ENDIF
 55   CONTINUE
c
c   if there is no location and lat lon depth is not default
c   event is not selected
c
      if (string(24:30).eq.'       ') then
c changed lo 08 March 2001 for seisweb
        if
     *    ((hilat.ne.90.0.or.hilon.ne.360.0.or.lolat.ne.-90.0.
     *    or.lolon.ne.-360.0).and.     
     *    (hilat.ne.90.0.or.hilon.ne.180.0.or.lolat.ne.-90.0.
     *    or.lolon.ne.-180.0)) then
            goto 99
        endif
      endif
      IF (LATI.LT.LOLAT.OR.LATI.GT.HILAT) GO TO 99
      IF (LONG.LT.LOLON.OR.LONG.GT.HILON) GO TO 99
      IF (DEPTH.LT.MINDEPTH.OR.DEPTH.GT.MAXDEPTH) GO TO 99
c
c   negative rms means larger than
c
      IF (maxrms .lt. 0.0) then
          if (rmsvalue .ge. abs(minrms) .and.
     *        rmsvalue .le. abs(maxrms)) goto 999
          goto 99
      else
          if (rmsvalue .lt. minrms .or.
     *        rmsvalue .gt. maxrms) go to 99
      endif

c
c   calling routine for check if event is inside polygon
c
      if (iant .ge. 3) then
          call polos(lati,long,ypol,iant,insidepol)
          if (.not. insidepol) go to 99
      end if

c  
c   check for required hypocenter agencies if wanted, at least one of agencies 
c   in hypaselect must be present to select event
      if (hypa_present .gt. 0) then
          do ind=1,hypa_present
            if (hypaselect(ind) .eq. agency) go to 999
          end do
          go to 99
      end if
c 
c   check for required magnitude agencies if wanted, at least one of agencies
c   in magaselect must be present to select event
      if (maga_present .gt. 0) then
          do ind=1,maga_present
            if (magaselect(ind) .eq. string (61:63)) go to 999
            if (magaselect(ind) .eq. string (69:71)) go to 999
            if (magaselect(ind) .eq. string (77:79)) go to 999
          end do
          go to 99
      end if
C
      GO TO 999
99    ACCEPTED=.FALSE.         
      goto 9999                                ! Return to caller.
999   ACCEPTED=.TRUE.
C
C    Return to caller...
C    ===================
C
9999  return
      END

      subroutine epibase(basename,starttime,endtime,
     *nstat,nphase,nhead,nrecord,typ,exp,data,id,status,compact,nout,
     *ncat_files,cat_files)
c
c     Subroutine to operate on the epicenter database.
c     Routine is called in a loop, and returns one event
c     return variables nstat etc as in main program
c
c     input: basename: e.g. agency 
c            starttime: 14 char standard time
c            endtime:   --------------------- end time
c            century1,century2: start and end century
c            ncat_files : number of cat files
c            cat_files  : cat file names
c     output: standard
c             status: 0: ok
c                     1: end of data base, if -1 on input, just write statistics
      implicit none
c--standard variables
      integer nstat,nphase,nhead,nrecord,id
      character*1 typ,exp
      character*80 data(*)
      character*80 cat_files(*)
      integer ncat_files
      integer nout_start                 ! # events at start of new cat file
      integer n_event_cat                ! coute events in one cat file
c-- number of events selected so far
      integer nout
c-- name of file to read
      character*80 filename	
c! data base name
      character*80 basename	  	
c-- status of read 0: ok 1: end of data
      integer status				
c-- times
      integer time1,time2,time			
      character*14 starttime,endtime
c  help text
c-- epi file name
      character*80 epifile
c  top directory structure
      character*60 top_directory	
c-- century
c-- logicals for file open etc
      logical epi_open,base_open,compact
c--help variables
      integer i2,nfile
      character*1 dchar
C
C    Seisan library inserts and routines...
C    ======================================
C
       include 'libsei.inc'                ! Library definitions & data defns.
       external sei open,                  ! Open file routine.
     &          sei close,                 ! Close file routine.
     &          sei code                   ! Error encoder.
C
      integer*4 
     &          read2,                     ! Ditto 2.
     &          code                       ! Local condition.
      logical*4 b_flag                     ! Flag end of file?.
      character chr_text *(80)             ! Text string.
C
C     *********** End of inserts *********
c
c     inizialize
c
      if(status.eq.-1) goto 999
      status=0
      call dir_char(dchar)
c
c   open epicenter data base meaning finding correct position in list
c   of data base file names according to start time
c
         if(.not.base_open) then
            nout_start=0
c
c  get starttime and end time to nearest month
c
            read(starttime(1:6),'(i6)') time1
            read(endtime(1:6),'(i6)') time2
            write(6,*)' '
c
c  get topdirectory structure
c
            call topdir(top_directory)
            i2=index(top_directory,' ')-1
            base_open=.true.
c
c   find base index file name
c
            filename(1:i2)=top_directory(1:i2)
            filename(i2+1:i2+1)=dchar
            filename(i2+2:i2+4)='REA'
            filename(i2+5:i2+5)=dchar
            filename(i2+6:i2+10)=basename(1:5)
            filename(i2+11:i2+11)=dchar
            filename(i2+12:i2+14)='CAT'
            filename(i2+15:i2+15)=dchar
c           
c   position pointer at first cat file to use 
c
            nfile=0
 450        continue                                    ! loop to find file
               nfile=nfile+1                            ! next file
               if(nfile.gt.ncat_files)     goto 460     ! last file
               epifile=cat_files(nfile)                 ! select file
               read(epifile,'(i6)') time                ! start time of file
C
c   check if containing start time
c
               if(time.gt.time1) then                   ! after start time
                  nfile=nfile-1                         ! back one file
                  if(nfile.le.0) nfile=1
                  goto 470                              ! found, go out
               else
                   goto 450                             ! try next
               endif
c
 460        continue
c
c   no file was found that has a start time equal to or smaller than 
c   requested time. However, if there was at least one cat file covering  
c   several months, start time could be in that file. Therefore try to use 
c   cat file before.
c
            if(nfile.gt.0) then
                 nfile=nfile-1
               if(nfile.le.0) nfile=1
            endif
 470        continue
            nfile=nfile-1     ! -1 since added again before oepning below
         endif                ! end of block finding right first epi file 
c
c  check if epifile is open
c
 475  continue
C
      if(.not.epi_open) then
         nfile=nfile+1
         if(nfile.gt.ncat_files) goto 480
c
c   check that next file is not beyond time limit
c
            epifile=cat_files(nfile)
            read(epifile,'(i6)') time
            if(time.gt.time2) goto 480
            chr_text = filename(1:i2+15) //  ! Construct filename.
     &                 epifile               !
            call sei open( old$,             ! Open file (default=stop on error)
     &                     ' ',              ! Prompt (n/a).
     &                     chr_text,         ! Filename.
     &                     read2,            ! Unit opened on.
     &                     b_flag,           ! Flag.
     &                     code )            ! Returned condition.
c
c   check if compact file
c
            call nortype(read2,compact)      !
            if(compact) write(6,*)' File type is compact'
            epi_open=.true.
            n_event_cat=0                    ! count number of events in file
            nout_start=nout                  ! save # of events selected
            goto 485
C
C    End of list...Close down filenr.lis and return to caller...
C    -----------------------------------------------------------
C
480         continue 
            status=1
            goto 9999                          ! Return to caller.
C
 485        continue
         endif
c
c   read one event
c
        if(.not.compact) then
           call indata(read2,nstat,nphase,nhead,  !
     &                 nrecord,typ,exp,data,id)
        else
           read(read2,'(a)',iostat=code) data(1)  ! Read record.
           call sei code(fort$,                   ! Stop on error.
     &                   code,                    ! Condition.
     &                   read2,                   ! Of fortran unit.
     &                   b_flag)                  ! Flag end of file.
           if( b_flag ) goto 150                  ! & go there!!.
C
           nstat=0
           nphase=0
           nhead=1
           nrecord=1
           typ=data(1)(22:22)
           exp=data(1)(23:23)
           goto 151
 150       continue
              nrecord=0
 151       continue
        endif
c
c   check if end of file
c
 999    continue
        if(nrecord.eq.0.or.status.eq.-1) then
           epi_open=.false.
           if(status.eq.-1) n_event_cat=n_event_cat-1
c
c   write out number of events selected so far and events in cat file
c
           write(6,'(1x,a,2x,a,i7,2x,a,i6,2x,a,i7)') 
     *     epifile(1:10),'No of events:', 
     *     n_event_cat,'Selected:',nout-nout_start,
     *     'Selected total:', nout
           if(status.ne.-1) then
              call sei close(close$,read2,code ) ! Close but stop on error.
              goto 475
           else
              return
           endif
        endif
        n_event_cat=n_event_cat+1              ! count number of events
        status=0
C
C    Return to Caller...
C    ===================
C
9999    return
        end



      subroutine alignnum(reading)
      implicit none
      integer ind, index                    ! index
      integer counter                       ! counter
      character*80 auxreading               ! aux for reading
      character*80 reading                  ! reading

      index = 0
      counter = 0

c-selecting only numeric characters
      do ind = 1,80
         if (reading(ind:ind) .eq. '0'.or. 
     *       reading(ind:ind) .eq. '1' .or.
     *       reading(ind:ind) .eq. '2' .or.
     *       reading(ind:ind) .eq. '3' .or.
     *       reading(ind:ind) .eq. '4' .or.
     *       reading(ind:ind) .eq. '5' .or.
     *       reading(ind:ind) .eq. '6' .or.
     *       reading(ind:ind) .eq. '7' .or.
     *       reading(ind:ind) .eq. '8' .or.
     *       reading(ind:ind) .eq. '9' .or.
     *       reading(ind:ind) .eq. '-' .or.
     *       reading(ind:ind) .eq. '+' .or.
     *       reading(ind:ind) .eq. '.') then
             index = index + 1
             auxreading (index:index) = reading (ind:ind)
         else
             if (reading(ind:ind) .eq. ' ') counter = counter + 1
         end if
      end do
c-if counter ne 80 means some not blank character has been reading
c-if index eq 0 means no valid character has been reading
c-checking if there is some unvalid character
      if (counter .ne. 80 .and. index .eq. 0) then
          index = index + 1
          auxreading (index:index) = '?'
      end if
c-completing variable whit blank
      do while (index .ne. 80)
         index = index + 1
         auxreading (index:index) = ' '
      end do
      reading = auxreading
      end


      subroutine aligncha(reading)
      implicit none
      integer ind, index                    ! index
      character*80 auxreading               ! aux for reading
      character*80 reading                  ! reading

      index = 0

c-moving non blank characters for the begining
      do ind = 1,80
         if (reading(ind:ind) .ne. ' ') then
             index = index + 1
             auxreading (index:index) = reading (ind:ind)
         end if
      end do
c-completing variable whit blank
      do while (index .ne. 80)
         index = index + 1
         auxreading (index:index) = ' '
      end do
      reading = auxreading
      end


      subroutine selcrit_prompt
     *(narg,arg,starttime,endtime,basename,seisweb,
     * web_out)
c
c   routine fills in choises if from prompt line
c
      implicit none
      include 'seidim.inc'
      include 'libsei.inc'
      integer   seiclen    ! function
      integer narg         ! number of arguments
      character*80 arg(*)  ! arguments
      character*14 starttime, endtime !  start time and end time inc. century
c  abs times

      double precision time1,time2,timcen
c  number of stations to be present
      integer           stat_present
      logical       all_stat         ! if true,  all must be present
c  number of hypocenter agencies to be present
      integer           hypa_present
c  number of magnitude agencies to be present
      integer           maga_present
      logical default
      logical seisweb  ! true if called from seisweb
      real minmag, minrms, maxrms, hilat, lolat, hilon, lolon, maxmag,
     *     mindepth, maxdepth,maxgap,mingap,
     *     minhelat, maxhelat,
     *     minhelon, maxhelon,
     *     minhedepth, maxhedepth
      integer minstation, maxstation, i, ind, j
      character*1 eventtype(5), disttype(5), magtypes(5)
      character*7 statselect(50)
      character*4 stat_phase(50)
      integer mindist(50),maxdist(50)  ! distance range for station	
      character*3 hypaselect(10), magaselect(10)
      character*80 basename      ! data base of file name of input
      character*80 userid        ! id for user, used by seisweb
c   fault plane solution
      logical fpsolut
c   earthquake felt
      logical eqfelt
      character*40 wave_check    ! string to identify wave form file name
      character*80 web_out       ! path and file name of web output
      logical header_check
      real ypol(max_polyn$,2)    ! array defining polygon
      integer iant               ! number of points of the polygon
      integer mnupol             ! minumum number of polarities
      integer code               ! error code
      logical hyp_dist           ! if true, use hypocentral distance
      character*4 phase(6)       ! phase names to select
      character*6 volcanictype(10)   ! volcanic subclasses

      common/epicrite/hilat,lolat,hilon,
     *                lolon,minmag,maxmag,minrms,maxrms,mindepth,
     *                maxdepth,minhelat,maxhelat,minhelon,maxhelon,
     *                minhedepth,maxhedepth,ypol,iant,mnupol
      common/epicrit2/fpsolut,eqfelt,statselect
      common/epicrit1/mindist,maxdist,
     *                hypaselect,magaselect 
      common/epicrit3/default,eventtype,disttype,magtypes,volcanictype
      common/epicrit4/minstation,maxstation,stat_present,hypa_present,
     *                maga_present,header_check,wave_check
      common/epicrit5/time1,time2,timcen,all_stat,mingap,maxgap,phase,
     *                stat_phase,hyp_dist

      starttime = '0500'
      endtime ='2050'
      minstation = 0
      maxstation = 999
      hilat = 90.0 
      lolat = -90.0
      hilon = 360.0
      lolon = -360.0
      minmag = -990.0
      maxmag = +999.0
      minrms = 0
      maxrms = 999.0
      mindepth = -99.0
      maxdepth = 99999.0 
      minhelat = .0
      maxhelat = 99999.0
      minhelon = .0
      maxhelon = 99999.0
      minhedepth = -99.0
      maxhedepth = 99999.0
      mingap=0.0
      maxgap=360.0
      do ind = 1,5
         magtypes(ind) = ' '
         disttype(ind) = ' '
         eventtype(ind) = ' '
      end do
      do ind = 1,10
        magaselect(ind)=' '
        hypaselect(ind)=' '
      enddo
      default = .false.
      fpsolut = .false.
      eqfelt = .false.
c
c   return if not enough arguments
c
      if(narg.lt.3) return

c
c   read arguments to fill in choises
c
      do i=1,narg
         if(arg(i)(1:7).eq.'-userid') then
             userid=arg(i)
         endif
         if(arg(i)(1:8).eq.'-web_out') then
            web_out=arg(i+1) 
c
c        clear output file for seisweb call
c
           open(1,file=web_out(1:seiclen(web_out))
     &//'.head',status='unknown')
           endfile 1 
           close(1)                  ! need to be clear up
         endif

         if(arg(i)(1:8).eq.'-seisweb') then
             seisweb=.true.
         endif
         if(arg(i)(1:5).eq.'-base') then
             basename=arg(i+1)
         endif
         if(arg(i)(1:7).eq.'-mgtype') then
             do j=1,5
                magtypes(j)=arg(i+1)(j:j)
             enddo
         endif
         if(arg(i)(1:9).eq.'-disttype') then
             do j=1,5
                disttype(j)=arg(i+1)(j:j)
             enddo
         endif
         if(arg(i)(1:10).eq.'-eventtype') then
             do j=1,5
                eventtype(j)=arg(i+1)(j:j)
                if(eventtype(j).eq.' ') eventtype(j)='%'
             enddo
         endif

         if(arg(i)(1:5).eq.'-area') then
             call sei get values(1,arg(i+1),code)
             lolat=array$(1)
             call sei get values(1,arg(i+2),code)
             hilat=array$(1)
             call sei get values(1,arg(i+3),code)
             lolon=array$(1)
             call sei get values(1,arg(i+4),code)
             hilon=array$(1)
         endif
         if(arg(i)(1:4).eq.'-mag') then
             call sei get values(1,arg(i+1),code)
             minmag=array$(1)
             call sei get values(1,arg(i+2),code)
             maxmag=array$(1)
         endif
         if(arg(i)(1:6).eq.'-depth') then
             call sei get values(1,arg(i+1),code)
             mindepth=array$(1)
             call sei get values(1,arg(i+2),code)
             maxdepth=array$(1)
         endif
         if(arg(i)(1:6).eq.'-nstat') then
             call sei get values(1,arg(i+1),code)
             minstation=array$(1)
             call sei get values(1,arg(i+2),code)
             maxstation=array$(1)
         endif
         if(arg(i)(1:4).eq.'-gap') then
             call sei get values(1,arg(i+1),code)
             mingap=array$(1)
             call sei get values(1,arg(i+2),code)
             maxgap=array$(1)
         endif
         if(arg(i)(1:4).eq.'-rms') then
             call sei get values(1,arg(i+1),code)
             minrms=array$(1)
             call sei get values(1,arg(i+2),code)
             maxrms=array$(1)
         endif
         if(arg(i)(1:5).eq.'-time') then
             starttime=arg(i+1)(1:14)
             endtime  =arg(i+2)(1:14)
         endif
      enddo
c
      return
      end
