C**************************************************************************
c                                                                               
c     Program to pick phase arrival times and write to SEISAN data base.        
c                                                                               
c     Written by Jens Havskov                               
c
ccccccccccccc   mulplt scematically ccccccccccccccccccccccccccccccccccccccccc
c
c  mulplt has 3 important loops where goto is used. below is seen the
c  loop labels (1000, 1100 and 2000) to the right and to the left is shown
c  all instances of goto to these labels.
c
c
c     program start
c
c     initialize mulplt
c        - get parameters from mulplt.def
c        - get iasp synthetic readings
c        - find if input from eev (opmode 0) or filenr.lis (opmode 1)
c          opmode 1 can also be cont data base
c
c---------------------------------------------------------------------------
c
c 1000 continue   ! loop back point for next event, filenr.lis or eev
c
c      if (input from eev, opmode = 0) then
c         if (plot finished) then
c            stop
c            return to eev
c         else
c            read waveform file names from s-file
c            select waveform files to use
c         endif
c      endif
c
c      if(input from filenr.lis, opmode = 1) then     
c         get file name of first or next event
c         if(filename(1:4) = 'cont') then
c             continuous data base input, cwaw=.true.
c             read start time and interval
c             goto 1050
c         endif
c         if(filename = 'filenr.lis') then
c            opmode=2              ! many hard copy plots
c            enter input of multi event plot parameters
c         endif
c      endif
c
c      if(opmode = 2)  then
c         read next waveform file name
c         if(no more files) stop                              --- goto 999
c      endif
c
c      check if waveform file exist and where it is
c
c      if(not exist)   get next event or back to eev          --- goto 1000
c
c      read waveform file(s) headers and initilize variables
c
c      if(opmode = 2) then
c         plot one event, hard copy only
c         back for next event                                ---  goto 1000
c      endif
c
c 1050 continue   
c      if(cwav)
c         read cont event headers
c      endif
c
c      if(opmode.eq.1) make an s-file
c-----------------------------------------------------------------------------
c
c      input of general options 0-6
c
c      if(option 4-6) then
c         continuous plot
c         stop
c      endif
c
c-----------------------------------------------------------------------
c  multi trace mode
c-----------------------------------------------------------------------
c
c      if(option 1-3) then
c
c         additional questions for multi trace option
c
c 1100    continue  ! loop back point for multitrace choices
c
c            -multi trace plot
c            -fk                                         
c            -pick                                      
c            -registation
c            -etc, for all above return to 1100          --- goto 1100
c
c            - go to single channel mode                 --- goto 2000
c
c            - delete s-file                            
c            - merge s-files                            
c            - delete wav-file(s)    
c            - register, input from eev                 
c            - other waveform file       
c            - next event
c            - for all above, return to 1000             --- goto 1000
c      endif
c
c--------------------------------------------------------------------------
c  single trace mode
c--------------------------------------------------------------------------
c
c     if(option 0) then
c
c        additional questions for single trace mode
c
c 2000   continue  ! loop back point when finished one channel
c          - single channel options                      ---- goto 2000
c          - jump to multi trace mode                    ---- goto 1100
c          - end of channels                             ---- goto 99
c        goto 2000
c     endif
c
c 99   continue
c
c      If input from filenr.lis, goto to next event      ---- goto 1000
c
c 999  continue
c
c      possibly send plot to plotter
c
c      close files
c
c      stop
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Latest update:                                                            
c     nov 20         : major clean up for 5.0
C!JAB(BGS)Dec94      : Install file & error handling (libsei)
c     jh jan 95      : file open problem, not properly closed
c     feb 20 95      : add question for hard copy plot
C!JAB(BGS)Mar95      : Accomodate large filenames in commands.
C!JAB(BGS)Mar95      : Accomodate the large suffix filenames.
C!JAB(BGS)Mar95      : If filename given, do not crash out if no filenr.lis
C!JAB(BGS)Mar95        exists!.
c     March 20 by jh : Resolution in mulplt.def file
c     March 21       : Separate resolution in screen and hc
c                      correct bug if readings from next day realtive to
c                      nordic header
C!JAB(BGS)Mar95      : Prevent core crashing for invalid user entry.
c april 10 94 jh     : Bugs with saving pics when not using data base
c april 21 94 jh     : component rotation
c april 26 94 jh     : extrac option for hc
c may 11             : enter both distance id and event type for registration
C!JAB(BGS)Jun95      : Use "sei get file" rather than "sei open" to open wave
C!JAB(BGS)Jun95        files in all cases, except where its pathname has already
C!JAB(BGS)Jun95        been found.
c jun 8       jh     : indicate in boxes if phases read
c jun 9              : fix problem with option OTHER
c sep 21             : disable rotate after traceplot
c oct 95             : new seisinc, add ffmin and ffmax to MULPLT.DEF,
c                      allow omega0 to be less than zero
c dec 95             : continous plotting
c dec 21             : check amplitude
c jan 8 96           : do not use synthetic data if not form the same date
c                      as the readings
c jan 16             : bug in above
c jan 31             : include nhead and nrecord in mulplt.inc
c feb 6              : bug cont. plot
c feb 13             : get distance irrespective of channel
c 5 3 96             : bug iasp in multitrace mode
c 12 3 96            : put routine convert into picsub
c aug 1 96           : fix problems wiht shifts in time  multi trace - single tr
c     8              : one extra return cleared in hc input
c    12              : wrong header in output when not using data base
c    28              : add hourr to commom block
c dec 27             : some modifications to phases: mouse is now blan on sun
c                      as on pc, lg put on = or \, sn has no i or e, L and l
c                      is locate
c feb 12, 97         : bug with hardcopy in single trace mode
c feb 20, 97,        : add write when locate
c bjb(BGS)Mar97	     : allow sub-classes for LV events to be entered in S-file
c                      and phase picks to be saved to s-file
c apr 16, 97 lo      : minor changes on volcanic part to solve Solaris problem
c apr 23, 97 lo      : plot iasp.out phases, when header date in S-file 0709
c aug 2      jh      : convert a sun wav name to pc format if on pc
c oct 97             : muilti file, spectral output
c nov 18             : revision
c dec 3              : output of file
c feb 11 98          : enable seach in several wav data bases
c feb 18             : both p and s velocity for spectral analysis
c feb 25             : fix eev connection
c mar 2              : more -------------
c mar 9
c mar 22             : fix rotation and amplitude
c jul 9  lo          : fix sfile gets lost when merge on solaris
c --------------------------------------------------------------------
c sep 98 jh          : ----------   version 6.0 check ----------------
c                      year 2000, 5 char station names, 5 char base
c oct 7              : bugs
c nov 4  jh          : put logical for linux
c nov 5              : systemc to systemc
c nov 26 98 jh       : add kappa
c jan 04 98 lo       : bug, read 5 characters when register
c jan 7     jh       : bug on merge, enlarge fileds for wav file name
c feb 3              : mores space for box_text
c feb 28             : fix fixed scaling, weigh 8 will not work on sun
c mar 19             : use save in main program
c mar 22 bmt         : include winplot.inc
c may 18 lo          : save fstart and ev_number when starting mulplt
c                    : save sfile when permanent merging
c may 28 jh          : put in FK
c jun 10             : add phase AMP
c jun 13 jh          : main_time to time, wrong addressing
c aug 16             : day was written wrongly in mulplt.out
c aug 26 lo          : fix some text output on Linux
c sep  8 jh          : put waveform file name in mulplt.out
c sep  9 lo          : fix bug in new_s_file
c sep  9 lo          : when register and no phase read, del synth phases
c sep 21 jh          : save menu show to eev so it can get back to mulplt
c sep 22             : add fk reading
c sep 30             : bug in above
c oct  1 lo          : read CODA AUTO as 0/1
c oct  4             : bug in above
c oct 22 jh          : new picsub, revise channel selection
c nov 5              : add variable long_text to copy files to wav, text too
c                      short
c nov 28             : variable channelname put into mulplt.inc in order to fix
c                      amplitude picking in multi trace mode
c dec 10             : put in response spectrum, channels name in mulplt
c                      mide, fixed in picsub
c feb 16 2000 jh     : option for plotting output ffrom modeling directly
c feb 29             : add copy_wav_dir to copy directly to data base
c april 2000         : new waveform structure
c may 25 2000 lo     : fix call for extract in fk
c may 30      jh     : error with hard copy plotting
c may 31      jh     : terminate PostScript file also on quit
c jun 5              : option o in single trace fixed in case of defaults
c jun 18      jh     : error when jumping intoi single trace mode from
c                      channel other then one
c october 20         : do not use upper character e and i for phases, I used
c                      for iasp option
c Nov 5, 2000        : ******** MAJOR CLEAN UP ************************
c Jan 14 2001        : fix bug so it is possible to pick more than one iasp
c                      phase for one staiton in multi trace mode
c jan 24             : more filters choises for ml, mb and ms
c feb 14             : pathname stripped from wavefilename for registration
c                    : user selected filters defined in MULPLT.DEF
c                    : FILTER_TYPE defined to allow use of bndpas or recfil
c                    : Year and month for wave database registration changed
c                    : to use header variables rather than filename syntax
c feb 20          lo : Changed length of xhead
c mar 9           jh : bug in routine write_s_file, no error check on write
c apr  23         jh : remove last check for hard copy, caused crash at end
c june 14         jh : change a filter from 0.8 haz to 1.25 hz
c sep 11             : def wa-filter set to 8 poles
c nov 11             : extract from cont data base
c nov 18             : back option in multi trace mode
c feb  1, 2002    lo : write out message when register s-file,used by seisantool
c feb 7           jh : do not allow filter lower than 0.1 for cont mode
c april  2003     jh : multiple screens for one event, extract to wavetool,
c                      also extract filtered and response corrected traces,
c                      stations alphabetical
c june 25         jh : 1000 channels and files, multiple selection screens
c july 10         lo : ask for stat/comp for continuous plotting
c july 21         jh : G and N to g and n for crustal phases
c sep 4           jh : make it possibel to quit after reg. in cont. mode
c oct 3           lo : set time_scale to 0 at 1100 to fix linux problem
c dec 2004        jh : seed 
c jan 12 2005     jh : fix some menu problems
c mar 11 2005     jh : initilize n_wav_file and n_wav_del to 0, not doing so
c                      created problem for wav deletiopn on linux
c jun 20 2005     jh:  plt to eps
c nov 11 2005     jh:  initialize cwav and cseed
c mar 06 2006     lo : added selection of continuous databases
c mar 24 2006     lo : init cseed at start
c jan    2006     rl : some changes, set n_wav_file=0 after 1000
c jun 1  2006     jh : Above, nsynt also set to zero, so iasp option from
c                      mulplt did not work, nsynt=0 commented out
c mar 15 2007     jh : do not use nsort_distance_save, dist can only be 
c                      turned on
c jul 30 2007     lo : write file to give cbase to wavetool
c oct    2007     lo:  read list of continuous databases from file
c oct 16 2007     jh : add init of mem function
c feb 13 2008     lo : add particle motion
c apr 25 2008     jh : change ms and mb filters, see manual version 8.2
c sep 12 2008     jh : small change in writing out waveform file name
c oct 23 2008     jh:  error in format writing out in cbase.inp, made soemtimes
c                      a blank in form of base on Linux
c
c        implicit none           ! does not work on pc due to graphics include
        include 'winplot1.inc'  ! dummy on unix
        include 'mulplt.inc'    ! mulplt includes
        include 'seiplot.inc'
        include 'seisan.inc'

c          
c-- operator
       character*4 operator
c       logical cseed  in common block                         ! if true, part of large seed file
c-- header for plot                                   
       character*160 xhead			
       character*80 question                                                    
c-- path to seismo                             
       character*60 top_directory		
c-- answer                                            
       character*1 answer			
c-- directory for s files                             
       character*40 s_dir			
c--  file number when reading many from filenr.lis
       integer filenumber
       integer n_wav_file                       ! # wav files in s-file
       integer n_wav_out                        ! # wav files selected
       integer n_wav_del                        ! # ------ for deletion
       integer n_wav_mer                        ! # ------ for merging
       character*80 wav_file_text               ! info on wav files(s)
       character*40 extra_wav                   ! extra wav file from S-file
c                                                 used with synthetics
c-- general text                                       
       character*80  text,text1 
       character*80  file_out                   ! complete wav name
       character   long_text*200
c-- time scal ein cm/sec                                
       real time_scale				
c-- multi trace start time                              
       real start_time				
c-- multi trace stop time                                
       real stop_time				
c-- stop_time - start_time                                  
       real window				
      logical  one_plot         ! true if one plot made
      character*10      keys                    

c-- single channel windows, not used presently       
       real wt1(max_trace),wt2(max_trace)                     
c-- save filter for option 0
c       real flow_def,fhigh_def ! now in common block 6-98
       integer filt_def
c-- operation mode 0: with SEISAN                        
c--       integer opmode	in common block			
c         0: single files, from eev 
c         1: mult. fil., 2: many file auto hard copy only plot
c                                                                               
c-- counters for above
      integer nsynt			
      character*10 synt_head  ! date of synthetic records
      character*80 data1(max_data)
c-- unit for default file
      integer def_unit
c-- Length in sec. of datafile                           
      real total_time				
c-- plot option, see below                              
      integer p_option				
      integer old_plotoption         ! save plot option
      integer npick                  ! number of time picking routine is called form traceplot
c-- Vector with selected channels                 
      integer old_chan(max_trace)			
c-- Number of selected channels                            
      integer nchan,old_nchan				
c-- See routine: 'indata'                      
      integer nstat,nphase		
c-- counters                                    
      integer i,j,k,l,ichan,x
c-- See routine: 'indata'                            
      character*1 type,exp			
c-- type and kind
      character*2 type_kind
c-- Indicator if default parameters are chosen                   
      logical default                
c-- filename of datafile including path                              
      character*80 filen			
c-- filename of datafile excluding path (bjb)                              
      character*80 trace_file			
c-- --------------------          
c-- name of current S file                             
      character*80 xsfile
c-- ---- new--- after registration                 
      character*80 new_sfile			
      character*5 stat_def(max_trace)
      character*4 comp_def(max_trace)   ! default channels
      integer nchan_def                       ! number of -----
      integer channelname_win(max_trace) ! initial selection of channels for multi windows
c-- dummy                                              
      character*6 dummy				
c-- See above                                            
      integer iswitch				
c-- id line number 
      integer id
c--- for extract of cont data
      double precision window_abs_time
      integer year,month,day,hour,min
      real sec
c-- .true. if a file exists                          
      logical exist				
c-- defualt for input parameters
      logical default_org
c-- save number of channels before interactive multi channel selection
      integer nchan_initial
c-- indicate if baz has been calculated
      logical no_baz
c-- directory separator
      character*1 dchar
c-- computer type
      logical pc,sun,linux
      character*5 station_code
      character*4 component_code
      character*(5) cbase_sel(max_cont) 


C--Variables for volcanic sub-classification
c bjb 18/3/97 
c
C-- comment line in VOLCANO.DEF
      CHARACTER*80 	comment
c-- User entered sub-class flag 
      CHARACTER*6	sub_class_flag
c-- sub-class descriptor
c      CHARACTER*40  	sub_class_descriptor
c-- sub class code
      CHARACTER*6       s_class(60)
c-- sub class number 
      INTEGER           n_class(60)
c-- user entered number 
      INTEGER           n_select
c-- sub-class description array
      CHARACTER*40  	description
c-- true if sub_class is in s_class()
      LOGICAL  		valid_class
c-- full pathname of VOLCANO.DEF
      CHARACTER*80	vol_file
c-- bjb variables for last dir character
      integer r_index,lastsl
      character*4 cwavyear
      character*2 cwavmon



C
C    SEISAN library inclusions...
c    ----------------------------
C
      include 'libsei.inc'                 ! Library definitions & data defns.
      external sei get file,               ! Find & open file.
     &         sei get values,             ! Extract from text string.
     &         sei open,                   ! File open handler.
     &         sei close,                  ! & closure.
     &         sei real num,               ! Extract real number from string.
     &         sei integer,                ! Extract integer from string.
     &         sei clen,                   ! Length of string.
     &         sei code                    ! Error condition handler.
      integer  sei clen,                   ! & function.
     &         sei integer                 ! Ditto.
      real     sei real num                ! Ditto.
      integer  code,                       ! Condition.
     &         ix,                         ! Very local.
     &         read1,                      ! Read unit1.
     &         read2,                      ! Ditto 2.
     &         read4,                      ! & 4.
     &         write1,                     ! Write unit1.
     &         write2,                     ! Ditto 2.
     &         write44,                    ! 
     *         readfk,
     *         any_unit
      logical  b_flag,                     ! Flag!!
     &         b_filenr                    ! Using filenr.lis?.
C
C    ------- End of details -------
      include 'version.inc'
       include 'winplot2.inc'
c                                                                               

c
c print version
c
      out_version_date='July 23, 2001'
      if (version_new) out_version_date=version_date
      call print_ver
cccccc    inizialize     ccccccccccccccc                                        
c     b_f_debug$ = .true.
      b_filenr$  = .false.      !JAB(BGS)Mar95. Not using filenr.lis yet!
      max_count  = 0            ! for fixed scaling
      no_baz=.true.    ! initially, no back azimuth angles have been calculated
      one_plot=.false. ! no plot made yet
      wav_interactive=.true.
c lot 24/03/2006, problem on RH Enterprise Linux
      cwav=.false.
      cseed=.false.

c-- postscript hard copy                                          
      hctype=1		
      rotate=.false.      ! cfix
c	  
c-- x-window size in % max
c
      wsize=90.0
c
c  initilize memory handling
c
      call wav_mem_init
c
c  position top frame in multi trace mode
c
      max_ypos=678.0
c
c  graphic display not yet open
c
      disp_open=0
c
c  by default, no default are chosen
c
      default=.false.
      default_org=.false.
      current_seq_chan=0     ! no active channel in traceplot
      npasses=0              ! filter
      cont_window=.false.    ! no change to window for cont plotting
      n_wav_file=0           ! initialy 0
      n_wav_del=0            ! initially 0
c
c                                                                               
c   get path to seismo                                                          
c                                                                               
      call topdir(top_directory)                                                
c
      call dir_char(dchar)   ! directory separation character
c
c   get computertype
c    
      call computer_type(sun,pc,linux)
c
c  no operator
c
      operator='    '
c                                                                               
c   agency directory by default                                                    
c                                                                               
      s_dir='                                        '                          
      do i  = 1,16                                                              
        phase(i) = ' '                                                          
      enddo                                                                     
      do i = 1,max_trace                                                       
        channelname(i) = 0                                                      
      enddo                                                                     
