subroutine readergse(fndata,idv,idn,ide,ids,datath,ms,dt,npts,ier) c c read 3d recording from datafile im GSE format c uses GSE stuff from Kradolfer's CODECO c a.tento 05/2002 v.1.0 c ids --> station name (if available) c ier : description c 1 - 3 no logical unit available (internal error) c 5 file not found c 7 number of points greater than dimension c 9 error in opening file c 15 error in dimesion of time history vector c 17 error in reading file : not found some components c 19 npts > dimens c 21 sampling rate has changed among channels c 23 number of samples has changed among channels c c implicit none character fndata*200, idv*3, idn*3, ide*3, ids*10 integer ms, npts, ier real datath, dt dimension datath(ms,3) c integer ckesfi, i, nunit, nunito, iread, k, nsmplh character idsh*10, idch(3)*3 real twopi, conv, smprh, rnano parameter (twopi = 6.2831853071795864769252867663e+0) parameter (rnano = 1.0e-9) c include 'codeco_common.f' integer iy, ichecksum, ierr character*1 cbuf(c_bufsize) dimension iy(c_sigsize) c c c if ( c_sigsize .lt. ms ) then write(*,*)' READERGSE : this error should be impossible' write(*,*)' Check dimension consistency in include file' write(*,*)' ( c_sigsize < maxsamp ?? ) ' ier = 15 return endif c ier = 0 c call glun(nunit, ier) if ( ier .ne. 0 ) then write(*,*)' READERGSE : this error should be impossible' write(*,*)' no logical unit available' ier = 1 return endif c if ( ckesfi(fndata) .ne. 0 ) then write(*,*)' READERGSE : this file cannot be found :' write(*,100)fndata ier = 5 return endif c open(nunit,file=fndata,status='old',err=98) c call glun(nunito, ier) if ( ier .ne. 0 ) then write(*,*)' READERGSE : this error should be impossible' write(*,*)' no logical unit available' ier = 1 return endif open(nunito,status='scratch') c idsh=ids idch(1) = idv idch(2) = idn idch(3) = ide iread = 0 smprh = -999.0 nsmplh = -9999 111 continue if ( iread .eq. 3 ) goto 333 call init_hdrvars hdr_debug = 0 call gsein(nunit,nunito,cbuf,iy,ichecksum,ierr) if ( ierr .ne. 0 ) goto 95 if ( idsh .eq. ' ' ) idsh = hdr_station if ( idsh .ne. hdr_station ) goto 111 do 1 i = 1, 3 k = i if ( hdr_chan .eq. idch(i) ) goto 2 1 continue goto 111 2 continue c cambiare gse_io --> hdr_samp < csigsize esce poi riprende a leggere c cercando WID2 c if ( hdr_nsamp .gt. ms ) goto 94 c if ( smprh .lt. 0.0 ) smprh = hdr_smprate if ( nsmplh .lt. 0 ) nsmplh = hdr_nsamp if ( smprh .ne. hdr_smprate ) goto 93 if ( nsmplh .ne. hdr_nsamp ) goto 92 idch(k) = ' ' iread = iread + 1 c c data are supposed to be velocity conv = 1.0 if (hdr_calunit .eq. 0 ) # conv = ((hdr_calfac * twopi) / hdr_calper) * rnano if (hdr_calunit .eq. 1 ) # conv = hdr_calfac * rnano if (hdr_calunit .eq. 2 ) # conv = ((hdr_calfac * hdr_calper) / twopi) * rnano c do 3 i = 1, hdr_nsamp datath(i,k)= float(iy(i)) * conv 3 continue c goto 111 c c O.K. 333 continue dt = 1.0/hdr_smprate npts = hdr_nsamp close(nunit) close(nunito) return c c c number of samples has changed 92 write(*,*)' READERGSE : number of samples has changed among ' write(*,*)' channels in file:' write(*,100)fndata close(nunit) close(nunito) ier = 23 return c c sampling rate has changed 93 write(*,*)' READERGSE : sampling rate has changed among channels' write(*,*)' in file:' write(*,100)fndata close(nunit) close(nunito) ier = 21 return c c npts > dimens 94 write(*,*)' READERGSE : number of samples : ', hdr_nsamp write(*,*)' greater than dimension : ', ms write(*,*)' in file:' write(*,100)fndata close(nunit) close(nunito) ier = 19 return c c ierr = 999 gse_io 95 write(*,*)' READERGSE : following channel(s) cannot be found' write(*,300)(idch(i), i=1,3), idsh write(*,*)' in file:' write(*,100)fndata close(nunit) close(nunito) ier = 17 return c c error in opening file 98 write(*,*)' READERGSE : this file cannot be opened' write(*,100)fndata ier = 9 return c c c 100 format(2x,a200) 200 format(a200) 300 format(' channel(s) : ',3(2x,a3),' for station : ',a10) c c end