subroutine readerth(indx,ier) c c read time history file unless already in memory c offeset removal or high pass filtering if required c c indx = main loop index (loop over time windows) c a.tento 4/02 v.1.0. c a.tento 6/02 v.1.1. cityshark + saf + gse c a.tento 5/03 v.1.2. new options for offset removal c a.tento 10/03 v.1.3. new option for offset removal c a.tento 02/04 v.1.4. storage of labels for ploting c c format index : 1 = gse, 2 = saf, 3 = cityshark c implicit none include 'main.h' include 'times.h' include 'window.h' include 'parameters.h' c c....... /SAFHDR8/ v. 2.1 integer length parameter ( length = 100 ) integer year, month, day, hour, minute, isec, msec, ndat real second, samp_freq, north_rot, gain character*(length) sta_code, ch0_id, ch1_id, ch2_id, units common /safhdr8/ year, month, day, hour, minute, isec, # msec, ndat, second, samp_freq, north_rot, gain, # sta_code, ch0_id, ch1_id, ch2_id, units c c integer indx, ier c real dt, hpfre, lpfre, sfre integer nw, irow character argout(20)*200, sep2*1 parameter (sep2 = ':') c ier = 0 if ( indx .gt. 1 ) then if ( data_file(indx) .eq. data_file(indx-1) .and. # idV(indx) .eq. idV(indx-1) .and. # idN(indx) .eq. idN(indx-1) .and. # idE(indx) .eq. idE(indx-1) .and. # idfor(indx) .eq. idfor(indx-1) .and. # idsta(indx) .eq. idsta(indx-1) ) then kv(indx) = kv(indx-1) kn(indx) = kn(indx-1) ke(indx) = ke(indx-1) kunits(indx) = kunits(indx-1) return endif endif c c read file from disk c 1 read GSE if ( idfor(indx) .eq. 1 ) then call readergse(data_file(indx),idV(indx),idN(indx),idE(indx), # idsta(indx),datath,maxsamp,dt,n_samples,ier) if ( ier .ne. 0 ) ier = 1 kv(indx) = idV(indx) kn(indx) = idN(indx) ke(indx) = idN(indx) kunits(indx) = 'm/s' c 2 read SAF elseif ( idfor(indx) .eq. 2 ) then call rsaf(data_file(indx),maxsamp,0,datath,n_samples,sfre,ier) if ( ier .eq. 0 ) dt = 1./sfre kv(indx) = ch0_id kn(indx) = ch1_id ke(indx) = ch2_id kunits(indx) = units if ( ier .eq. 2 .or. ier .eq. 3) then write(*,*)' RSAF : this error should be impossible' write(*,*)' problem in getting an unused fortran file unit' ier = 1 endif if ( ier .eq. 4 ) then write(*,*)' RSAF : this file cannot be opened' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 7 ) then write(*,*)' RSAF : mandatory parameters are not entirely set' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 8 ) then write(*,*)' RSAF : number of samples : ', n_samples write(*,*)' greater than dimension : ', maxsamp write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 8 ) then write(*,*)' RSAF : error reading time histories data' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 50 ) then write(*,*)' RSAF : the opened file is NOT a current version SAF' write(*,100)data_file(indx) ier = 1 endif if ( ier .gt. 1000 ) then irow = ier - 1000 write(*,*)' RSAF : problem reading line number :',irow write(*,100)data_file(indx) ier = 1 endif c 3 read City Shark elseif ( idfor(indx) .eq. 3 ) then call readercs(data_file(indx),datath,maxsamp,dt,n_samples,ier) kv(indx) = 'Vert' kn(indx) = 'N-S' ke(indx) = 'E-W' kunits(indx) = 'm/s' if ( ier .eq. 1 .or. ier .eq. 3) then write(*,*)' READERCityShark : this error should be impossible' write(*,*)' problem in getting an unused fortran file unit' ier = 1 endif if ( ier .eq. 5 .or. ier .eq. 9 ) then write(*,*)' READERCityShark : this file cannot be opened' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 7 ) then write(*,*)' READERCityShark : number of samples : ', # n_samples write(*,*)' greater than dimension : ', maxsamp write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 11 ) then write(*,*)' READERCityShark : error reading time histories data' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 13 ) then write(*,*)' READERCityShark : this is NOT a CityShark file' write(*,100)data_file(indx) ier = 1 endif if ( ier .eq. 15 ) then write(*,*)' READERCityShark : found less data points than', # ' those specified in the header' write(*,100)data_file(indx) ier = 1 endif c c UNCORRECT FILE FORMAT INDEX else write(*,*)' incorrect format index : ', idfor(indx),' file:' write(*,100)data_file(indx) ier = 1 endif c c if ( ier .eq. 1 ) goto 99 c c if ( indx .eq. 1 ) then sampling_rate = dt else if ( dt .ne. sampling_rate ) then write(*,*)' READERTH: sampling rate previously found : ', # sampling_rate write(*,*)' present sampling rate : ', dt write(*,100)data_file(indx) ier = 1 endif endif c if ( ier .eq. 1 ) goto 99 c c if ( indx .eq. 1 ) then c call split3(instrument_resp,argout,sep2,nw) c if (argout(1) .eq. 'yes') then c write(*,*)' WARNING : NO instrument correction provided in', c # ' the current software version' c ier = 2 c endif c call split3(offset_rem,argout,sep2,nw) if (argout(1) .eq. 'r_mean') then if(argout(2) .eq. 'all' .or. nw .eq. 1) then call rmean(datath,maxsamp,n_samples) endif elseif (argout(1) .eq. 'high-pass') then read(argout(2),*) hpfre lpfre = 1.0e+25 call hps(datath,maxsamp,n_samples,dt,hpfre,lpfre) elseif (argout(1) .eq. 'band-pass') then read(argout(2),*) hpfre read(argout(3),*) lpfre call hps(datath,maxsamp,n_samples,dt,hpfre,lpfre) elseif (argout(1) .eq. 'low-pass') then read(argout(2),*) lpfre hpfre = 1.0e+25 call hps(datath,maxsamp,n_samples,dt,hpfre,lpfre) elseif (argout(1) .ne. 'no' ) then write(*,200)offset_rem ier = 1 endif c c 99 return c 100 format(1x,a200) 200 format(' ERROR in ''offset removal'' parameter: ', a80,/, # ' The key is NOT recognised') c end