c                                                                               
c---------------------------------------------------------------------------                                                                               
c  get default parameters from MULPLT.DEF.  
c---------------------------------------------------------------------------
c
       call get_mulplt_def(def_unit,stat_def,comp_def,                        
     + nchan_def)     
c        
c   get seisan defaults
c
      call get_seisan_def

c---------------------------------------------------------------------                                                                               
c   get synthetic readings if file iasp.out exists    cccccc                          
c---------------------------------------------------------------------
c
       call get_synt(nsynt,synt_head)
c
c---------------------------------------------------------------
c   look for s-file reference to check if from eev                             
c---------------------------------------------------------------
c
      call get_env_event(sfile)
      call put_env_event(sfile)    ! put back in so iasp can use it
c
      opmode=0                     ! default from eev
      if(sfile(1:3).eq.'   '.or.ichar(sfile(1:1)).eq.0) then
         opmode=1
         nrecord=0
         nhead=0
         sfile='mulplt.out'   ! make an initial s-file
         open(1,file=sfile,status='unknown')
         write(1,*)
         close(1)
      else
         extra_wav=' '  ! initially no extra wav file
         call get_env_string(text)  ! get options from eev
c        write(6,*)'mulplt eev mes',text
         if(text(1:1).eq.'o'.or.text(1:1).eq.'O') then
           default=.true.
           default_org=.true.
           filt_def=filt
         endif
         read(text(3:8),'(i6)') event_no    ! get event number
         read(text(12:12),'(i1)') show_menu  ! get menu show option
         extra_wav(1:40)=text(40:79)
         seisan_base=text(16:20)
         eev_start_time=text(21:34)
      endif

c
c-----------------------------------------------------------------------
c-----------------------------------------------------------------------
c   enter here if: 
c   1: one or several waveform files deleted from s-file
c   2: merge  
c   3: next from eev
c   4: next or previous file from filenr.lis
c   5: select other waveform files
c------------------------------------------------------------------------
c
 1000 continue                                          
c
c   initialize waveform file info
c
      call wav_init
c     nsynt = 0                 ! RL 1/2006
      n_wav_file = 0            ! RL 1/2006


c
c-----------------------------------------------------                                                                     
c-- data base, next file or other actions, from eev                                                 
c-----------------------------------------------------
c
       if(opmode.eq.0) then
c
c   directly from data base, select eev action if one plot already done
c   and return to eev
c
         if(one_plot) then
               text= ' '
               text(1:10)=keys
               write(text(12:12),'(i1)') show_menu  ! save menu option
               call put_seisan_message(text(1:seiclen(text)))
               stop
         endif
         one_plot=.true.   ! if passing here, there must come a plot
c
c   read old  picks
c
         call read_s_file
c
c   find if any waveform files
c
         if(extra_wav.eq.' ') then            ! no special wav file from EEV
            call auto_tr(data,nhead,n_wav_file,wav_filename)
            if(n_wav_file.eq.0) then   ! if no waveform, stop, if single file
               write(6,*)' No waveform file name in S-file'
               write(6,*)' Return to continue'
               call flush (6)
               read(5,'(a)') i
               keys(1:4)='    '          ! go  back to same event
               goto 1000
            endif
c
c   select file(s) to use if more than one if all defaults not chosen
c
            if(n_wav_file.gt.1.and.(.not.default)) then
               plotoption=0           ! only display
               call open_display      ! 
               call wav_select(n_wav_file,n_wav_out)                            
               call clear_to_alpha
c
c   stop if no files selected
c
               if(n_wav_out.eq.0) then
                  write(6,*) ' Waveform files not selected'
                  write(6,*) ' Return to stop'
                  read(5,'(a)') i
                  stop
               endif
            else
                n_wav_out=n_wav_file  ! use all if default or one if not def.  
            endif
            default=default_org       ! default could have been diabled, if
                                      ! optin other wav file used
         else            ! for separate wav
            wav_filename(1)(1:40)=extra_wav
            n_wav_out=1
         endif
      endif
c                                                                               
c-------------------------------------------------------------------            
c   next file from filenr.lis                                          
c-------------------------------------------------------------------            
c                                                                               
c                                                                               
c   get waveform data file name if single files are used, if question is
c   #Next_file#, then the next number is chosen from filenr.lis AND
c   no question is asked. if question is #Back_file#, previous file
c   is used and no question asked.
c                                                                               
      if(opmode.eq.1) then
         call wav_init              ! new file
         n_wav_out=1                ! only one file at a time  
         sfile='mulplt.out'                            !mar19
         if( b_filenr$      .and.                      !JAB(BGS)Mar95. Next!!.
     &       (question(1:11) .eq. '#Next_file#'.or.
     &        question(1:11) .eq. '#Back_file#' )) then 
             continue                                  !JAB(BGS)Mar95.
         else                                          !JAB(BGS)Mar95.
            question=                                                          
     *    ' Filename, number, filenr.lis (all), cont for cont base,'//
     *    ' conts for large SEED'                                 
         endif
         call filename(question,wav_filename(1))
c
c   check if continuous data bases
c
         if(wav_filename(1)(1:4).eq.'cont')
     *   then
            cwav=.true.
            cseed=.false.
            if(wav_filename(1)(5:5).eq.'s') cseed=.true. ! large seed volume
            if(.not.cseed) then
                write(6,*) 'Give start time, yyyymmddhhmmss'
                read(5,'(a)') cwav_start_time
                write(6,*) 'Interval in min'
                read(5,*) cont_interval
                cont_interval=cont_interval*60.0
c
c select waveform databases
c
                plotoption=0           ! only display
                call open_display      ! 
                call cbase_select(cont_base,cont_base_def,n_cont_base,i)
                n_cont_base=i
                n_cont_base_sel=i
c
c save selection, this is overwritten by calls to get_seisan_def
c
                if (n_cont_base_sel.eq.0) then
                   write(*,*) ' no database selected '
                   stop
                 endif
                 call clear_to_alpha
             endif
             if(cseed) then
                cwav=.false.
 500            continue
                question=' Seed file name or number'                              
                call filename(question,wav_filename(1))

	        inquire(file=wav_filename(1),exist=exist)
	        if(.not.exist) then
	           write(6,*) ' No such file, try again'
	           goto 500
	        endif 
                call wav_init
                call read_wav_header(1)
                write(6,*)
                write(6,*) ' Available data in SEED file'
                write(6,'(a,a)')
     *          ' STAT  COMP LO YEAR MO DA HR MN    SEC',
     *          ' DUR: DA HR MN  SEC'
                do i=1,wav_nchan
                   min=wav_duration(i)/60.0
                   sec=wav_duration(i)-min*60.0
                   hour=min/60.0
                   min=min-hour*60.0
                   day=hour/24.0
                   hour=hour-day*24.0
                   write(6,'(1x,a5,1x,a4,1x,a,1x,i4,4i3,f7.3,
     *             5x,i3,1x,i2,1x,i2,f5.1)') 
     *             wav_stat(i),wav_comp(i),wav_location(i),
     *             wav_year(i),
     *             wav_month(i),wav_day(i),wav_hour(i),wav_min(i),
     *             wav_sec(i),day,hour,min,sec
                enddo
                WRITE(6,*)
                write(6,*) 'Give start time, yyyymmddhhmmss,',
     *          ' enter for start time in first channel'
                read(5,'(a)') cwav_start_time
                IF(cwav_start_time.eq.' ') then
                  write(cwav_start_time,'(i4,5i2)') 
     *            wav_year(1),
     *            wav_month(1),wav_day(1),wav_hour(1),wav_min(1),
     *            int(wav_sec(1)+0.1) ! make sure start in first block
                endif
                write(6,*) 'Interval in min'
                read(5,*) cont_interval
                cont_interval=cont_interval*60.0
            endif
            call cwav_time_limits(0)  ! set times
            goto 1050
         endif
c
         b_filenr = wav_filename(1)(1:10).eq.'filenr.lis' .or.   
     *              wav_filename(1)(1:10).eq.'FILENR.LIS'        
c
c   clear question
c
         question(1:11)='           '                                          
c-- no more files                    
         if(wav_filename(1)(1:3).eq.'EOF') goto 999          
c
         if( b_filenr ) then                           !JAB(BGS)Mar95.
            opmode=2                                                            
            display_type=0    ! make sure nothing is sent to x
c
            call sei open( old$,              ! Open old file.
     &                     ' ',               ! No prompt.
     &                     'filenr.lis',      ! This filename.
     &                     read2,             ! On this unit.
     &                     b_flag,            ! Existance?.
     &                     code )             ! Returned consition (n/a).
c                                                                               
c   get scaling parameters                                                      
c                                                                               
            write(6,*)' Resolution in cm/sec, ',                                
     *              '0: plot all on one page (default)'                         
            call flush (6)
            read(5,'(a)') text                                                  
            if(text(1:5).eq.'     ') then                                       
               time_scale=0.0                                                   
            else
            time_scale = sei real num( text, code ) ! Get time.
            code = e_ok$                            ! Ignore conversion errors.
            endif                                                               
            write(6,*)
     *      ' Low and high cut for filter, return for no filter'
             call flush (6)
             read(5,'(a)') text
             if(text(1:4).eq.'    ') then
               filt=0
             else
c-- use index 9 for variable filter
                call sei get values( 2, text, code )   ! Extract 2 values.
                code = e_ok$                           ! re-store.
                flow(9) = array$(1)                    ! Retrieve.
                fhigh(9)= array$(2)                    ! Ditto.
                filt=9
             endif
         endif                                                                  
      endif
c
c----------------------------------------------------------------------                                                                               
c   many files to plot sequentially, names in filenr.lis                                     
c-----------------------------------------------------------------------
c
      if(opmode.eq.2) then                                                      
         call wav_init
         n_wav_out=1
         read(read2,'(2x,i3,2x,a)',iostat=code) filenumber,
     *   wav_filename(1)
         call sei code( fort$, code, read2, b_flag )             ! Process e.
         if( b_flag ) goto 999                                   ! end of file.
c-- no more files                        
         if(wav_filename(1)(1:5).eq.'     ') goto 999	
      endif                                                                     


c
c-------------------------------------------------------------------------------
c   check if file(s) exist, read waveform file(s) headers
c-------------------------------------------------------------------------------
c

c
c   file name text
c
       wav_file_text=' '
       if(n_wav_out.gt.1) then
          wav_file_text='Many waveform files'
       else
          wav_file_text=wav_filename(1)(1:seiclen(wav_filename(1)))
       endif
c
c   check if files exist and where
c
       k=0
       do i=1,n_wav_out
          call  get_full_wav_name(wav_filename(i),file_out)
          if(file_out.eq.' ') then
              write(6,'(1x,a,a)') ' No such file: ',
     *        wav_filename(i)(1:seiclen(wav_filename(i)))
         else
            k=k+1
            wav_filename(k)=file_out
         endif
       enddo                       
c
c   action if no files available, assume that if opmode 2, file must exist
c
       if(k.eq.0) then            !
         write(6,*)' No waveform files found, return to continue'
         read(5,'(a)') i
         keys(1:4)='    '    
         goto 1000
       endif                                
c                                                                               
c   read all header information from all files selected or available           
c                              
       wav_nfiles=k
       do i=1,wav_nfiles
          call read_wav_header(i)
          if(wav_nchan.gt.max_trace) then
              write(6,*)' Too many channels'
              write(6,*)' Return to stop'
              read(5,'(a)') k
              stop
          endif   
       enddo
       write(6,'(a,a)')' Read headers from files:'
       do i=1,wav_nfiles
          write(6,'(1x,a)') wav_filename(i)(1:80)
       enddo                          

c                                                                               
c  set default start time and window                                            
c                                                                               
       start_time=0.0       
       total_time=wav_total_time                                                    
       window=wav_total_time                                                        
       stop_time=start_time+window                                              
c                                                                               
c--------------------------------------------------------------------------     
c   if in multi event only hard copy plotting mode, do it here                       
c--------------------------------------------------------------------------     
c                                                                               
       if(opmode.eq.2) then                                                     
c-- only hard copy plot                                   
          p_option=3				
c-- resolution                                           
          resolu=resolu_hc
c-- use all channels                         
          nchan=wav_nchan 		
          do i=1,wav_nchan                                             
             channelname(i)=i                                                   
          enddo                                                                 
c                                                                               
c   plot header for traceplot                                                   
c                                                                               
          do i=1,160
            xhead(i:i)=' '
          enddo
          xhead(1:28)=wav_header_text(1)(1:28)
          xhead(30:30)=' '
          xhead(31:)  =wav_file_text(1:seiclen(wav_file_text))
c
c   check for null chars
c
          do i=1,160
            if(ichar(xhead(i:i)).eq.0) xhead(i:i)=' '
          enddo
c                                                                               
c   open plot file                                                              
c                                                                               
          call sei open( unknown$,      ! Open file.
     &                   ' ',           ! No prompt.
     &                   'mulplt.eps',  ! This file.
     &                   plotunit,      ! On this unit.
     &                   b_flag,        ! Existance.
     &                   code )         ! Condition not applicable.
c--                             
          plotoption=p_option-1			
c
c  sort after distance or time
c
      call channel_order(wav_stat,wav_delay,nchan,nsynt)                   
c
c                                                                               
c   plot                                                                        
c                                                                               
         call open_display      ! display here is only postscript file

c
         call traceplot                                                         
     *   (nchan,time_scale,start_time,stop_time,wav_delay,xhead)
c
c   close plot in post script file
c
         if(hctype.eq.1)  call close_post                                
c                                                                               
c   send hard copy plot to laser                                             
c                                                                               
         call sei close( close$, plotunit, code ) ! Close (stop on error).
         call send_plot("mulplt.eps",10)
         write(6,*)' ...Plotfile sent'
c
c   go back for next event                                                      
c                                                                               
         goto 1000                                                              
      endif                                                                     
c                                                                               
c-------end of multiplot hard copy only--------------
c
c
c-----------------------------------------------------------------
c   cont multiple data bases
c-----------------------------------------------------------------
c

 1050 continue   ! enter here if cont mode

      if(cwav.or.cseed) then
         
         if(cseed) then
            call wav_seed_read_header_interval ! find position in file of window
         else
            call cwav_read_bases   ! read all base info in interval
         endif
c                                                                              
c  set default start time and window                                            
c                                                                               
         start_time=0.0       
cx         total_time_window=cwav_abs_end_time-cwav_abs_start_time
         window=wav_total_time
cx         window=total_time_window
         stop_time=start_time+window
      endif

c--------------------------------------------------------------------------
c
c  if this is a run without data base, put in time in header from
c  main header currently used, no check on change of day !!!!!!!!
c
      if(opmode.eq.1) then
         do i=1,80
            data(1)(i:i)=' '
            data(2)(i:i)=' '
            data(3)(i:i)=' '
            data(4)(i:i)=' '
         enddo
         write(data(1)(2:5),'(i4)') wav_year(wav_first)
         write(data(1)(7:20),'(2i2,1x,2i2,f5.1)') wav_month(wav_first),
     *   wav_day(wav_first),wav_hour(wav_first),wav_min(wav_first),
     *   wav_sec(wav_first)
         data(1)(22:22)='L'
         data(1)(80:80)='1'
c
c   put in waveform file name, if cont base, not correct
c
         data(2)(2:seiclen(wav_filename(1))+1)=
     *   wav_filename(1)(1:seiclen(wav_filename(1)))
         data(2)(80:80)='6'
         data(3)(1:57)=
     *   ' STAT SP IPHASW D HRMM SECON CODA AMPLIT PERI AZIMU VELO '           
c         data(3)(58:80)='SNR AR TRES W  DIS CAZ7'
         data(3)(58:80)='AIN AR TRES W  DIS CAZ7'
         nhead=3
         nrecord=4
c
c   write s-file
c
         call write_s_file
      endif

c          
c----------------------------------------------------------------------         
ccccc     General options entred here         
c----------------------------------------------------------------------
c

c
c   set the default plotting option
c
      p_option=1          
c
c   check if in default multichannel mode
c
      if(.not.default) then   ! get input
c
c   get plotting output device and type of plot, make sure 
c   not in graphics mode                                 
c                         
         call clear_to_alpha
c                                                      
2222     write(6,*)'                                                   '          
         write(6,*)' Plot options: Interactive picking          Return '         
         write(6,*)'               Multi trace plot on screen, def (0) '  
         write(6,*)'               Multi trace plot on screen      (1) '           
         write(6,*)'               Multi trace plot on screen+laser(2) '           
         write(6,*)'               Multi trace plot on laser       (3) '
         write(6,*)'               Continuoues on screen           (4) '
         write(6,*)'               Continuoues on screen + laser   (5) '
         write(6,*)'               Continuoues on laser            (6) '
         write(6,*)                                                          
     *             '               Stop                            (q) '
         call flush (6)
         read(5,'(a)') dummy                                                       
         if(dummy(1:1).eq.'q'.or.dummy(1:1).eq.'Q') goto 999
         if(dummy(1:1).ne.' ') then
            ix = sei integer( dummy, code )        
            if( code .ne. e_ok$ ) then             
               write(*,*)'****       ... try again...'
               goto 2222                           
            else if(ix.lt.0.or.ix.gt.6) then
               write(*,*)                             
               write(*,*)                             
     &         '** WARN: option is out of range ...try again      **'
               goto 2222                              
            end if                                 
 2639       continue
            write(6,*)                                                          
     *      ' Low and high cut for filter, return for no filter'                  
            call flush (6)
            read(5,'(a)') text                                                  
            if(text(1:4).eq.'    ') then                                        
               filt=0                                                           
            else                                                                
c-- use index 9 for variable filter   
               call sei get values( 2, text, code )   ! Extract 2 values.
               code = e_ok$                           ! re-store.
               flow(9) = array$(1)                    ! Retrieve.
               fhigh(9)= array$(2)                    ! Ditto.
               filt=9
               flow_def=flow(9)
               fhigh_def=fhigh(9)                                                  
c
c   check filter lower bound in cont mode
c
               if(ix.gt.3.and.flow(9).lt.0.1.and.flow(9).gt.0.0) 
     *         then
                  write(6,*)
     *            ' In this mode, lowest filter can only be 0.1'
                  write(6,*)
     *           ' Use low pass instead by gving 0 as low cut'
                  goto 2639
               endif
       
            endif                
            filt_def=filt                                               
         endif
c
c   check if all defaults
c
         default=.false.
         if(dummy(1:1).eq.'0') then
           default=.true.
           default_org=default
           dummy(1:1)='1'
         endif

         read(dummy,'(i1)') p_option                                               
c-- default output on screen                                
         plotoption=0
      endif
c
c   put in default filter
c
      if(default) then
         flow(9)=flow_def
         fhigh(9)=fhigh_def
         filt=filt_def
      endif
      if(p_option.gt.1) then                              
c-- for graphics device                              
          plotoption=p_option-1			
      endif
c
c----------------------------------------------------------------------
c CONTINOUES PLOTTING, ONE CHANNEL
c----------------------------------------------------------------------
c
      if(p_option.ge.4.and.p_option.le.6) then
        plotoption=p_option-4
         write(6,*)' Seconds pr line'
         call flush (6)
         read(5,*) page_time
         if(opmode.eq.0) then
            write(6,*)' End time (ymd..), return is to end of month'
            call flush (6)
            read(5,'(a)') eev_end_time
         endif
         write(6,*)' Max count'
         call flush (6)
         read(5,*) max_count
         write(6,*)' Number of lines pr page'
         call flush (6)
         read(5,*) k
         if(k.lt.1) k=1
c         write(6,*)' Channel number'
c         call flush (6)
c         read(5,*) current_chan
          write(6,*) ' Station code, 5 chars max '
          call flush (6)
          read(5,'(a5)') station_code
          write(6,*) ' Component code, 4 chars max '
          call flush (6)
          read(5,'(a4)') component_code
          
c
c  open plot file if needed
c
         if(plotoption.ge.1) then                              
             call sei open( unknown$,      ! Open file.
     &                      ' ',           ! No prompt.
     &                      'mulplt.eps',  ! This file.
     &                      plotunit,      ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
         endif                                                                 
c 
c open display, could be just postscript file
c
         call open_display
c
c   plot continoues, put in original name without path in order to
c   be able to find event in filenr.lis, could be read form TMP if
c   decompressed
c
c         call plot_cont(k,wav_file_text)
         call plot_cont(k,wav_file_text,station_code,
     &    component_code)
c
         call clear_to_alpha                                                 
         stop
      endif
                                                                              
c                                                                               
c----------------------------------------------------------------------         
c MULTI CHANNEL OPTIONS                                                          
c----------------------------------------------------------------------         
c                                                                                
      if(p_option.gt.0) then                                                    
c
c   check if plotting parameter should be entered
c
        if(.not.default.and.p_option.eq.3) then
c                                                                               
c   get scaling parameters                                                      
c                                                                               
            write(6,*)' Resolution in cm/sec, ',                                
     *                 '0: plot all on one page (default)'                      
            call flush (6)
            read(5,'(a)') text                                                  
            if(text(1:5).eq.'     ') then                                       
               time_scale=0.0                                                   
            else                                                                
               time_scale = sei realnum(text,code) ! Extract real number.
               code       = e_ok$                  ! Restore.
            endif                                                               
c                                                                            
c   get window                                                                  
c                                                                               
            window=stop_time-start_time                                         
            write(6,277) start_time,window                                      
 277        format(1x,'Selected start time and window is:',2f8.1,              
     *      ' Ok, else enter new value?')                                    
            call flush (6)
            read(5,'(a)' )text                                                 
            if(text(1:4).ne.'    ') then                                  
               call sei get values( 2, text, code ) ! Extract 2 variables.
               code = e_ok$                         ! Restore.
               start_time = array$(1)               ! Retrieve.
               window     = array$(2)               !
               if(start_time.eq.0.0.and.window.eq.0.0) window=total_time        
               if(window.eq.0.and.start_time.ne.0.0)                            
     *            window=total_time-start_time                                  
               stop_time=start_time+window                                      
            endif                                                              
c
c   now enter defaults
c
        else
           time_scale=0.0 
           window=stop_time-start_time
        endif
c                                                                               
c   show (if not default) which channels selected and possibly select others                     
c
        call channelselect(wav_nchan,wav_stat,wav_comp,                       
     *  nchan,nchan_def,stat_def,comp_def,default)
c
c   save all selected channel numbers, could be more than used for one screen
c
c        write(17,*)' save org'
        do i=1,nchan
           channelname_org(i)=channelname(i)   ! the new total selection
c           channelname_win(i)=channelname(i)   ! the origial total selection used for the first windows
        enddo
c
c   save original number of channels, used if several screens are plotted
c
        nchan_org=nchan
c
c   set screen number
c
        n_screen=1
c
c   clear to alpha if no screen plot
c
        if(p_option.eq.3) call clear_to_alpha                                                 
c
c   stop if zero number of channels, can be caused by a q in selection
c
        if(nchan.eq.0) goto 999
c
c   reset default, could have been temporaryly disabled
c

        default=default_org
c
c---------------------------------------------------------------------------
c---------------------------------------------------------------------------
c   Main loop start point in multitrace mode, come back here after most
c   choises
c---------------------------------------------------------------------------
c---------------------------------------------------------------------------
c
 1099   continue
c
c   select channels for screen number n_screen
c   channelname_org: channels selected after initial channel selection screen
c                    or after selection when all windows has been plotted
c   channelname_win: the original selection for each window
c
c
c  when starting a new set of windows, save the chennel selection available
c  then. thsi selection might be different form the very first selection due
c  to selection in the multi trace window so cannelname_org migh have been
c  chages in picsub
c
        if(n_screen.eq.1) then     ! new set of windows
           do i=1,nchan_org
              channelname_win(i)=channelname_org(i)
           enddo
           do i=nchan_org+1,max_trace
              channelname_win(i)=0
           enddo
c
c   for first screen, calculate totoal number of windows to show 
c
        total_n_screen=(nchan_org-1)/n_chan_screen +1
c        write(17,*) total_n_screen
        endif
c
c   now select channels for window
c
        l=1
        nchan=0
c        write(17,*) 'nscreen before',n_screen
        k=(n_screen-1)*n_chan_screen+1
        do i=k,k+n_chan_screen-1
c           write(17,*) 'i,chan', i, channelname_org(i)
           if(channelname_win(i).gt.0) then
               channelname(l)=channelname_win(i)
               nchan=nchan+1
               l=l+1
           else  ! no more channels to plot, return to first screen next time
c               n_screen=0
           endif
        enddo
c        write(17,*) 'nchna,nscreen',nchan,n_screen

        if(nchan.eq.0) then       ! could be that last screen has zero channels, then go to first
          n_screen=1
          goto 1099
        endif
        nchan_initial=nchan_org
c
c------------------------------------------------------------------
c   enter here for replot
c------------------------------------------------------------------
c
 1100   continue
 
        time_scale=0.  ! lo 03/10/2003

c
c  check if change of window in cont plotting
c
        if(cont_window.and.(cwav.or.cseed)) then
           cont_window=.false.
           call cwav_time_limits(1)             ! calculate new lim         
	     if(cseed) then
              call wav_seed_read_header_interval ! find position in file of window
           else
              call cwav_read_bases   ! read all base info in interval
           endif
           call wav_index_total  ! testing this


c                                                                              
c  set default start time and window                                            
c                                                                               
           start_time=0.0       
           window=wav_total_time
           stop_time=start_time+window
        endif
c          write(6,*)' wav_total_time',  wav_total_time
c 
c                                                                               
c   plot header for traceplot                                                   
c                                                                               
        do i=1,160
           xhead(i:i)=' '
        enddo
        i=index(filen,' ')                                               
        xhead(1:28)=wav_header_text(1)(1:28)
        xhead(30:30)=' '
        xhead(31:)  = wav_file_text            
c
c   check for null chars
c
        do i=1,160
           if(ichar(xhead(i:i)).eq.0) xhead(i:i)=' '
        enddo
c                                                                               
c   Get old picks                                                               
c                                                                               
        call read_s_file
c
c   add synthetic readings if any
c
        call add_synt_readings(nsynt,synt_head)
c                                                                               
c  plot, set resolution to 1000 if on screen, else 3000 (defaults)
c                                                                               
        resolu=resolu_x
        if(p_option.gt.1) resolu=resolu_hc
c
c  sort after distance or time
c
        call channel_order(wav_stat,wav_delay,nchan,nsynt)                               
c
c   check if baz angles should be calculated
c
        if(rotate.and.no_baz) then
            call get_baz
     *      (wav_nchan,wav_stat,data,nhead,nrecord,baz)
            no_baz=.false.      ! indicate that baz has been calculated
        endif
c
c   close plot file if open to make sure that another plot is not put on top
c   this means that if a replot is made, only the last plot can be sent for
c   hardcopy
c
        if(plotoption.ge.1.and.plotunit.gt.10)  then 
           call sei close( close$, plotunit, code ) ! Close (stop on error).
        endif
c
c
c  open plot file if needed
c
        if(plotoption.ge.1) then                              
             call sei open( unknown$,      ! Open file.
     &                      ' ',           ! No prompt.
     &                      'mulplt.eps',  ! This file.
     &                      plotunit,      ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
        endif                                                                 
c 
c open display, could be just postscript file
c
        call open_display

c
c   clear menu choises
c
         do i=1,13
           onbox(i)=0
         enddo
         do i=15,42
           onbox(i)=0
         enddo
c
c   multi trace plot
c
        call traceplot                                                         
     *  (nchan,time_scale,start_time,stop_time,wav_delay,xhead)

c
c--------------------------------------------------------------------------
c particle motion plot
c--------------------------------------------------------------------------
c
        if(do_pmp) then
          call plot_pm(start_time,stop_time)
        endif

c
c   reset temporary settings due to hc plot and submit plot
c
        if(choice.eq.'HCAL') then
           do l=1,old_nchan
              channelname(l)=old_chan(l)
           enddo
           call close_post                               
           call sei close( close$, plotunit, code ) ! Close (stop on error).
           nchan=old_nchan
           plotoption=old_plotoption
           call send_plot("mulplt.eps",10)
           resolu=resolu_x
        endif
c
c   count number of calls to pic routine
c
        npick=0
c                                                                               
c   activate channel select if not only hardcopy is made, also enter here
c   for more choices
c   if only hard copy done, choice is assumed to be the next event
c
        if(p_option.eq.3) choice='FINI'
c
c--------------------------------------------------------------------------
c   block where interactive graphics is used
c--------------------------------------------------------------------------
c
        if(p_option.le.2) then     ! remain in graphics mode                                                  
c
c   save old channel selection if only one selected, might want to
c   got back to old selection
c   also used when resetting for temporary hc plot
c
           do i=1,nchan
              old_chan(i)=channelname(i)
           enddo
           old_nchan=nchan
c
c---------------------------------------------------------------------------
c   get up cursor for choises
c---------------------------------------------------------------------------
c

           call chasel(nchan,wt1,wt2,start_time,stop_time)
c
c--------------------------------------------------------------
c   Multiple window handling
c--------------------------------------------------------------
c

           if(choice.eq.'NEXW') then
c
c   only go to next screen if all channels of current screen are selected
c
c               if(nchan_org.eq.nchan_initial) n_screen=n_screen+1
               n_screen=n_screen+1
               if(n_screen.gt.total_n_screen) n_screen=1
c               write(17,*) 'nscreen new', n_screen
               choice=' '
               goto 1099
           endif

c
c--------------------------------------------------------------------------
c   check if pick, remain in picking loop as long as picks are chosen
c--------------------------------------------------------------------------
c
           do while(choice.eq.'PICP') 
              npick=npick+1
              call add_synt_readings(nsynt,synt_head)
              iswitch = 0  ! convert readings before calling picking routine
              call convert(wav_abs_time(wav_first),
     *        wav_stat(current_chan),                     
     +        wav_comp(current_chan),                            
     +        iswitch)
              chan_delay=start_time 
              first=1
              call tecpic
              chan_delay=0.0  ! make sure no delay if going into s. chan. mode
              iswitch = 1  ! convert readings  back to nordic format
              call convert(wav_abs_time(wav_first),
     *        wav_stat(current_chan),                     
     +        wav_comp(current_chan),                               
     +        iswitch)                                         
c                          
c   save any new picks
c          
              if(npick.gt.0) then
                npick=0
                call write_s_file
              endif
c
c   get cursor up, if a pick, remain in picking loop, else continue
c
              call chasel(nchan,wt1,wt2,start_time,stop_time)       
           enddo
c
c----------------------------------------------------------------------------
c  hard copy of all
c---------------------------------------------------------------------------
c
           if(choice.eq.'HCAL') then
              do i=1,wav_nchan
                 channelname(i)=i
              enddo
              nchan=wav_nchan
              old_plotoption=plotoption
              plotoption=1                  ! temporarely reset plot option
              resolu=resolu_hc
              goto 1100                     ! hc plot
           endif
c
c---------------------------------------------------------------------------
c check if help
c---------------------------------------------------------------------------
c
           if(choice.eq.'HELP') then
              call mulplt_help            ! print help file
              goto 1100                   ! replot		   
           endif
c
c--------------------------------------------------------------------------
c iasp
c--------------------------------------------------------------------------
c
           if(choice.eq.'IASP') then
              call systemc('iasp',4)        ! calculate synthetic phases
              call get_synt(nsynt,synt_head)   ! read synthetic phases
              goto 1100
           endif
c
c---------------------------------------------------------------------------
c check if write out of waveform file, either isolated or to use with FK
c---------------------------------------------------------------------------
c
           if(choice.eq.'WOUT'.or.choice.eq.'FK  ') then
c
c   open and write in file for choises to wavetool program
c
              call sei open( unknown$,     ! Open file.
     &                      ' ',           ! No prompt.
     &                      'extract.inp', ! This file.
     &                      any_unit    ,  ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
c
              window=stop_time-start_time
              write(any_unit,*) nchan
              do i=1,nchan
                 if(cwav.or.cseed) then ! cont use first sample and whole window
                    write(any_unit,'(i3,a)') channelname(i),' 0.0 0.0'
                 else
                    write(any_unit,'(i3,1x,2f10.3)')
     *              channelname(i),start_time,window
                 endif
              enddo
              call sei close( close$, any_unit, code )
              wave_out=.false.
c
c   filter resp text
c

              text=' '
              if(filt_old.gt.0) then
                  write(text,'(a,2f10.4)') 
     *            ' -filter ',filt_old_low,filt_old_high
              endif
              if(remove_response_old.eq.1) then
                   write(text(31:43),'(a,i3)') ' -ground ',
     *             disp_vel_old
              endif
c              write(17,*) filt_old,disp_vel_old,
c     *                    remove_response_old
c
c   extract/wavetool file
c
              if(cwav.or.cseed) then
	           if(cseed) then
	              window_abs_time=wav_abs_time(wav_first)
     *              +start_time
	           else
                    window_abs_time=cwav_abs_start_time+start_time
	           endif
                 call sectim
     *           (window_abs_time,year,i,month,day,hour,min,sec)
                 i=sec+0.5
                 write(text,'(i4,5i2)')year,month,day,hour,min,i
                 do i=1,14
                    if(text(i:i).eq.' ') text(i:i)='0'
                 enddo
                 write(text1(1:10),'(f10.1)') window

                if(cseed) then
                 if (choice.eq.'FK  ') then
                   long_text='wavetool -start '//text(1:14)//
     *             ' -cwav -duration '//text1(1:10)
     *             //' -chansel extract.inp -wav_out_file waveform.out'
                 else
                   long_text='wavetool -start '//text(1:14)//
     *             ' -cseed -duration '//text1(1:10)
     *              //' -sfile '//sfile(1:seiclen(sfile))
     *             //' -chansel extract.inp -wav_out_file SEISAN'
                 endif
                else           !  cwac  option
                 if (choice.eq.'FK  ') then
                   long_text='wavetool -start '//text(1:14)//
     *             ' -cwav -duration '//text1(1:10)
     *             //' -chansel extract.inp -wav_out_file waveform.out'
                 else
                   long_text='wavetool -start '//text(1:14)//
     *             ' -cwav -duration '//text1(1:10)
     *             //' -chansel extract.inp -wav_out_file SEISAN'
c
c only selected databases
c
                   if (n_cont_base_sel.gt.0) then
                     call sei open( unknown$,     ! Open file.
     &                      ' ',           ! No prompt.
     &                      'cbase.inp', ! This file.
     &                      any_unit    ,  ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
                     do i=1,n_cont_base_sel
c                     long_text=long_text(1:seiclen(long_text))//
c     *                 ' -cbase '//
c     *                 cont_base(i)(1:seiclen(cont_base(i)))//' ' 
                       write(any_unit,'(a)')
     *                 cont_base(i)(1:seiclen(cont_base(i)))//' ' 
                     enddo
                     call sei close( close$, any_unit, code )
                     long_text=long_text(1:seiclen(long_text))//
     *                 ' -cbase cbase.inp '
                   endif
                 endif
                endif
              else     ! a normal file
                 if (choice.eq.'FK  ') then
                   long_text='wavetool -sfile '//sfile(1:seiclen(sfile))
     *             //' -chansel extract.inp -wav_out_file waveform.out'
                 else
                   long_text='wavetool -sfile '//sfile(1:seiclen(sfile))
     *             //' -chansel extract.inp -wav_out_file SEISAN'
     *             //text(1:42)
                 endif
              endif

              write(6,*) long_text
c              write(17,*) long_text
              call systemc(long_text,seiclen(long_text))
              if(choice.ne.'FK  ') goto 1100    ! replot
           endif
c
c--------------------------------------------------------------
c    FK analysis if waveform file has been written out
c--------------------------------------------------------------
c
           if(.not.wave_out.and.choice.eq.'FK  ') then
              call systemc('fk',2)
              fk=.false.
c
c     some problem to make sei open work
c
c   open file with results
c
c             call sei open( old$+ignore$,            
c    &               ' ',                     ! No prompt.
c    &               'fk.out',                ! This file.
c    &               readfk,                  ! On unit.
c    &               exist,                   ! File exists?.
c    &               code )                   ! Condition.
c
c    File exists and is open!!..
c
             open(29,file='fk.out',status='old',err=9362)
             goto 9361
 9362        continue
             write(6,*)' No fk.out file'
             goto  9365
 9361        continue
             readfk=29
c            if(exist) then
                do i=1,8
                   read(readfk,'(a)',err=9364) text
c                  write(6,'(a)',err=9364) text
                enddo
c
c   check if results
c
                if(text(2:9).eq.'APPARENT') then
                   read(text(21:25),'(f5.1)',err=9364) veli
                   read(text(45:48),'(i4)',err=9364) k
                   azim=k
                   goto 9365
                else
                   write(6,*)' No FK values were selected'
                   veli=0
                   azim=0
                   goto 9365
                endif
 9364           continue
                write(6,*)' Something wrong with fk.out'
 9365           continue
c               call sei close( close$, readfk, code ) ! Close 
                close(29)
              choice='    '      ! clear FK choice
              goto 1100          ! replot
           endif

c
c----------------------------------------------------------
c check if locate event
c----------------------------------------------------------
c
           if(choice.eq.'LOCA') then
               call clear_to_alpha
c
c   if no data base, put name mulplt.out in as an s-file for location
c
              if(opmode.eq.1) call put_env_event('mulplt.out')
              call systemc('hyp',3)  ! locate and put screen output
                                      ! in hyp.tmp
              write(6,*)' Return to continue'
			  call flush (6)
			  read(5,'(a)') text      ! pause for input
c
c   make an iasp.out file with theoretical arrival times
c
              call make_res_file(nrecord,data,nsynt) ! calulate residual
              synt_head=data(1)(1:10)
              call add_synt_readings(nsynt,synt_head)
              goto 1100               ! replot             
           endif
c
c-------------------------------------------------------------------
c   check if quit
c------------------------------------------------------------------
c
           if(choice.eq.'QUIT') then
              goto 999                                            
           endif
c
c----------------------------------------------------------------------
c   replot traces with new choice of parameters, if any picks were made
c   go to reread picks
c-----------------------------------------------------------------------
c
           if(choice.eq.'REPL') then
              goto 1100
           endif
c
c-------------------------------------------------------------------                        
c   check if going into pick mode, toggle mode
c-------------------------------------------------------------------
c
           if(choice.eq.'TOGL') then
             if(plotoption.ge.1)
     *       call sei close( close$, plotunit, code ) ! Close (stop on error).
             i=0
             goto 2000      ! this is far below in single trace plotting
           endif
c
c---------------------------------------------------------------------
c   check if merge of multiple files
c-------------------------------------------------------------------
c
           if(choice.eq.'MERG') then
              call wav_select_mer(wav_nfiles,n_wav_mer)
           endif
c
c----------------------------------------------------------------
c   check if multi file delete, then display delete box
c----------------------------------------------------------------
c
           if(choice(1:4).eq.'DEL '.and.n_wav_file.gt.1) then
              call wav_select_del(wav_nfiles,n_wav_del)            
c
c   replot traces, if no files deleted or at least 2 selected for merge.
c   go to reread picks
c
              if((choice(1:4).eq.'DEL '.or.choice(1:4).eq.'MERG').and.
     *        n_wav_del.eq.0.and.n_wav_mer.lt.2.and.opmode.eq.0) then
                 goto 1100
              endif
           endif

        endif           ! this endif is end of options in graphics mode
c
c---------------------------------------------------------------------
c   for the remaining options, screen must be cleared and cursor moved
c   to text window 
c---------------------------------------------------------------------
c
        call clear_to_alpha                                                          
c
        write(6,*)
c
c-------------------------------------------------------
c   Delete S-file
c------------------------------------------------------
c
        if(choice.eq.'DELS'.and.opmode.eq.0) then
          write(*,*) ' deleting s-file ...'  ! lot 22-04-2002
           keys(1:4)='D   '
            goto 1000
        endif
c 
c---------------
c   merge files
c---------------
c
        if(choice.eq.'MERG'.and.n_wav_mer.gt.1) then
c
c   write s-file so merge can be done
c
              xsfile = sfile
              call write_s_file

c
c   make a list of files to merge for extract
c
              call sei open( unknown$,          ! Open file.
     &                      ' ',           ! No prompt.
     &                      'extract.inp', ! This file.
     &                      any_unit    ,  ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
c
              do i=1,n_wav_mer
                  write(any_unit,'(7x,a)') wav_filename(i)
              enddo
              call sei close( close$, any_unit, code )
c
c   merge files
c
              long_text='wavetool -wav_files extract.inp'// 
     *        '  -wav_out_file SEISAN'
              write(6,*) long_text
              call systemc(long_text,seiclen(long_text))
c
c   find if merge was ok
c
              call get_message('extract',text)
              if(text(1:2).ne.'OK') then
                 write(6,*)' Merged failed ************'
                 write(6,*)' Return to continue        '
                 call flush (6)
                 read(5,'(a)')text 
              else
                 filen(1:60)=text(3:62)   ! new file name
c
c   read s-file with new name of waveform file
c
                 sfile = xsfile
                 call read_s_file
c
c   remove merged files from s-file if more than one
c
                 if(n_wav_mer.gt.1) then
                    k=2
                    do i=2,nrecord
                      if(data(i)(80:80).eq.'6'.and.data(i)(1:1).eq.'*')
     *                then
                         continue    ! just skip line
                      else
                         data(k)=data(i)
                         k=k+1
                      endif
                    enddo
c
c   put in new name of merged file in line 2
c
                    do i=nrecord,2,-1
                       data(i+1)=data(i)
                    enddo
                    data(2)=' '
                    data(2)(2:61)=filen(1:60)
                    data(2)(80:80)='6'
                    nrecord=nrecord-n_wav_mer+1
                    nhead=nhead-n_wav_mer+1
                    data(nrecord)=' '
                 endif 
c
c   write s file again
c
                 call write_s_file
c
c  go and select again from very start
c
cx                 keys(1:4)='    '   ! same event in eev
                 one_plot=.false.   ! do not return to eev
                 goto 1000
              endif
        endif

c
C---------------------------------------------------------------------                                                    
C   DELETE FILES ?                                                         
C-------------------------------------------------------------------
c          
        if(choice.eq.'DEL ') then                                            
           if(choice.eq.'DEL ') 
     *     WRITE(6,'(a,$)')
     *  '  SURE YOU WANT TO DELETE WAVEFORM FILE (Y/N) ??????? '        
           call flush (6)
           READ(5,'(A1)') answer                                             
           IF(answer.EQ.'Y'.or.answer.eq.'y') then                      
c
c-- CLOSE and DELETE FILE(S)
c
c   check if one or several of many files to delete 
c
c suggested change RL 1/20006, kept at 0 lot
c               if(n_wav_del.gt.1) then   ! many files, must be from s-file
c               if(n_wav_del.gt.0) then   ! many files, must be from s-file
                if (opmode.eq.0) then    ! lot 17/05/2006
                  do i=1,n_wav_del       ! delete
                     if(sun.or.linux) then
                         write(text,'(a,a)')'rm ',wav_filename(i)(1:60)
                      else
                         write(text,'(a,a)')'del ',wav_filename(i)(1:60)
                      endif
c no delete from s-file                       call systemc( text,seiclen(text) )
                  enddo
c
c   remove deleted files from s-file
c
                  k=2
                  do i=2,nrecord
                     if(data(i)(80:80).eq.'6'.and.data(i)(1:1).eq.'*')
     *               then
                        continue    ! just skip line
                     else
                        data(k)=data(i)
                        k=k+1
                     endif
                  enddo
                  nrecord=nrecord-n_wav_del
                  nhead=nhead-n_wav_del
                  data(nrecord)=' '
c
c   convert possible readings and write the corrected s-file
c
                  iswitch=0
                  call convert(wav_abs_time(wav_first),
     *            wav_stat(current_chan),                     
     +            wav_comp(current_chan),                            
     +            iswitch)
c
c   write s-file
c
                  call write_s_file
c
c  go and select again from very start
c
                  keys(1:4)='    '   ! same event in eev
                  one_plot=.false.
                  goto 1000
               else
c
c   one input file
c                     
                  if(sun.or.linux) then
                     write(text,'(a,a)')'rm ',wav_filename(1)(1:60)
                  else
                     write(text,'(a,a)')'del ',wav_filename(1)(1:60)
                  endif
                  call systemc( text,seiclen(text) )
 
                  if(opmode.eq.1) then
                     if(default) then
                        question(1:11)='#Next_file#'
                     else
                        question(1:11)='           '
                     endif
                  endif
c
c-- new event                                       
c
                  keys(1:4)='NEXT'   ! in case from eev
                  goto 1000   
               endif   ! endif of delete many files
           endif       ! endif of confirm delite
c
c   if here, assumed wrong choice,  close plot file (if any)
c   and replot
c
           if(plotoption.ge.1) call sei close( close$,   ! Close plot.
     &                                      plotunit, ! Unit.
     &                                      code )    ! Condition (n/a).
           goto 1100                                                             
        endif            ! endif of delete section                                                    
c
c---------------------------------------------------------------------                                                                               
c   register  (put) event using eev                                                              
c---------------------------------------------------------------------
c
        if(choice.eq.'PUT '.and.opmode.eq.0) then
           write(*,*) ' register existing s-file ... '
           keys(1:3)='REG'
           goto 1000
        endif          
c
c---------------------------------------------------------------------                                                                               
c   register  (put) event  using filenr.lis or cont base                                                           
c---------------------------------------------------------------------
c          
        if(choice.eq.'PUT ') then                            
           write(6,*)                                                         
           WRITE(6,'(a,$)')
     &  '  ENTER EVENT TYPE L,R OR D '
           call flush (6)
           READ(5,'(A2)')TYPE_kind                                                 
 846       CONTINUE                                                           
           IF(TYPE_kind(1:1).EQ.'l') type_kind(1:1)='L'                                           
           IF(TYPE_kind(1:1).EQ.'d') type_kind(1:1)='D'                                           
           IF(TYPE_kind(1:1).EQ.'r') type_kind(1:1)='R'                                           
           IF(TYPE_kind(1:1).NE.'L'.AND.TYPE_kind(1:1).NE.'D'
     *        .AND.TYPE_kind(1:1).NE.'R') THEN               
              WRITE(6,*)' WRONG TYPE, TRY AGAIN'                              
              call flush (6)
              READ(5,'(A2)') TYPE_kind                                             
              GOTO 846                                                        
           ENDIF                                                              

C bjb 18/3/97 
C If a local volcanic event then we want register a sub class defined in
C the file VOLCANO.DEF located in the DAT directory.
C The format of this file will be one line of text (80A) followed by
C i2,1x,6A,1X,40A for number, code, space, description
c
c next lines moved down to be run only if 'V' LO, 04.97
c
c      valid_class=.FALSE.
c      sub_class_flag='  '
c
           IF(TYPE_kind(2:2).eq.'v') TYPE_kind(2:2)='V'
              IF(TYPE_kind(1:1).eq.'L'.and.TYPE_kind(2:2).eq.'V') THEN

c
c call routine to select subclass, lo May 27, 2002
c
              call select_volcano_subclass(sub_class_flag)
 
c              valid_class=.FALSE.
c              sub_class_flag='  '
cC Create path name for VOLCANO.DEF on sun or PC
c              vol_file=top_directory(1:60)
c              vol_file(seiclen(top_directory)+1:
c     *        seiclen(top_directory)+1)=dchar
c              vol_file(seiclen(vol_file)+1:seiclen(vol_file)+3)='DAT'
c              vol_file(seiclen(vol_file)+1:seiclen(vol_file)+1)=dchar
c              vol_file(seiclen(vol_file)+1:)='VOLCANO.DEF'
c
c              CALL sei open(check$,
c     &                  ' ',
c     &                  vol_file,
c     &                  0,
c     &                  exist,
c     &                  code)
c              IF(.not.exist) THEN 
c                 WRITE(6,*)
c     *           'Warning: Cannot find VOLCANO.DEF file in DAT dir'
c                 GOTO 3413
c              ENDIF
cc
cC If we are here then we want to open up VOLCANO.DEF file and print to
cC the screen and let the user select which code he wishes to enter
cC in line 1 col 56
cc
c              CALL sei open(old$,
c     &                ' ',
c     &                 vol_file,
c     &                read2,
c     &                exist,
c     &                code)
c 3922         READ(read2,'(a80)') comment
c              WRITE(6,*)' '
c              WRITE(6,*) comment
c
c              WRITE(6,*)'---------------------------------------'
c              Write(6,*)'Number Sub-Class Description'
c              WRITE(6,*)'---------------------------------------'
c              DO i=1,60
c                 READ(read2,'(i2,1x,a6,1x,a40)') n_class(i),s_class(i),
c     &                                    description
c                 WRITE(6,'(4x,i2,1x,a6,4x,40a)') n_class(i),s_class(i),
c     &                                    description
c
c                 IF(description.eq.'QUIT') GOTO 3923
c              ENDDO
c 3923         CONTINUE
c              WRITE(6,*)'---------------------------------------'
c              WRITE(6,*) 'Please Enter number for sub-class : '
c              call flush (6)
c              READ(5,'(i2)') n_select 
cC Test for valid sub_class code number
c              DO i=1,60
c                 IF(n_select.eq.n_class(i)) then
c                    valid_class=.TRUE.
c                    sub_class_flag=s_class(i)
c                    WRITE(6,*)'Sub-class ', sub_class_flag, ' selected.'
c                 endif
c              ENDDO
c              IF(.not.valid_class) THEN
c                 WRITE(6,*)'Invalid Sub-class code. Try again'
c                 REWIND(read2)
c                 GOTO 3922
c              ENDIF
c              CALL sei close(close$,read2,code)
           ENDIF        ! end of volcanic section

c
c   get operator code
c
 3413     continue    ! enter here if no operator code
          if(operator.eq.'    ') then
             write(6,*)' Give operator code (max 4 char)'
             call flush (6)
             read(5,'(a4)') operator
             write(6,*)
     *     ' Give 2-5 letter data base, ,, for local dir,',
     *     ' return for default base'
             call flush (6)
             read(5,'(a5)')s_dir(1:5)
             if (s_dir(1:1).ne.' ') then
                do x=2,5
                   if (s_dir(x:x).eq.' ') s_dir(x:x)='_'
                enddo
             endif
             if(operator.eq.'    ') goto 3413
          endif
c     
c take out the synthetic phases for register , lo 09/99
c
          do k=1,nrecord
             data1(k)=data(k)
          enddo
          do k=1,max_data
                data(k) = ' '
          enddo
          i=0
          do k=1,nrecord
               if (data1(k)(10:10).ne.'y') then
                 i=i+1
                 data(i) = data1(k)
               endif
           enddo
           nrecord = i
c
c   generate extract file if cont data base or large seed volume 
c
           if(cwav.or.cseed) then

c
c   open and write in file for choises to extract program
c
              call sei open( unknown$,     ! Open file.
     &                      ' ',           ! No prompt.
     &                      'extract.inp', ! This file.
     &                      any_unit    ,  ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
c
              window=stop_time-start_time
              write(any_unit,*) nchan
              do i=1,nchan
                 write(any_unit,'(i3,a)') channelname(i),' 0.0 0.0'
              enddo
              call sei close( close$, any_unit, code )
              wave_out=.false.
c
c   extract file
c
              if(cseed) then
                 window_abs_time=wav_abs_time(wav_first)+
     *           start_time
	        else
                  window_abs_time=cwav_abs_start_time+start_time
              endif
              call sectim
     *        (window_abs_time,year,i,month,day,hour,min,sec)
              i=sec+0.5
              write(text,'(i4,5i2)')year,month,day,hour,min,i
              do i=1,14
                 if(text(i:i).eq.' ') text(i:i)='0'
              enddo
              if(cwav) then
              write(text1(1:10),'(f10.1)') window
                long_text='wavetool -start '//text(1:14)//
     *          ' -cwav -duration '//text1(1:10)
     *          //' -chansel extract.inp -wav_out_file SEISAN'
c
c only selected databases
c
c                   do i=1,n_cont_base_sel
c                     long_text=long_text(1:seiclen(long_text))//
c     *                 ' -cbase '//
c     *                 cont_base(i)(1:seiclen(cont_base(i)))//' ' 
c                   enddo
                   if (n_cont_base_sel.gt.0) then
                     call sei open( unknown$,     ! Open file.
     &                      ' ',           ! No prompt.
     &                      'cbase.inp', ! This file.
     &                      any_unit    ,  ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.

                     do i=1,n_cont_base_sel
                       write(any_unit,'(a)')
     *                 cont_base(i)(1:seiclen(cont_base(i)))//' '
                     enddo
                     long_text=long_text(1:seiclen(long_text))//
     *                 ' -cbase cbase.inp '
                     call sei close( close$, any_unit, code )
                   endif

              else
                write(text1(1:10),'(f10.1)') window
                long_text='wavetool -start '//text(1:14)//
     *          ' -cseed -duration '//text1(1:10)
     *           //' -sfile '//sfile(1:seiclen(sfile))
     *          //' -chansel extract.inp -wav_out_file SEISAN'
              endif

              write(6,*) long_text
              call systemc(long_text,seiclen(long_text))
c
c   get file name
c
              call get_message('extract',long_text)
c
c   check if ok
c
              if(long_text(1:2).ne.'OK') then
                  write(6,*)
     *            ' Something wrong with wavetool, return to continue'
                  read(5,'(a)') i
                  goto 1100
              else
                  trace_file=' '
                  trace_file(1:29)=long_text(3:31)
              endif
              CALL new_s_file(year,month,
     *            day,hour,min,sec,type_kind, 
     *            s_dir,trace_file,new_sfile,data,operator,
     *            sub_class_flag,nhead,nrecord)
           else
c
c    case of normal file
c    bjb 2001/02/13 Remove path from filename if normal waveform file
c
              lastsl=r_index(wav_filename(1),dchar)
              trace_file=wav_filename(1)(lastsl+1:)

              CALL new_s_file(wav_year(wav_first),wav_month(wav_first),
     *            wav_day(wav_first),wav_hour(wav_first),
     *            wav_min(wav_first),
     *            wav_sec(wav_first),type_kind, 
     *            s_dir,trace_file,new_sfile,data,operator,
     *            sub_class_flag,nhead,nrecord)
           endif
c  
c-- CHECK IF S-FILE ALREADY EXIST, this section the same for single files
c   and cont data base
c
           call sei open( check$,              ! Check file exists.
     &                      ' ',                 ! No prompt.
     &                      new_sfile,           ! This filename.
     &                      0,                   ! Unit (n/a).
     &                      exist,               ! File exists?.
     &                      code )               ! Condition (n/a).
           write(6,*)                                                         
           write(6,'(a,2x,a)')' S-file name: ',new_sfile(1:
     &              seiclen(new_sfile))
           if(exist) THEN                                                     
                write(6,*)' S-FILE ALREADY EXISTS, OPTIONS ARE:       '
                write(6,*)' Ignore (leave old event)            Return'
                write(6,*)' Overwrite duplicate                 o     '
                write(6,*)' Create new event, different ID:     n     '
                call flush (6)
                READ(5,'(A1)') answer
c
c   overwrite
c
                IF(answer.EQ.'o'.OR.answer.EQ.'O') THEN                         
                   WRITE(6,*)' REALLY, REALLY SURE ?'
                   call flush (6)
                   READ(5,'(A1)') answer                                        
                ENDIF
c
c   ignore
c 
                if(answer.eq.' ') then
                   write(6,*)' Event not registered, return to continue'
                   call flush (6)
                   read(5,'(a)') answer
                   answer=' '   ! make sure a y do not come here
                endif
c
c   new id
c
                if(answer.eq.'n'.or.answer.eq.'N') then
                   i=seiclen(new_sfile)
                   k=1
 5857              continue
                   write(6,*) ' Creating a new id for event'
                   call inc_id(data(2),new_sfile,i) ! id line is assumed to be in line # 2
                   inquire(file=new_sfile,exist=exist)
                   k=k+1
c
c   check if not too many duplicates
c
                   if(k.gt.59) then
                      write(6,*)
     *                ' Cannot make a duplicate,',
     *                ' more than 60 events with same second'
                      write(6,*)' Return to stop'
                      call flush (6)
                      read(5,'(a)') answer
                      stop
                   endif
                   if(exist) then
                      goto 5857    ! try again
                   else
                      answer='y'   ! accept new event
                   endif
                endif
           ELSE                  ! file do not exist
                WRITE(6,739)                                           
 739            FORMAT(' GO AHEAD (Y/N)')              
                call flush (6)
                READ(5,'(A1)') answer                                           
           ENDIF                                                              
C                                                                               
C  OPEN AND WRITE S-FILE                                                        
C                                                                               
           if(answer.EQ.'Y'.OR.answer.EQ.'y') then                            
              call sei open( unknown$,        ! Open file.
     &                      ' ',             ! No prompt.
     &                      new_sfile,       ! This file.
     &                      write44,         ! On this unit.
     &                      b_flag,          ! exist
     &                      code )           ! Condition (n/a).

              WRITE(write44,'(A80)',iostat=code)
     &                 (DATA(I),I=1,nrecord) ! Write record.
c             WRITE(6,'(A80)',iostat=code)
c    &                 (DATA(I),I=1,nrecord) ! Write record.
              call sei code( fort$, code, write44, b_flag )     ! Process outcome.
              call sei close( close$, write44, code )           ! Close down.
c
c   now write following picks to data base, but only if not cont
c
              if(.not.cwav) then
                 sfile=new_sfile                 ! mar 19
                 call put_env_event(sfile)       ! mar 19, make sfile available
             
c
c   optinally start a process
c
              if(auto_process.gt.0) then
                 if(auto_process.eq.2) then
                    write(6,'(a,a)') ' Run process(y/return=n)? '
     *              ,auto_process_name
                     call flush (6)
                     read(5,'(a1)') answer
                     if(answer.eq.'y'.or.answer.eq.'Y') then
                        call systemc(auto_process_name,10)
                     endif
                  else
                     call systemc(auto_process_name,10)
                  endif
              endif  ! end of start a process
                  
c
c run hypocenter
c
              if(auto_locate.gt.0) then
                 if(auto_locate.eq.2) then
                    write(6,'(a,a)') 
     &              ' Locate event (y/return=n))? '
                    call flush (6)
                    read(5,'(a1)') answer
                    if(answer.eq.'y'.or.answer.eq.'Y') then
                       call systemc('hyp',3)
                    endif
                 else
                    call systemc('hyp',3)
                 endif
c
c  save location in s-file if desired 
c
                 if(auto_update.gt.0) then
                    if(auto_update.eq.2) then
                        write(6,*)
     &                  ' Do you want to save location, (y/return=n) ?'
                         call flush (6)
                         read(5,'(a1)') answer
                         if(answer.eq.'y'.or.answer.eq.'Y') then
                            if(sun.or.linux)call 
     &                      systemc('cp hyp.out '//sfile,91) 
                            if(pc) call 
     &                      systemc('copy hyp.out '//sfile,80)
                         endif
                      else
                         if(sun.or.linux)call
     &                   systemc('cp hyp.out '//sfile,91)
                         if(pc) call
     &                   systemc('copy hyp.out '//sfile,80)   ! bug ??
                      endif 
                   endif
c
c end of auto-location section
c
              endif
              endif   ! of not cont
c                                                                               
c   copy trace file name to WAV
c
              write(cwavyear,'(I4.4)') wav_year(1)
              write(cwavmon,'(I2.2)') wav_month(1)

              if(cwav.or.cseed) then
                 filen=trace_file
              else
                 filen=wav_filename(1)    ! assume only one
              endif
              if( pc ) then
                 if(copy_wav_dir.eq.' ') then
                    long_text = 'copy ' // filen(:seiclen(filen)) //
     &                 ' '                                    //
     &               top_directory(:seiclen(top_directory)) //
     &               dchar//'WAV'//dchar                    //
     &               filen(:seiclen(filen))
                 else
                    long_text = 'copy ' // filen(:seiclen(filen)) //
     &                 ' '                                    //
     &               top_directory(:seiclen(top_directory)) //
     &               dchar//'WAV'//dchar                    //
     &               copy_wav_dir//dchar//cwavyear(1:4)//dchar //
     &               cwavmon(1:2)//dchar
c     &               copy_wav_dir//dchar//filen(1:4)//dchar //
c     &               filen(6:7)//dchar                     
c     &               filen(:seiclen(filen))
                 endif
c
c bjb modified wavefile name to remove path when writing into S-file
c
              else if( sun.or.linux ) then
                 if(copy_wav_dir.eq.' ') then
                    long_text = 'cp   ' // filen(:seiclen(filen)) //
     &                 ' '                                    //
     &               top_directory(:seiclen(top_directory)) //
     &               dchar//'WAV'//dchar                    //
     &               trace_file(:seiclen(trace_file))
                  else
                     long_text = 'cp   ' // filen(:seiclen(filen)) //
     &                 ' '                                    //
     &               top_directory(:seiclen(top_directory)) //
     &               dchar//'WAV'//dchar                    //
     &               copy_wav_dir//dchar//cwavyear(1:4)//dchar //
     &               cwavmon(1:2)//dchar
c     &               copy_wav_dir//dchar//trace_file(1:4)//dchar //
c     &               trace_file(6:7)//dchar                      //
c     &               trace_file(:seiclen(trace_file))
                  endif
              else
                  chr_err_msg$ = 
     &'**** ERROR: could not determine the computer type'
                  call sei code( stop$, e_init$, 0, b_flag ) ! Halt program
              end if                                     !
c
              write(6,'(1x,a)') long_text                                          
c
c now copy
c
              call systemc( long_text,
     &                         seiclen(long_text) )
c
c  check that file got there
c
              call sei open( check$,              ! Check file exists.
     &                      ' ',                 ! No prompt.
     &        long_text(7+seiclen(filen):seiclen(long_text)),
     &                      0,                   ! Unit (n/a).
     &                      exist,               ! File exists?.
     &                      code )               ! Condition (n/a).
              if(exist) then
                  write(6,*)' File transferred to WAV **********'               
              else
                  write(6,*)' Failure to transfer to WAV ****'
                  write(6,*)' Return to continue'
                  call flush (6)
                  read(5,'(a4)') i
              endif
              write(6,*)                                                      
c
c   event was registered, go to next or another according to opmode,
c   however if in cont mode, replot
c
              if(cwav.or.cseed) then
                 choice='REPL'
                 write(6,*)' Continue plot(y/n=default)'
                 read(5,'(a)') text
                 if(text(1:1).eq.'y') then
                    goto 1100
                 else
                   goto 999 
                 endif
              else
                 choice='FINI'
              endif
           else
               write(6,*)' You did not register event'
c
c   if here, assume  pressed by mistake, replot
c   clean out data fil by resetting line counters
c
               nrecord=0
               nhead=0
c
               goto 1100                                                      
           endif                                                              
        endif               ! end of register (PUT) section
c
c-----------------------------------------------------------------
c   for remaining options, there might be a hard copy file which
c   could be sent to the plotter, check !                     
c-----------------------------------------------------------------
c
c   make hard copy plot                                                         
c                                                                               
        if(p_option.gt.1) then                                               
              call close_post
              call sei close( close$, plotunit, code ) ! Close (stop on error).
              write(6,'(a,$)')' Submit plot (y=return/n) '                      
              call flush (6)
              read(5,'(a)') dummy                                               
              if(dummy.eq.' '.or.dummy.eq.'Y'.or.dummy.eq.'y') 
     *        call send_plot("mulplt.eps",10)
        endif
c
c------------------------------------------------------------------------
c   check if other channels 
c------------------------------------------------------------------------
c
        if(choice.eq.'OTHE') then
              if(default) then         ! unset default in order to set ch.
                 default_org=default
                 default=.false.
              endif
c
c   show menu of other channels
c
              call channelselect(wav_nchan,wav_stat,wav_comp, 
     *        nchan,nchan_def,stat_def,comp_def,default)
c
c   stop if zero number of channels, can be caused by a q in selection
c
              if(nchan.eq.0) goto 999
        do i=1,nchan
           channelname_org(i)=channelname(i)
        enddo
c
c   save original number of channels, used if several screens are plotted
c
        nchan_org=nchan
c
c   set screen number
c
        n_screen=1
c
c
c   reset default
c
              default=default_org
              goto 1099                ! other channels
        endif
c
c-----------------------------------------------------------------------
c    check if other waveform file when called from eev
c-----------------------------------------------------------------------
c
        if(choice.eq.'OTWA' ) then
             if(opmode.eq.0) then
                one_plot=.false.   ! allow one more plot
                default=.false.    ! only if no default will file menu be shown
                goto 1000
             endif
        endif
c
c------------------------------------------------------------------------
c   check if next or another event from filenr.lis or next event
c   from eev is wanted, also next cont interval
c------------------------------------------------------------------------
c
        if(choice.eq.'FINI') then
              if(cwav.or.cseed) then            ! cont base
                  cwav_abs_start_time=cwav_abs_start_time+  ! advance start
     *            cont_interval*0.8
                  call cwav_time_limits(1)             ! calculate new lim
                  goto 1050                            ! next window
              endif
              if(opmode.eq.1) then     ! from filenr.lis
                 if(default ) then    
                     question(1:11)='#Next_file#' ! next event chosen, no quesitons
                 else
                     question(1:11)='           '
                 endif
                 goto 1000            ! get next file from filenr.lis
              else
                 if(opmode.eq.0) then
                   keys='NEXT'          ! - from data base, next event
                   goto 1000
                 else
                   goto 999             ! stop if called from eev
                 endif
              endif
        endif
c
c------------------------------------------------------------------------
c   check if back an event from filenr.lis or back one event
c   from eev is wanted, also back in cont interval
c------------------------------------------------------------------------
c
        if(choice.eq.'BACK') then
              if(cwav.or.cseed) then            ! cont base
                  cwav_abs_start_time=cwav_abs_start_time-  ! advance start
     *            cont_interval*0.8
                  call cwav_time_limits(1)             ! calculate new lim
                  goto 1050                            ! next window
              endif
              if(opmode.eq.1) then     ! from filenr.lis
                 if(default ) then    
                     question(1:11)='#Back_file#' ! next event chosen, no quesitons
                 else
                     question(1:11)='           '
                 endif
                 goto 1000            ! get next file from filenr.lis
              else
                 if(opmode.eq.0) then
                   keys='BACK'          ! - from data base, next event
                   goto 1000
                 else
                   goto 999             ! stop if called from eev
                 endif
              endif
        endif

c
c   end of multitrace option                                                    
c                                                                               
      endif                                                                     



         
c----------------------------------------------------------------------------------                                                                               
c-----------------------------------------------------------------------        
cccccc      start of section where channel data are picked   cccccccc
c           single trace option 0, only option left so no if
c-----------------------------------------------------------------------
c----------------------------------------------------------------------------------
c
c


c
c   select channels
c
       call channelselect(wav_nchan,wav_stat,wav_comp,                   
     * nchan,nchan_def,stat_def,comp_def,default)
c
c  sort after distance or time
c
       call channel_order(wav_stat,wav_delay,nchan,nsynt)                               
c
c  save original selection
c
       do i=1,nchan
          old_chan(i)=channelname(i)
       enddo
       old_nchan=nchan
c
c   stop if zero number of channels, can be cause by a q in selection
c
       if(nchan.eq.0) goto 999
c
c-------------------------------------------------------------------------
c   single trace mode loop startsn here, also get here if jump out
c   of multi trace mode above
c-------------------------------------------------------------------------
c
      i=0           ! start with channel one

 2000 continue
c                                                                               
      i=i+1
      if(i.le.0) i=1
      if(i.gt.nchan) goto 99    ! jump out of loop to stop
c                                                                               
c  read one channel data                                                        
c                                                                               
         ichan=channelname(i)   
c
c   check if baz angles should be calculated
c
         if(rotate.and.no_baz) then
            call get_baz
     *      (wav_nchan,wav_stat,data,nhead,nrecord,baz)
            no_baz=.false.      ! indicate that baz has been calculated
         endif
         resolu=resolu_x
c
c   read one channel, might have to be rotated in which case both horizontal
c   must be read
c

         wav_rot_comp(ichan)=' '
         wav_rot_delay(ichan)=0.0
          if(rotate.and.baz(ichan).lt.400.0.
     *    and.wav_comp(ichan)(4:4).ne.'Z') then
             call wav_read_2channel(ichan)
             numb_samp=wav_out_duration(1)*wav_rate(ichan)+1
             if(wav_comp(ichan)(4:4).eq.'N') wav_rot_comp(ichan)='R'
             if(wav_comp(ichan)(4:4).eq.'E') wav_rot_comp(ichan)='T'
             call rotate_comp(numb_samp,
     *       wav_out_first_sample(wav_current_chan(2)),
     *       wav_out_first_sample(wav_current_chan(3)),
     *       wav_rot_comp(ichan),
     *       baz(ichan),signal1,signal2,signal3)
c
c   replace parmeters for current channel due to rotation, time
c   start and interval might be different if 2 horizontal channels
c   have different start times
c
             wav_rot_delay(ichan)=wav_out_start(1)
     *       -wav_delay(ichan) ! normally zero
          else
             call wav_read_channel(ichan)
             numb_samp=wav_nsamp(ichan)
          endif

         rate=wav_rate(ichan) 
c                                                                               
c   make plot header, rotated times could be different                         
c                          
         head=' '
         head(1:40)=wav_file_text(1:40)
         head(41:45)=wav_stat(ichan)
         head(47:50)=wav_comp(ichan)
         if(wav_rot_comp(ichan).ne.' ') 
     *   head(50:50)=wav_rot_comp(ichan)
         if(rotate) then
            write(head(54:80),'(i4,4i2,f6.3)')wav_out_year(1),
     *      wav_out_month(1),wav_out_day(1),
     *      wav_out_hour(1),
     *      wav_out_min(1),wav_out_sec(1)                 
         else
            write(head(54:80),'(i4,4i2,f6.3)')wav_year(ichan),
     *      wav_month(ichan),wav_day(ichan),wav_hour(ichan),
     *      wav_min(ichan),wav_sec(ichan)                 
         endif
c         
c check for null chars
c
         do k=1,80
           if(ichar(head(k:k)).eq.0) head(k:k)=' '
         enddo
c                                                                               
cccccc   Get old picks       ccccccccccccccc                                    
c                                                                               
         call read_s_file
         if(nrecord.ge.max_data) then
              write(6,*)
     *      ' Too many lines in readings file'
              write(6,*)' Maximum is ',max_data
              goto 999 
          endif
c
c   add synthetic readings if any                                         
c
          call add_synt_readings(nsynt,synt_head)
c
         iswitch = 0
         call convert(wav_abs_time(ichan),wav_stat(ichan),                        
     +   wav_comp(ichan),iswitch)
c                                                                               
ccccc   plot the data and pick phases   ccccccccccccccccccc                                   
c
c  open plot file if needed
c
         if(plotoption.ge.1) then                              
             call sei open( unknown$,      ! Open file.
     &                      ' ',           ! No prompt.
     &                      'mulplt.eps',  ! This file.
     &                      plotunit,      ! On this unit.
     &                      b_flag,        ! Existance.
     &                      code )         ! Condition not applicable.
         endif                                                                 
c                 
         call open_display
c
         call picc   ! pick phases, make spec etc, one channel, most done here                                                               
c
c   close plot file, note everything done in picing mode is on one page !
c
        if(plotoption.ge.1)  then 
           call close_post                               
           call sei close( close$, plotunit, code ) ! Close (stop on error).
        endif
c                                                                               
c   make hard copy plot                                                         
c                                                                               
        if(p_option.gt.1) then                                               
           call clear_to_alpha
           write(6,'(a,$)')' Submit plot (y=return/n) '                      
           call flush (6)
           read(5,'(a)') dummy                                               
           if(dummy.eq.' '.or.dummy.eq.'Y'.or.dummy.eq.'y') 
     *     call send_plot("mulplt.eps",10)
        endif
c
c-----------------------------------------------------------------
c   if replot, assume this or previous choice was rotate, 
c   go and read other horizontal channel and plot again
c-----------------------------------------------------------------
c
        if(choice.eq.'REPL') then
           i=i-1    ! use same channel
           goto 2000
        endif
c
c------------------------------------------------------------------                                                                               
c   Always save readings, also when quitting         
c------------------------------------------------------------------

         iswitch = 1                                                            
                                                                                
         call convert(wav_abs_time(ichan),wav_stat(ichan),                     
     +   wav_comp(ichan),iswitch)
c
         call write_s_file
c
c                                                                               
c   decide what to do next                                                      
c                                                                               
         if(choice.eq.'QUIT') then       ! save also if quit                   
             call clear_to_alpha
             goto 999
         endif

c-----------------------------------
c  check if multi channel plot
c-----------------------------------
c
        if(choice.eq.'TOGL') then
c
c   if only one channel was selected above, assume you want to go
c   back to old multi channel selection 
c
           if(nchan.eq.1) then
              do l=1,old_nchan
                 channelname(l)=old_chan(l)
              enddo
              nchan=old_nchan
           endif
           goto 1100
        endif
c
c----------------------------------
c-- chose other channels                        
c----------------------------------
c
        if(choice.eq.'OTHE') then
           if(default) then         ! unset default in order to set ch.
              default_org=default
              default=.false.
           endif
           call channelselect(wav_nchan,wav_stat,wav_comp,
     *     nchan,nchan_def,stat_def,comp_def,default)
           default=default_org
c
c   stop if zero number of channels, can be cause by a q in selection
c
           if(nchan.eq.0) goto 999
c
c  sort after distance or time
c
           call channel_order(wav_stat,wav_delay,nchan,nsynt)                  
           i=0
c
           goto 2000              ! start again
        endif
c
c check if going back one channel
c
        if(choice.eq.'BACK') i=i-2 
        goto 2000
c 
c---------------------------------------------------------------------------
c   End of channel picking loop in single channel mode
c---------------------------------------------------------------------------
c---------------------------------------------------------------------------                                                                  

 99    continue    

c
c-------------------------------------------------------------------------- 
c
      if(opmode.eq.1) then ! if in multiple event mode
         call clear_to_alpha
         goto 1000         ! another event
      endif                                                      
c                                                                               
 999  continue                                                                  
      call clear_to_alpha                                                     
c
c   there might be a hard copy file which
c   could be sent to the plotter, check !   ! 4-2001 jh: there never seesm to
c                                                        to be a plot, caused
c                                                        crash
c
c   make hard copy plot
c
c          if(p_option.gt.10) then     
c             call close_post
c             call sei close( close$, plotunit, code ) ! Close (stop on error).
c             write(6,'(a,$)')' Submit plot (y=return/n) '
c             call flush (6)
c             read(5,'(a)') dummy
c             if(dummy.eq.' '.or.dummy.eq.'Y'.or.dummy.eq.'y')
c    *        call send_plot("mulplt.eps",10)
c          endif

c                                                                               
c    Close down all files...
c
      call sei close( close$+all$,               ! Close all files.
     &                0,                         ! Unit (n/a).
     &                code )                     ! Condition (n/a).
      
      stop                                                                      
      end                                                                       
                                                                                
c------------------------------------------------------------------------------ 
      subroutine channelselect(number_of_channels,station,comp,                 
     *           nchan,nchan_def,stat_def,comp_def,
     *           default)                               
c                                                                               
c                                                                               
c     Routine to show default channels and select channels to plot.             
c                                                                               
c     written by  j. havskov                                     
c                                                                               
c     Input:   number_of_channels   : in input file                             
c              station, comp        : station and component in input file       
c              stat_def,comp_def    : default channels
c              nchan_def            : number of default channels
c              default              : if default or not for selection
c                                                                               
c     Input/Output:  channelname    : channel numbers selected,now in common                  
c                    nchan          : number of channels selected               
c
      implicit none
      include 'mulplt.inc'
c
c------------------------------------------------------
      include 'libsei.inc'              ! Library definitions & data defns.
      external   sei integer            ! Extract integer from string.
      integer    sei integer            ! & function.
      integer    code                   ! Condition code.
c---------------- end of sei lib changes --------------
c-- channels selected                             
c     integer channelname(max_trace)			
c-- number of channels in file                  
      integer number_of_channels
      integer nchan_def		
c-- station and components                
      character*5 station(max_trace)
      character*4 comp(max_trace)		
      character*5 stat_def(*)
      character*4 comp_def(*)
      character*2 answer     
c--- next 3 for sorting
      character*80 cha_sort_in(max_trace)
      character*80 cha_sort_out(max_trace)
      integer order_out(max_trace)                                                   
c-- selected array                               
      character*1 selected(max_trace)			
      integer on(max_trace)
      integer on_temp(max_trace)
c-- output text                                     
      character*75 text(12)
      character*80 box_text(max_trace)
      character*120 title
      character*80 box_text_temp(max_trace)
      character*1  ph(max_trace)  ! mark if a phase present
c-- number of ch. selected                                 
      integer nchan				
c-- last character pushed in input_box
      character*1 last_char
c-- number of lines print.                             
      integer lines_out				
      character*2 comp_short   ! short version of component notation
      integer nchan_in_box     ! number of channels used for selkection if more than 250
      logical default
c-- Counters                                               
      integer i,j,k,box,l
      box=1

c
c   initialize channel names
c
      do i=1,max_trace
         channelname(i)=0
      enddo	
	  
      do i=1,number_of_channels
         ph(i)=' '
      enddo
c
c   sort channels 
c
      do i=1,number_of_channels
          cha_sort_in(i)(1:10)=station(i)//'A '//comp(i)
c
c   get components in right order
c
          if(comp(i)(4:4).eq.'Z') cha_sort_in(i)(7:7)='1'
          if(comp(i)(1:1).eq.'A') cha_sort_in(i)(6:6)='B'     ! acceleration channels at end
          if(comp(i)(4:4).eq.'N') cha_sort_in(i)(7:7)='2'
          if(comp(i)(4:4).eq.'E') cha_sort_in(i)(7:7)='3'
      enddo
      call  text_sort(cha_sort_in,cha_sort_out,order_out,
     *                number_of_channels)        

c                                                                               
c   find which default channels are present, initially selected if the
c   default option is used                                     
c                                                                               
      do i=1,number_of_channels
         k=order_out(i)
c         write(17,*) 
c     *   i,station(i),comp(i),order_out(i),station(k),comp(k)
      enddo

      k=0                                                                       
      do i=1,number_of_channels                                                 
         do j=1,nchan_def                                                       
c            write(17,*) station(i),stat_def(j),comp(i),comp_def(j)
            l=i
            if(chan_sort) l=order_out(i)
            if(station(l).eq.stat_def(j).and.comp(l).eq.
     *         comp_def(j)) then                
c               write(17,*) k, selected,order_out(i)
               k=k+1                                                            
               channelname(k)=l
            endif                                                               
         enddo                                                                  

c
c   find if any reading this channel
c
         if(nrecord.gt.0) then
          do j=nhead+1,nrecord-1
            call component(comp(i),comp_short) ! get short version of component
            if(station(i).eq.data(j)(2:6)
     *      .and.comp_short.eq.
     *      data(j)(7:8)) 
     *      ph(i)='*'
          enddo
         endif
      enddo                                                                     
      nchan = k                                                                 
      do i=1,nchan
c         write(17,*) i,channelname(i)
      enddo
c
c   check if not too many channels
c
      if(k.gt.max_trace) then
         write(6,*)' Too many channels, will define ',max_trace
         k=max_trace ! look like it does not work, is it needed ?
      endif
c
c   if no default channels, select all
c
      if(nchan.eq.0) then
         do i=1,number_of_channels
            if(chan_sort) then
               channelname(i)=order_out(i)
            else
               channelname(i)=i
            endif
         enddo
         nchan=number_of_channels
      endif 	  
	  
c
c   return if default
c
      if(default) return

c                                                                               
c  mark channels already selected                                               
c                                                                               
      do i=1,number_of_channels
        on(i)=0
      enddo
      do i=1,number_of_channels                                                 
        on(i)=0                                                     
        do k=1,nchan                                                            
           if(chan_sort.and.channelname(k).eq.order_out(i))                            
     *       on(i)=1
           if(.not.chan_sort.and.channelname(k).eq.i)
     *       on(i)=1
        enddo                                                                   
      enddo
c
c
c  put in text for boxes
c
      do k=1,number_of_channels
            if(chan_sort) then
                i=order_out(k)
            else
                i=k
            endif
            box_text(k)=station(i)//comp(i)//ph(i)
            channelname(i)=0
      enddo
c
c   display channels
c
         title=
     *   'SELECT CHANNELS, FILLED OUT BOXES INDICATE SELECTION,'//
     *   ' A * INDICATES A PHASE READ '
         title(81:120)=' '
c
c   less than 250 channels
c
      if(number_of_channels.le.250) then
         box_text(number_of_channels+1)='All Z'
         call input_box
     *   (number_of_channels+1,on,10,90.0,15.0,box_text,10,
     *                     3.0,685.0,title,last_char,1,0)
       endif

c
c   Quit...
c
      if(last_char.eq.'Q'.or.last_char.eq.'q') then
         nchan=0
         return
      end if   
c
c   250 to 500 channels
c
      if(number_of_channels.gt.250) then

         do i=1,number_of_channels
           on_temp(i)=on(i)
           box_text_temp(i)=box_text(i)
         enddo
c
c  show 1-250
c
         title(85:111)='MORE CHANNELS, PUSH OK OR F'

         nchan_in_box=250
         box_text(nchan_in_box+1)='All Z'
         do i=1,nchan_in_box
            on_temp(i)=on(i)
         enddo
         call input_box(nchan_in_box+1,on_temp,10,90.0,15.0,box_text,10,
     *                     3.0,710.0,title,last_char,1,0)

c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            nchan=0
            return
         end if   
c
c   save choises
c
         do i=1,250
             on(i)=on_temp(i)
         enddo
      endif
c
c   show 251-500
c
      if(number_of_channels.gt.250) then 
         if(number_of_channels.gt.500) then
             title(85:111)='MORE CHANNELS, PUSH OK OR F'
             nchan_in_box=250
         else
             nchan_in_box=number_of_channels-250
             title(85:111)=' '
         endif  
         do i=1,nchan_in_box
            on_temp(i)=on_temp(i+250)
            box_text(i)=box_text_temp(i+250)   ! use original text
         enddo

         box_text(nchan_in_box+1)='All Z'
         call input_box
     *   (nchan_in_box+1,on_temp,10,90.0,15.0,box_text,10,
     *                     3.0,710.0,title,last_char,1,0)
c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            nchan=0
            return
         endif

c
c   save choises
c
         do i=1,nchan_in_box
             on(i+250)=on_temp(i)
         enddo         
      endif
c
c   show 501-750
c

      if(number_of_channels.gt.500) then
         if(number_of_channels.gt.750) then
             title(85:111)='MORE CHANNELS, PUSH OK OR F'
             nchan_in_box=250
         else
             nchan_in_box=number_of_channels-500
             title(85:111)=' '
         endif
         do i=1,nchan_in_box
            on_temp(i)=on_temp(i+500)
            box_text(i)=box_text_temp(i+500)   ! use original text
         enddo
         box_text(nchan_in_box+1)='All Z'
         call input_box
     *   (nchan_in_box+1,on_temp,10,90.0,15.0,box_text,10,
     *                     3.0,710.0,title,last_char,1,0)
c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            nchan=0
            return
         endif

c
c   save choises
c
         do i=1,nchan_in_box
            on(i+500)=on_temp(i)
         enddo
      endif
c
c   show 750-1000
c
      if(number_of_channels.gt.750) then
         if(number_of_channels.gt.1000) then
             write(6,*)' Number of channels too large'
             stop
         else
             nchan_in_box=number_of_channels-750
             title(85:111)=' '
         endif
         do i=1,nchan_in_box
            on_temp(i)=on_temp(i+750)
            box_text(i)=box_text_temp(i+750)   ! use original text
         enddo

         box_text(nchan_in_box+1)='All Z'
         call input_box
     *   (nchan_in_box+1,on_temp,10,90.0,15.0,box_text,10,
     *                     3.0,710.0,title,last_char,1,0)
c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            nchan=0
            return
         endif

c
c   save choises
c
         do i=1,nchan_in_box
             on(i+750)=on_temp(i)
         enddo
      endif

c
c   take out selected channels
c
      k=1
      do i=1,number_of_channels
         if(on(i).eq.1) then
            if(chan_sort) then
               channelname(k)=order_out(i)   
            else
               channelname(k)=i
            endif
            k=k+1
         endif
      enddo

      nchan=k-1                                                         
                                                                 
      return                                                                    
      end                                                                       
******************************************************************              

      subroutine channel_order(station,                 
     *           delay,nchan,nsynt)                               
c                                                                               
c                                                                               
c     Routine to order channels in aproximate distance              
c                                                                               
c     written j. havskov, oct 95                                     
c                                                                               
c     Input:                                
c              station              : station       
c              trace_delay          : delay each trace relative to main header
c              nsynt                : number of sybthetic readings
c
c     Input/Output:  channelname    : channel numbers reordered,now in common                  
c                    nchan          : number of channels selected               
c     
c
      implicit none
      include 'mulplt.inc'
c
c-- channels selected                             
c     integer channelname(*)			
      real delay(*)                      ! channel delay
      integer new_channelname(max_trace) ! for reordering channels
      logical not_used(max_trace)        ! if channel reordered or not
      integer min             ! channel number of channel with minumum delay
      real mindel             ! minimum delay
      integer nsynt
c-- station                 
      character*5 station(*)
c-- number of ch. selected                                 
      integer nchan				
c-- Counters                                               
      integer i,j,k,l
	  
c
c  check if stations are to be plotted in distance order, nsort_distance must
c  be positive
c
 
c      write(6,*)nsort_distance,nrecord,nhead
       if(nsort_distance.eq.0) return
c
         do i=1, nchan
            not_used(i)=.true.          ! no channels are ordered initially
         enddo
c
c  plot in order as given in s-file, if a station not in s-file, put at end
c
         if(nrecord-nhead-nsynt.gt.nsort_distance) then ! only do if enough readings
c         write(6,*)'phas'
            k=0                         ! count channels reordered
            do j=nhead+1,nrecord-1      ! put in same order as in s-file
               do i=1,nchan             ! check every prev. selected channel
                  if(station(channelname(i)).eq.data(j)(2:6).
     *            and.not_used(i)) then
                     k=k+1
                     not_used(i)=.false.     ! channel now ordered
                     new_channelname(k)=channelname(i)
                  endif
               enddo
            enddo
            do i=1,nchan                 ! put channels not ordered at the end
               if(not_used(i)) then
                  k=k+1
                  new_channelname(k)=channelname(i)
               endif
            enddo
            do i=1,nchan                 ! put channel order back in org. array
               channelname(i)=new_channelname(i)
            enddo
         else                           
c
c   use waveform file header time order
c
c            write(6,*)'time order'
             i=1
 10             continue
                mindel=9999999.0      ! initialize minumum delay
                   do l=1,nchan          ! find minimum delay of remaining stats.
                      if(delay(channelname(l)).lt.mindel.and.
     *                not_used(l))  then 
                         mindel=delay(channelname(l))
                         min=l
                      endif
                   enddo
                   not_used(min)=.false.     ! channel now ordered
                   new_channelname(i)=channelname(min)
                   k=0                      ! number of channels, same station
                   do l=1,nchan             ! make sure remaining channels
                      if(station(channelname(l)).eq.   ! - of same station are
     *                station(channelname(min)).and.not_used(l)) then 
                         not_used(l)=.false.      ! - selected together
                         i=i+1
                         new_channelname(i)=channelname(l)
                      endif                   
                   enddo
               i=i+1
               if(i.le.nchan) goto 10
            do i=1,nchan                 ! put channel order back in org. array
               channelname(i)=new_channelname(i)
            enddo
         endif
                         
c
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine get_mulplt_def(def_unit,stat_def
     *,comp_def,nchan_def)               
c                                                                               
C     get mulplt defaults                                            
c                                                                               
c     written by  J. Havskov                                     
c                                                                               
c     Input:   def_unit  : unit to read from (changed to output..JAB(BGS)Dec94)
c              data      : work array                                               
c     Output:  defaults, through window, default channels to plot,
c                        the rest through common block                                                      
c                  
      implicit none
      external sei get file,                 ! Search directories & open file.
     &         sei close,                    ! Close file open.
     &         sei code                      ! Error processor.
      include 'libsei.inc'                   ! Library definitions & data defns
      integer  code                          ! Condition.
      logical  b_eof                         ! End of file?.
c
      include 'mulplt.inc'
      include 'seiplot.inc'
      character*5 stat_def(*)
      character*4 comp_def(*)			
c-- unit for file
      integer def_unit
c-- directory separator char
      character*1 dchar
c-- path to seismo                             
      character*60 top_directory			
c-- number of default channels                                
      integer nchan_def
c-- Counters and help variables
      character*1 amouse            
      real xmouse,x_screen_size,xres,xsort_distance,ca,xin
                                        
      integer i,k,nline				
      logical sun,pc,linux
c
      call dir_char(dchar)
      call topdir(top_directory)
      call computer_type(sun,pc,linux)
c
c   set default parameters in case there is no mulplt.def
c
c-- mouse is blank                                               
c
      if(sun.or.linux) mouse=ichar(' ')
      if(pc) mouse=ichar(' ')
      resolu_x=1000
      resolu_hc=3000
      nchan_def=0
      numb_keys=0
      numb_weights=0
      q0=0.0
      kappa=0
      qalpha=1.0
      travel_time=1.0
      pvelocity=6.0
      svelocity=3.5
      density=3.0
      three_comp_velocity=5.0
      nsort_distance=0
      ffmin=0.05
      ffmax=50.0
      auto_locate=0.0
      auto_update=0.0
      auto_process=0.0
      auto_process_name=' '
      spec_out=0.0
      filt=0
      coda_h=10.0
      coda_l=5.0
      coda_sta=5.0
      coda_ratio=1.5
      do_auto_coda=.FALSE.
      ms_high=0.1000
      ms_low=0.038
      ms_low_pole=2
      ms_high_pole=1
      mb_low=0.9
      mb_high=1.8
      mb_low_pole=2
      mb_high_pole=3
      ml_high = 20.0
      ml_high_pole=8
      ml_low=1.25
      ml_low_pole=8
c
c   others
c
      n_chan_screen=99 ! max 99 channels per screen
      chan_sort=.true. ! sort alphabetically
c
c Set time domain recursive filter type to 0 (use function bndpas bjb 2001/02/14)
c
      filter_type=0
c                                                                               
c   Initially set mulplt filters (bjb 2001/02/13)
c                                                                               
      flow(1)=0.01                                                             
      fhigh(1)=.1
      flow(2)=.1                                                              
      fhigh(2)=1.0
      flow(3)=1.0                                                               
      fhigh(3)=5.0                                                             
      flow(4)=5.0                                                              
      fhigh(4)=10.0                                                             
      flow(5)=10.0                                                              
      fhigh(5)=15.0                                                             
      flow(6)=15.0                                                              
      fhigh(6)=23.0                                                             
      flow(7)=2.0
      fhigh(7)=4.0
c                                                                               
c   get path to seismo                                                          
c                                                                               
      k=index(top_directory,' ')-1                                              
c                                                                               
c   open and read default file with stations and components to use              
c   --------------------------------------------------------------
c
      call sei get file( open$+ignore$,    ! Find and open without messages.
     &                   def_unit,         ! On file unit.
     &                   code,             ! Condition (n/a).
     &                   'DAT',            ! Alternative directory to search.
     &                   'MULPLT.DEF' )    ! For this file.
c                                                                               
c   read file if there...
c   ------------
c                                                                               
      if(code.ne.e_ok$)  goto 666

      i=1                                                                       
10    read(def_unit,'(a)',iostat=code) data(i) ! Read from file.
      call sei code( fort$,                    ! Process fortran i/o condition.
     &               code,                     ! Condition.
     &               def_unit,                 ! On unit.
     &               b_eof )                   ! End of file?.
c
      if( b_eof ) then                         ! End of file.
      nline=i                                  ! Store records in file.
      call sei close( close$, def_unit, code ) ! Close (Default stop on error).
c
      else                                     ! Otherwise.
      i=i+1                                    ! Increment record number.
      goto 10                                  ! Read another record.
      end if                                   !
c
c   find default chanels
c
      do i=1,nline
         if(data(i)(1:15).eq.'DEFAULT CHANNEL'.and.
     *      data(i)(41:50).ne.'          ') then
            nchan_def=nchan_def+1
            stat_def(nchan_def)=data(i)(41:45)
            comp_def(nchan_def)=data(i)(51:54)
         endif
      enddo		 
c
c   find keys assigned to phases
c
      do i=1,nline
         if(data(i)(1:14).eq.'PHASE NAME KEY'.and.
     *      data(i)(41:50).ne.'          ') then
            numb_keys=numb_keys+1
            ascip(numb_keys)=data(i)(41:41)
            phs(numb_keys)=data(i)(51:59)
         endif
c
c  weight keys assigned
c
         if(data(i)(1:16).eq.'PHASE WEIGHT KEY'.and.
     *      data(i)(41:50).ne.'          ') then
            numb_weights=numb_weights+1
            if(numb_weights.gt.10) then
               write(6,*)' You have defined too many weights'
               write(6,*)' Reduce to 10 or less in MULPLT.DEF'
               stop
            endif
            key_weight(numb_weights)=data(i)(41:41)
            i_weight(numb_weights)=data(i)(51:51)
         endif
      enddo
c
c   find if a mouse definition, can be a character or ascii code
c
      do i=1,nline
         if(data(i)(1:15).eq.'PHASE MOUSE KEY'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)', err=273 ) xmouse
            mouse=xmouse
            goto 274
 273        continue
c
c   was not a number, try a character
c
            amouse=data(i)(41:41)
            mouse=ichar(amouse)
 274        continue
         endif
      enddo
c
c   find and set spectral and other parameters
c
      do i=1,nline
         if(data(i)(1:11).eq.'SPECTRAL Q0'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) q0
         endif
         if(data(i)(1:15).eq.'SPECTRAL QALPHA'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) qalpha
         endif
         if(data(i)(1:14).eq.'SPECTRAL KAPPA'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99)kappa
         endif
         if(data(i)(1:19).eq.'SPECTRAL S-VELOCITY'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) svelocity
         endif
         if(data(i)(1:19).eq.'SPECTRAL P-VELOCITY'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) pvelocity
         endif
         if(data(i)(1:16).eq.'SPECTRAL DENSITY'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) density
         endif
         if(data(i)(1:15).eq.'SPECTRAL F-BAND'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) ffmin,ffmax
         endif
         if(data(i)(1:15).eq.'BANDPASS FILTER'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) flow_def,fhigh_def
            filt=9
         endif
         if(data(i)(1:15).eq.'SPECTRAL OUTPUT'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(f10.1)',err=99) spec_out
         endif
         if(data(i)(1:22).eq.'WOOD ANDERSON HIGH CUT'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(f10.1)',err=99) ml_high
            ml_high_pole=8
         endif

         if(data(i)(1:21).eq.'ML HIGH CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) ml_high,xin
            ml_high_pole=xin
            if(ml_high_pole.eq.0) ml_high_pole=8
         endif

         if(data(i)(1:21).eq.'MS HIGH CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) ms_high,xin
            ms_high_pole=xin
            if(ms_high_pole.eq.0) ms_high_pole=8
         endif

         if(data(i)(1:20).eq.'ML LOW CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) ml_low,xin
            ml_low_pole=xin
            if(ml_low_pole.eq.0) ml_low_pole=8
         endif


         if(data(i)(1:20).eq.'MS LOW CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) ms_low,xin
            ms_low_pole=xin
            if(ms_low_pole.eq.0) ms_low_pole=8
         endif

         if(data(i)(1:21).eq.'MB HIGH CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) mb_high,xin
            mb_high_pole=xin
            if(mb_high_pole.eq.0) mb_high_pole=8
         endif

         if(data(i)(1:20).eq.'MB LOW CUT AND POLES'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:60),'(2f10.1)',err=99) mb_low,xin
            mb_low_pole=xin
            if(mb_low_pole.eq.0) mb_low_pole=8
         endif
c
c   velocity for 3c analysis
c
         if(data(i)(1:14).eq.'3COMP VELOCITY'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) three_comp_velocity
         endif
c
c   autoprocessing and location
c
         if(data(i)(1:11).eq.'AUTO_LOCATE'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99)auto_locate 
            read(data(i)(51:60),'(f10.1)',err=99)auto_update 
         endif


         if(data(i)(1:12).eq.'AUTO_PROCESS'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) auto_process
            auto_process_name(1:10)=data(i)(51:60)
         endif

c
c Read filter type parameter from MULPLT.DEF (bjb 2001/02/14)
c
         if(data(i)(1:11).eq.'FILTER TYPE'.and.
     *      data(i)(41:50).ne.'          ') then

            read(data(i)(41:50),'(f10.1)') filter_type
         endif

c
c Read filter parameters for up to 7 filters from MULPLT.DEF (bjb 2001/02/13)
c
         if(data(i)(1:8).eq.'FILTER 1'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(1)
            read(data(i)(51:60),'(f10.1)') fhigh(1)
         endif

         if(data(i)(1:8).eq.'FILTER 2'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(2)
            read(data(i)(51:60),'(f10.1)') fhigh(2)
         endif

         if(data(i)(1:8).eq.'FILTER 3'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(3)
            read(data(i)(51:60),'(f10.1)') fhigh(3)
         endif

         if(data(i)(1:8).eq.'FILTER 4'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(4)
            read(data(i)(51:60),'(f10.1)') fhigh(4)
         endif

         if(data(i)(1:8).eq.'FILTER 5'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(5)
            read(data(i)(51:60),'(f10.1)') fhigh(5)
         endif

         if(data(i)(1:8).eq.'FILTER 6'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(6)
            read(data(i)(51:60),'(f10.1)') fhigh(6)
         endif

         if(data(i)(1:8).eq.'FILTER 7'.and.
     *      data(i)(41:50).ne.'          '
     *     .and.data(i)(51:60).ne.'          ') then
            read(data(i)(41:50),'(f10.1)') flow(7)
            read(data(i)(51:60),'(f10.1)') fhigh(7)
         endif
c
c   number of phases to do sorting, or no sortingó
c
         if(data(i)(1:14).eq.'NSORT_DISTANCE'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99)xsort_distance 
            nsort_distance=xsort_distance
         endif
c
c   x screen size
c
         if(data(i)(1:13).eq.'X_SCREEN_SIZE'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99) x_screen_size
            wsize=x_screen_size
         endif                      
c
c  resolution
c
         if(data(i)(1:11).eq.'RESOLUTIONX'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99)xres
            resolu_x=xres
         endif
         if(data(i)(1:12).eq.'RESOLUTIONHC'.and.
     *      data(i)(41:50).ne.'          ') then
            read(data(i)(41:50),'(f10.1)',err=99)xres
            resolu_hc=xres
         endif
c
c parameters for automatic coda
c
         if(data(i)(1:15).eq.'AUTOCODA FILTER') then
           if (data(i)(41:50).ne.'          ') then
              read(data(i)(41:50),'(f10.1)',err=99) coda_l
           endif
           if (data(i)(51:60).ne.'          ') then
              read(data(i)(51:60),'(f10.1)',err=99) coda_h
           endif
         endif

         if(data(i)(1:12).eq.'AUTOCODA STA'.and.
     *       data(i)(41:50).ne.'          ') then
             read(data(i)(41:50),'(f10.1)',err=99) coda_sta
         endif

         if(data(i)(1:14).eq.'AUTOCODA RATIO'.and.
     *       data(i)(41:50).ne.'          ') then
             read(data(i)(41:50),'(f10.1)',err=99) coda_ratio
         endif

         if(data(i)(1:9).eq.'CODA AUTO') then
             read(data(i)(41:50),'(f10.1)',err=99)ca 
               k = int(ca)
             if (k.eq.0) do_auto_coda=.FALSE.
             if (k.eq.1) do_auto_coda=.TRUE.
         endif
c
c  number of traces to one screen
c
         if(data(i)(1:16).eq.'NCHAN PER SCREEN') then
             read(data(i)(41:50),'(f10.1)',err=99)ca 
               k = int(ca)
             if (k.gt.0) n_chan_screen=k
         endif

        if(data(i)(1:15).eq.'CHANNEL SORTING') then
             read(data(i)(41:50),'(f10.1)',err=99)ca 
               k = int(ca)
             if (k.gt.0) chan_sort=.true.
             if (k.eq.0) chan_sort=.false.
         endif



      enddo
c
c 
  666   continue
c
c   if no phases were defined, do it here
c
       if(numb_keys.eq.0) then	
c-- IP	! - default                                         

c-- IP	! - default                                         
          ascip(1)='1'	
          phs(1)='IP       '                                                       
c-- EP                                                     
          ascip(2)='2'	
          phs(2)='EP       '                                                       
c-- EPG                                                    
          ascip(3)='3'	
          phs(3)='IPg      '                                                       
c-- EPG                                                    
          ascip(4)='4'	
          phs(4)='EPg      '                                                       
c-- IPN                                                    
          ascip(5)='5'	
          phs(5)='IPn      '                                                       
c-- EPN                                                    
          ascip(6)='6'	
          phs(6)='EPn      '	                                                      
c-- IS                                                     
          ascip(7)='7'	
          phs(7)='IS       '                                                       
c-- ES                                                     
          ascip(8)='8'	
          phs(8)='ES       '                                                       
c-- ISG                                                    
          ascip(9)='9'	
          phs(9)='ISg      '                                                       
c-- ESG                                                   
          ascip(10)='0'	
          phs(10)='ESg      '                                                      
c--  SN                                                   
          if(pc.or.linux)ascip(11)='+'	
          if(sun)ascip(11)='-'	
          phs(11)=' Sn      '                                                      
c-- ESN                                                   
c         ascip(13)='}'	
c         if(pc) ascip(13)=dchar
c         phs(13)='ESn      '                                                      
c-- LG                                                    
           if(sun) ascip(12)='='	
           if(pc.or.linux) ascip(12)=dchar
           phs(12)=' Lg      '                                                      
c         ascip(14)='l'	
c         phs(14)='Lg       '                                                      
c-- coda                                                  
          ascip(15)='c'	
          phs(15)='CODA     '                                                      
c-- coda                                                  
c
          ascip(16)='C'	
          phs(16)='CODA     '                                                      
c-- i     
          ascip(17)='i'
          phs(17)='I        '
c          ascip(18)='I'
c          phs(18)='I        '                                                      
c-- e     
          ascip(19)='e'
          phs(19)='E        '
c          ascip(20)='E'
c          phs(20)='E        '                                                      
c-- A
          ascip(21)='A'
          phs(21)=' AMP'
          numb_keys=21    

      endif
c                                                                               
c   define keys for weight if not done above                                  
c                                           
      if(numb_weights.eq.0) then                                 
c--	 upper case 1                                          
      key_weight(1)='!'
c-- upper case 2                                          
      key_weight(2)='@'
      if(pc) key_weight(2)='"'	
c-- upper case 3                                          
      key_weight(3)='#'	
c-- upper case 4                                          
      key_weight(4)='$'
c-- upper case 5                                          
      key_weight(5)='%'	
c-- upper case 6                                          
      key_weight(6)='^'	
      if(pc)key_weight(6)='&'
c-- upper case 7                                          
      key_weight(7)='&'	
      if(pc) key_weight(7)='/'
c-- upper case 8                                          
c     key_weight(8)='*'   ! temporary fix on sun	
      if(pc) key_weight(8)='('
c-- upper case 9                                          
      key_weight(9)='('	
      if(pc) key_weight(9)=')'
c-- upper case 0                                          
      key_weight(10)=')'
      if(pc) key_weight(10)='='
c                                                                               
c  assign weights asci values                                                   
c                                                                               
      i_weight(1)='1'                                                           
      i_weight(2)='2'                                                           
      i_weight(3)='3'                                                           
      i_weight(4)='4'                                                           
      i_weight(5)='5'                                                           
      i_weight(6)='6'                                                           
      i_weight(7)='7'                                                           
      i_weight(8)='8'                                                           
      i_weight(9)='9'                                                           
      i_weight(10)=' '          
      endif                      

c
c  save value of nsort_distance, might be temporarely turned off
c
c3-07-jh      nsort_distance_save=nsort_distance                          
c
c    Return to Caller...
c    ===================
c
c   errror
c
      goto 9999
99    continue
      write(6,*)' Errror in MULPLT.DEF'
      write(6,*)' Enter to to continue'
      call flush (6)
      read(5,'(a)') i
      stop
c
9999  return
      end
c
c******************************************************************             
                                                                                
      subroutine new_s_file(year,month,day,hr,min,sec,type,                     
     *            sdir,trace_file,event_name,data,operator,
     *            sub_class_flag,nhead,nrecord)                    
c                                                                               
c     Makes an initial S-file name from trace data file data                    
c                                                                               
c      J. Havskov, December 1988                                                
c                                                                               
c  last update:                                                                 
c  jan 16, 89 by j.h. : change comment line from type 3 to 7                    
c  sep 15  89    j.h. : new directory structure adaption                        
c  mar 22  89         : remove [wave] from file name output                     
c  aug 14  90         : pos+17 changed to pos+18 in blank string                
c  oct 01  91    j.h. : some unix clean up
c  nov 26  91         : new nordic format
c  jan 31  92    c.l. : Always write type on first header line
c  mar 18  97    bjb  : subclass information and number of headers
c                       and records are passed to subroutine
c                       a type 3 line is created if volcanic
c                       subclass info is desired.
c                       Phase readings are saved in the array DATA
c                       so these can be written out when event is 
c                       registered
c                                                                               
c     Input: Year,month,day,hr,min,sec: time of event                           
c            type: event type:L,R or D                                          
c	     sub_class: for local volcanic events only. See 
C 			VOLCANO.DEF in DAT dir                                        
c            sdir: dirctory for S-files, deafault (blank) is agency:...            
c            trace_file: trace file name                                        
c     Output:event_name: S - file name                                         
c            data: standard data readings array with one help line              
c                                                                               
c                                    
      implicit none
      integer year,month,day,hr,min                               
c--input-output                                
      character*80      event_name	
c--------------                                
      character*80      trace_file	
c--------------                                     
      character*40      sdir		
c--------------                                           
      character*2	type		
c--------------                                           
      character*6	sub_class_flag
c--------------                                     
      character*80  	data(*)		
c-- seconds                                                      
      real		sec		
c-- seconds                                        
      integer		isec            
c-- disk and directory name lengths                       
      integer		l1	
c-- number of header lines in temp. s-file
      integer nhead
c-- number of additional header lines to be added
      integer nh
c-- number of record lines in temp. s-file including headers
      integer nrecord
c-- system time
      character*12 p_time
      character*14 proc_time
c-- id line
      character*80 idline
c-- operator
      character*4 operator
      character*5 agency
      integer 		i	
c-- volcano line
      character*80 volc_line
c-- counter
      integer x


      call get_def_base(agency)

c
c   check on default data base
c
      if(sdir(1:5).eq.'     ') sdir(1:5)=agency

      do x=2,5
        if (sdir(x:x).eq.' ') sdir(x:x)='_'  
      enddO
c                                                                               
c   make output file name                                                       
c                                                                               
      isec=sec
      call sfilname
     *(year,month,day,hr,min,isec,sdir(1:5),type(1:1),event_name,l1)
c
c  make sure nhead and nrecord has reasonable values
c
      if(nrecord.lt.2) then
         nrecord=3
         nhead=2
      endif
c
c  shift possible readings
c
c     nh=2   ! changed lo
      nh=1
      if(type(2:2).eq.'V') nh=nh+1
      do i=nrecord,nhead+1,-1
        data(i+nh)=data(i)
      enddo
      nhead=nhead+nh
      nrecord=nrecord+nh
c                                                                               
c   write header line in file always with type '1' at the end        
c                                                                               
      write(data(1),'(1x,i4,1x,2i2,1x,2i2,1x,f4.1,1x,a2)')                      
     *year,month,day,hr,min,sec,type                                            
      write(data(1)(80:80),'(a1)')'1'
c
c   next line is id line
c
      idline(1:40)= ' ACTION:                   OP:     STATU'
      idline(41:80)='S:               ID:                   I'
      WRITE(IDLINE(61:75),'(i4,5I2)')
     *YEAR,MONTH,DAY,HR,MIN,ISEC
      DO I=61,74
         IF(IDLINE(I:I).EQ.' ') IDLINE(I:I)='0'
      ENDDO
      call systime(p_time,proc_time)
      WRITE(IDLINE(31:34),'(A)')OPERATOR
      WRITE(IDLINE(13:26),'(A)')PROC_TIME
      WRITE(IDLINE(9:11),'(A)')'REG'
      data(2)=idline

c
c-- next line is trace data file name                   
c                                                                               
c  trace file name                                                 
c                                                                               
c-- blank whole string                        
      do i=1,80
        data(3)(i:i)=' '
      enddo
      i=index(trace_file,' ')-1
      data(3)(2:i+1)=trace_file(1:i)                                            
      data(3)(80:80)='6'

c
c construct the volcano line if required
c
      if(type(2:2).eq.'V') then 
        do i=1,80
          volc_line(i:i)=' '
        enddo
        volc_line(2:10)='VOLC MAIN'
        volc_line(12:17)=sub_class_flag
        volc_line(80:80)='3'
        data(4)=volc_line

        data(5)(1:57)=
     *' STAT SP IPHASW D HRMM SECON CODA AMPLIT PERI AZIMU VELO '               
c        data(5)(58:80)='SNR AR TRES W  DIS CAZ7'
        data(5)(58:80)='AIN AR TRES W  DIS CAZ7'

      else

        data(4)(1:57)=
     *' STAT SP IPHASW D HRMM SECON CODA AMPLIT PERI AZIMU VELO '               
c        data(4)(58:80)='SNR AR TRES W  DIS CAZ7'
        data(4)(58:80)='AIN AR TRES W  DIS CAZ7'

      endif


c-- blank last line                                    
      do i=1,80                                                                 
         data(nrecord)(i:i)=' '		
      enddo                                                                     
      return                                                                    
      end                  
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                                                     
        subroutine make_res_file(nrecord,data,nsynt)
c
c   update array data so residuals have been added to the travel times
c   and put at end of array as synthetics for residual plotting
c
        implicit none
        include 'seidim.inc'
        include 'libsei.inc'             !  Library definitions & data defns.
        character*80 data(*), data_out(max_data)
        character*80 text
        integer nrecord
        integer hour,min
		integer unit           ! file unit
        logical exist          ! true if file exist
        integer code           ! code for open
        integer nsynt          ! number of calculated phases
        real sec
        real res               ! residual
        real time              ! time in seconds
        integer i,k
c
c   read results from print.out file
c
      call sei open( old$+ignore$,            ! Try to open & warn.
     &               ' ',                     ! No prompt.
     &               'print.out',             ! This file.
     &               unit,                    ! On unit.
     &               exist,                   ! File exists?.
     &               code )                   ! Condition.
c
c    File exists and is open!!..
c
c   find start of event
c
  10    continue
        read(unit,'(a)',end=50) text
        if(text(2:4).eq.'stn') goto 20
        goto 10
  20    continue
c
c   read results
c
        k=1
  30    continue
        read(unit,'(a)') text
        if(text(2:6).eq.'    ') goto 40   ! end of stations
        data_out(k)=' '
        data_out(k)(2:6)=text(2:6)
        data_out(k)(11:18)=text(34:41)    ! output phase
        read(text(42:50),'(2i2,f5.2)') hour,min,sec
        read(text(65:71),'(f7.2)') res
        time=hour*3600+min*60.0+sec-res
        if(time.ge.0.0) then
           hour= time/3600
           min=(time-hour*3600)/60
           sec=time-hour*3600-min*60
           write(data_out(k)(19:28),'(2i2,1x,f5.2)') hour,min,sec
        else
           write(data_out(k)(19:28),'(2i2,1x,f5.1)') hour,min,time
        endif
        data_out(k)(10:10)='y'      ! indicate calculated time
        k=k+1
        goto 30
c
c   finish station list
c
  40    continue
c
c   put back in data array, first clear other synthetic readings
c
          do i=1,nsynt
             data(max_data-i+1)=' '
          enddo
c
          nsynt=k-1
          do i=1,nsynt
             data(max_data-i+1)=data_out(i)
          enddo
            if((nrecord+nsynt).ge.max_data) then
              call clear_to_alpha
              write(6,*)
     *      ' Too many real and synthetic phases'
              stop
            endif
c
c   no data
c
 50      continue
c
c   close print.out file
c
         call sei close( close$, unit, code ) ! Close (default stop on error).
         return
         end                 
c
                                                                                              
cc      subroutine auto_tr(data,nhead,nfile,filename)
ccc moved to LIB
ccc
ccc   routine to get trace file names for nordic file
ccc
ccc   input:
ccc   data: nordic S-file
ccc   nhead: number of headers in file
ccc   output:
ccc   nfile: number of waveform files
ccc   filename: waveform files
ccc
cc      implicit none
cc      character*80 data(*)
cc      character*80 filename(*)
cc      integer nhead,nfile
c
c-- help variables
c
cc      integer i
cc      nfile=0
c
cc      do i=2,nhead
cc         if(data(i)(80:80).eq.'6') then
cc            nfile=nfile+1
cc            filename(nfile)(1:78)=data(i)(2:79)
cc            filename(nfile)(79:80)=' '
cc          endif
cc      enddo
ccc
cc      return
cc      end


c----------------------------------------------------------------------------   
      subroutine cbase_select(cbase,cbase_def,n_cbase_in,n_cbase_out)         
c                                                                               
c                                                                               
c     Routine toselect continuous databases.
c                                                                               
c     Input:   cbase                : list of continuous databases              
c              cbase_def            : index list of default databases (SEISAN.DEF)
c              n_cbase_in           : number of databases in
c                                                                               
c     Output   n_cbase_out          : number of databases in
c
      implicit none
      include 'mulplt.inc'
c
c------------------------------------------------------
      include 'libsei.inc'              ! Library definitions & data defns.
      external   sei integer            ! Extract integer from string.
      integer    sei integer            ! & function.
c---------------- end of sei lib changes --------------
c-- number of file names in file                  
      integer n_cbase_in
c-- number of files selected
      integer n_cbase_out
      character*(*) cbase(*)
      integer cbase_def(*)
c-- selected array                               
      integer on(80)
      integer order_out(1000)      ! order after sorting
      character*80 box_text(1000),box_text_local(80)
      character*120 title
c-- last character pushed in input_box
      character*1 last_char
      integer nfile_page           ! number of files, one page
      integer npage                ! number of pages
c-- Counters                                               
      integer i,k,ipage		

c
c   sort file names
c
      call  text_sort(cbase,box_text,order_out,
     *                n_cbase_in)        

c
c  put in text for boxes if no sorting, else done above
c
      if(.not.chan_sort) then
         do i=1,n_cbase_in
           box_text(i)=' '
           box_text(i)=cbase(i)
           on(i)=cbase_def(i)
         enddo
      endif
c
c   display boxes
c
      title=
     *'SELECT DATABASES, FILLED OUT BOXES INDICATE SELECTION'

c
c   loop to show many pages of file names
c
      npage=(n_cbase_in-1)/75+1           ! max 75 names per page
      k=1                                 ! counter for selected files

       
      do ipage=1,npage
c
c   check if last page
c
          if(ipage.eq.npage) then
              title(81:120)=' '
              nfile_page=n_cbase_in-(ipage-1)*75
          else
              title(81:120)=' More databases, push OK or F'
              nfile_page=75
          endif
c
c   transfer data to local array
c
          do i=1,nfile_page
             box_text_local(i)=box_text(i+(ipage-1)*75)
          enddo
c
c   display one page
c     
          call input_box(nfile_page,on,3,330.0,15.0,
     *                     box_text_local,35,
     *                     3.0,max_ypos+30.0,title,last_char,1,0)
c
c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            n_cbase_out=0
            return
         end if                           !
c
c   put selected files at top of list
c
         do i=1,nfile_page
            if(on(i).eq.1) then
               cbase(k)=box_text(i+(ipage-1)*75)
               k=k+1
               on(i)=0       ! clear for next page
            endif
         enddo
      enddo

      n_cbase_out=k-1
                                                            
      return                                                                    
      end                                                                       

c----------------------------------------------------------------------------   
      subroutine wav_select(n_wav_file,n_wav_out)                               
c                                                                               
c                                                                               
c     Routine to show wav file names and select files to plot.             
c                                                                               
c     written by  j. havskov                                     
c                                                                               
c     Input:   n_wav_file           : in input file                             
c              wav_filename         : all waveform file names       
c                                                                               
c     Output   n_wav_out            : number of wav files selected               
c              wav_filename         : selected files
c
      implicit none
      include 'mulplt.inc'
c
c------------------------------------------------------
      include 'libsei.inc'              ! Library definitions & data defns.
      external   sei integer            ! Extract integer from string.
      integer    sei integer            ! & function.
c---------------- end of sei lib changes --------------
c-- channels selected                             
c-- number of file names in file                  
      integer n_wav_file
c-- number of files selected
      integer n_wav_out
c-- selected array                               
      integer on(80)
      integer order_out(1000)      ! order after sorting
      character*80 box_text(1000),box_text_local(80)
      character*120 title
c-- last character pushed in input_box
      character*1 last_char
      integer nfile_page           ! number of files, one page
      integer npage                ! number of pages
c-- Counters                                               
      integer i,k,ipage		

c
c   sort file names
c

      call  text_sort(wav_filename,box_text,order_out,
     *                n_wav_file)        

  
c
c  put in text for boxes if no sorting, else done above
c
      if(.not.chan_sort) then
         do i=1,n_wav_file
           box_text(i)(1:35)=wav_filename(i)(1:35)
         enddo
      endif
c
c   display boxes
c
      title=
     *'SELECT FILENAMES, FILLED OUT BOXES INDICATE SELECTION'

c
c   loop to show many pages of file names
c
      npage=(n_wav_file-1)/75+1           ! max 75 names per page
      k=1                                 ! counter for selected files

       
      do ipage=1,npage
c
c   check if last page
c
          if(ipage.eq.npage) then
              title(81:120)=' '
              nfile_page=n_wav_file-(ipage-1)*75
          else
              title(81:120)=' More files, push OK or F'
              nfile_page=75
          endif
c
c   transfer data to local array
c
          do i=1,nfile_page
             box_text_local(i)=box_text(i+(ipage-1)*75)
          enddo
c
c   display one page
c     
          call input_box(nfile_page,on,3,330.0,15.0,
     *                     box_text_local,35,
     *                     3.0,max_ypos+30.0,title,last_char,1,0)
c
c   Quit...
c
         if(last_char.eq.'Q'.or.last_char.eq.'q') then
            n_wav_out=0
            return
         end if                           !
c
c   put selected files at top of list
c
         do i=1,nfile_page
            if(on(i).eq.1) then
               wav_filename(k)=box_text(i+(ipage-1)*75)
               k=k+1
               on(i)=0       ! clear for next page
            endif
         enddo
      enddo

      n_wav_out=k-1
c
c   mark in s-file if more than one
c
cfix  is this really needed, cannot see it, delete ???
c      k=2
c      if(n_wav_out.gt.1) then
c        do i=1,n_wav_file
c 200       continue
c           if(k.gt.nhead) then
c              write(6,*)' Something wrong in file selection'
c              stop
c           endif
c           if(data(k)(80:80).eq.'6') then
c              if(on(i).eq.1) data(k)(1:1)='*'
c              k=k+1
c           else
c              k=k+1
c              goto 200
c           endif
c        enddo
c      endif
                     
                                                            
      return                                                                    
      end                                                                       
c----------------------------------------------------------------------------   
      subroutine wav_select_del(n_wav_file,n_wav_out)                               
c                                                                               
c                                                                               
c     Routine to show wav file names and select files to delete.             
c                                                                               
c     written by  j. havskov                                     
c                                                                               
c     Input:   n_wav_file           : input file                             
c              wav_filename         : all waveform file names       
c
c     Output:  n_wav_out            : number of wav files selected     
c                                   : selected files
c
      implicit none
      include 'mulplt.inc'
c
c------------------------------------------------------
      include 'libsei.inc'              ! Library definitions & data defns.
      external   sei integer            ! Extract integer from string.
      integer    sei integer            ! & function.
c---------------- end of sei lib changes --------------
c-- channels selected                             
      integer n_wav_file
c-- number of files selected
      integer n_wav_out
c-- selected array                               
      integer on(100)
      character*80 box_text(100),title
c-- last character pushed in input_box
      character*1 last_char
c-- Counters                                               
      integer i,k,knew,l
      character*1 dchar
c
      call dir_char(dchar)
	  
c
c  put in text for boxes
c
      k=0
      do i=1,n_wav_file
        if(wav_filename(i)(1:1).ne.dchar) then
           k=k+1
           box_text(k)(1:35)=wav_filename(i)(1:35)
        endif
      enddo
      knew=k
c
c   display boxes
c
      title=
     *'SELECT FILES FOR DELETION'
cx      if(n_wav_file.gt.22) then
      if(knew.gt.22) then
cx         call input_box(n_wav_file,on,2,300.0,20.0,box_text,35,
         call input_box(knew,on,2,300.0,20.0,box_text,35,
     *                    400.0,max_ypos-50.0,title,last_char,0,0)
      else
         call input_box(knew,on,1,300.0,20.0,box_text,35,
cx         call input_box(n_wav_file,on,1,300.0,20.0,box_text,35,
     *                    700.0,max_ypos-50.0,title,last_char,0,0)
      endif
c
c   Quit...
c
      if(last_char.eq.'Q'.or.last_char.eq.'q') then
         n_wav_out=0
         return
      end if                           !
c
c   put  selected files at top of list
c
      k=1
cx      do i=1,n_wav_file
      do i=1,knew
         if(on(i).eq.1) then
cx            wav_filename(k)=wav_filename(i)
            wav_filename(k)=' '
            wav_filename(k)(1:35)=box_text(i)(1:35)
            k=k+1
         endif
      enddo
      n_wav_out=k-1
c
c   mark in s-file files to be deleted if one or more
c
      k=2
      if(n_wav_out.ge.1) then
cx        do i=1,n_wav_file
        do i=1,knew
 200       continue
           if(k.gt.nhead) then
              write(6,*)' Something wrong in file selection'
              stop
           endif
           if(data(k)(80:80).eq.'6') then
              do l=1,n_wav_out
                 if(wav_filename(l)(1:35).eq.data(k)(2:36)) 
     *           data(k)(1:1)='*'
              enddo
cx              if(on(i).eq.1) data(k)(1:1)='*'
              k=k+1
           else
              k=k+1
              goto 200
           endif
        enddo
      endif
                     
                                                            
      return                                                                    
      end                                                                       
c----------------------------------------------------------------------------   
      subroutine wav_select_mer(n_wav_file,n_wav_out)                               
c                                                                               
c                                                                               
c     Routine to show wav file names and select files to merge.             
c                                                                               
c     written by  j. havskov                                     
c                                                                               
c     Input:   n_wav_file           : input file                             
c              wav_filename         : all waveform file names       
c
c     Output:  n_wav_out            : number of wav files selected     
c
      implicit none
      include 'mulplt.inc'
c
c------------------------------------------------------
      include 'libsei.inc'              ! Library definitions & data defns.
      external   sei integer            ! Extract integer from string.
      integer    sei integer            ! & function.
c---------------- end of sei lib changes --------------
c-- number of file names in file                  
      integer n_wav_file
c-- number of files selected
      integer n_wav_out
c-- selected array                               
      integer on(100)
      character*80 box_text(100)
      character*120 title
c-- last character pushed in input_box
      character*1 last_char
c-- Counters                                               
      integer i,k,l,knew		
      character*1 dchar
     
      call dir_char(dchar)
      n_wav_out=0    ! initially nothing selected	  
c
c  put in text for boxes, only select files in working directory
c
      k=0
      do i=1,n_wav_file
        if(wav_filename(i)(1:1).ne.dchar) then
           k=k+1
           box_text(k)(1:35)=wav_filename(i)(1:35)
        endif
      enddo
      knew=k

c
c   display boxes
c
      title=
     *'Select files for merging in current directory'
      if(knew.gt.22) then
         call input_box(knew,on,2,300.0,20.0,box_text,35,
     *                    400.0,max_ypos-50.0,title,last_char,0,0)
      else
         call input_box(knew,on,1,300.0,20.0,box_text,35,
     *                    700.0,max_ypos-50.0,title,last_char,0,0)
      endif

c
c   Quit...
c
      if(last_char.eq.'Q'.or.last_char.eq.'q') then
         n_wav_out=0
         return
      end if                           !
c
c   put  selected files at top of list
c
      k=1
      do i=1,knew
         if(on(i).eq.1) then
            wav_filename(k)=' '
            wav_filename(k)(1:35)=box_text(i)(1:35)
            k=k+1
         endif
      enddo
c
      n_wav_out=k-1
c
c   mark in s-file if two or more
c
      k=2
      if(n_wav_out.ge.1) then
        do i=1,knew
 200       continue
           if(k.gt.nhead) then
              write(6,*)' Something wrong in file selection'
              stop
           endif
           if(data(k)(80:80).eq.'6') then
              do l=1,n_wav_out
                 if(wav_filename(l)(1:35).eq.data(k)(2:36))
     *           data(k)(1:1)='*'
              enddo
              k=k+1
           else
              k=k+1
              goto 200
           endif
        enddo
      endif


                                                            
      return                                                                    
      end                                                                       
******************************************************************              
      subroutine read_s_file

c
c   open and read s-file, close
c
c   see main program for variables
c
      implicit none
      include 'mulplt.inc'
      include 'libsei.inc'
      integer read_unit
      logical b_flag
      integer code,nstat,nphase,id
      character*1 exp,type
      
              call sei open( old$,                 ! Open old file.
     &                  ' ',                  ! No prompt.
     &                  sfile,                ! This file.
     &                  read_unit,            ! On this unit.
     &                  b_flag,               ! Existance?.
     &                  code )                ! Condition (n/a).
             call indata
     *       (read_unit,nstat,nphase,nhead,nrecord,type,exp,data,id)
             call sei close(close$,read_unit,code)    ! Close (stop on error).
       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine write_s_file

c
c   open and write s-file, close 
c   do not write synthetic phases
c
c   see main program for variables
c
      implicit none
      include 'mulplt.inc'
      include 'libsei.inc'
      integer write_unit
      logical b_flag
      integer code,i,nrecord_old
      
              call sei open( old$,            ! Open old file.
     &                  ' ',                  ! No prompt.
     &                  sfile,                ! This file.
     &                  write_unit,           ! On this unit.
     &                  b_flag,               ! Existance?.
     &                  code )                ! Condition (n/a).
              if( code .ne. e_ok$ ) then                     !
                 code = e_ok$                                ! Restore.
                 write(6,*)' Error opening S-file'
                 write(6,*)
     *           ' You might not be allowed to change data base'
c                write(6,*)' Return to continue'
                 call flush (6)
c                read(5,'(a)') i
                 goto 1                                        ! & skip out.
              endif

              do i=1,nrecord
                 if(.not.(data(i)(10:10).eq.'y'.and.i.gt.nhead))
     *           write(write_unit,'(a80)',err=10)data(i)
              enddo
              goto 1
 10           continue
c
c   only write message first time if no change
c
                 if(nrecord_old.ne.nrecord) then
                    write(6,*)' Error writing to S-file,',
     *              ' you might not be allowed to change data base'
c                   write(6,*)' Return to continue'
                    call flush (6)
c                   read(5,'(a)') i
                    nrecord_old=nrecord
                 endif
 1           continue
             call sei close(close$,write_unit,code)    ! Close (stop on error).
       return
       end

       subroutine get_synt(nsynt,synt_head)
c
c   put possibele syntethic readings into data array
c
c   variable names as defined in mulplt main
c
       implicit none
       include 'mulplt.inc'
       include 'libsei.inc'
       character*80 text
       integer read1,code,nsynt,k
       character*10 synt_head
       logical exist

      call sei open( old$+ignore$,            ! Try to open & warn.
     &               ' ',                     ! No prompt.
     &               'iasp.out',              ! This file.
     &               read1,                   ! On unit.
     &               exist,                   ! File exists?.
     &               code )                   ! Condition.
c
c    File exists and is open!!..
c
      if (exist) then                                                           
      code = e_ok$                            ! Re-set condition.
c
c  delete all from data and down
c
      do k=nrecord+1,max_data
         data(k)=' '
      enddo
c
c  read
c
          k=0
          read(read1,'(a)',end=99) text       ! header line
 1        continue
          read(read1,'(a)',end=99) data(max_data-k) ! read into end of array
          if(k.ge.max_data-300) then  ! leave room for at least 300 phase lines
              write(6,*)
     *      ' Too many synthetic phases, check iasp.out'
              nsynt=k
              return
          endif
          if(data(max_data-k).eq.' ') goto 99
          k=k+1
          goto 1
c
 99       continue
c
c  all data read
c
          nsynt=k
          synt_head=text(1:10)   ! save date of synthetic data
          call sei close( close$, read1, code ) ! Close (default stop on error).
      endif

      return
      end

      subroutine add_synt_readings(nsynt,synt_head)
c
c   add synthetic readings if any, however only if the data is from
c   the same day
c
c   for explanation of variables, see main program
c
      implicit none
      include 'mulplt.inc'
      integer nsynt,k
      character*10 synt_head  ! date of synthetic records
c
c if character 7 or 9 of data(1)=0, make blank   LO , apr 97
c
      if (data(1)(7:7).eq.'0') data(1)(7:7)=' '
      if (data(1)(9:9).eq.'0') data(1)(9:9)=' '
         if(nsynt.gt.0.and.synt_head(4:10).eq.data(1)(4:10)) then      
            if((nrecord+nsynt).ge.max_data) then
               write(6,*)
     *         ' Too many real and synthetic phases'
                write(6,*)' Return to continue'
                call flush (6)
                read(5,'(a)') k
                stop
             endif
          data(nrecord+nsynt)=data(nrecord)
          do k=1,nsynt
             data(nrecord-1+k)=data(max_data-k+1)
          enddo
          nrecord=nrecord+nsynt
       endif
       return
       end


