C INTERNATIONAL AVS CENTER C (This disclaimer must remain at the top of all files) C C WARRANTY DISCLAIMER C C This module and the files associated with it are distributed free of charge. C It is placed in the public domain and permission is granted for anyone to use, C duplicate, modify, and redistribute it unless otherwise noted. Some modules C may be copyrighted. You agree to abide by the conditions also included in C the AVS Licensing Agreement, version 1.0, located in the main module C directory located at the International AVS Center ftp site and to include C the AVS Licensing Agreement when you distribute any files downloaded from C that site. C C The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module provide absolutely C NO WARRANTY OF ANY KIND with respect to this software. The entire risk as to C the quality and performance of this software is with the user. IN NO EVENT C WILL The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module BE LIABLE TO C ANYONE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE, INCLUDING, C WITHOUT LIMITATION, DAMAGES RESULTING FROM LOST DATA OR LOST PROFITS, OR ANY C SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES. C C This AVS module and associated files are public domain software unless C otherwise noted. Permission is hereby granted to do whatever you like with C it, subject to the conditions that may exist in copyrighted materials. Should C you wish to make a contribution toward the improvement, modification, or C general performance of this module, please send us your comments: why you C liked or disliked it, how you use it, and most important, how it helps your C work. We will receive your comments at avs@ncsc.org. C C Please send AVS module bug reports to avs@ncsc.org. C C NOTE: THIS MODULE AND SOURCE CODE IS FOR USE C WITH THE AVS SOFTWARE ENVIRONMENT ONLY C Module Name: "Read SEG Y" (Input) (Subroutine) C Module to read Seismic data in SEG "Y" format C Copyright (c) 1993 by C Advanced Visual Systems Inc. C All Rights Reserved C Author: John Tee * C AVS Consultant * C 17, Dawnay Road, Great Bookham * C Leatherhead, Surrey KT23 4PE, UK * C Date Created: Mon Jan 4 18:30:43 1993 C C End of Module Description Comments C **************************************** C Module Description C **************************************** subroutine AVSinit_modules implicit none C IAC CODE CHANGE : include 'avs/avs.inc' INCLUDE '/usr/avs/include/avs.inc' integer out_port, param external Read_segy_compute integer Read_segy_compute C Set up a common block between the initial descriptor and C the compute routine common /char_stuff/ cbuf character*3240 cbuf call AVSset_module_name('Read SEG Y', 'data') call AVSset_module_flags(single_arg_data) C Output Port Specifications out_port = AVScreate_output_port('field', & 'field 3D scalar real 3-space') C Parameter Specifications param = AVSadd_parameter('Read SEGY File Browser', 'string', & ' ', ' ', ':') call AVSconnect_widget(param, 'browser') param = AVSadd_parameter('Send Data', 'oneshot', 0, 0, 1) call AVSconnect_widget(param, 'oneshot') param = AVSadd_parameter('Samples/trace', 'integer', 1500, 100, & INT_UNBOUND) call AVSconnect_widget(param, 'typein_integer') param = AVSadd_parameter('Traces/file', 'integer', 200, 1, & INT_UNBOUND) call AVSconnect_widget(param, 'typein_integer') param = AVSadd_parameter('Byte order', 'integer', 1, 1, 4) call AVSconnect_widget(param, 'islider') param = AVSadd_parameter('Start sample', 'integer', 0, 0, 1500) call AVSconnect_widget(param, 'idial') param = AVSadd_parameter('End sample', 'integer', 0, 0, 1500) call AVSconnect_widget(param, 'idial') param = AVSadd_parameter('Start trace', 'integer', 1, 1, 200) call AVSconnect_widget(param, 'idial') param = AVSadd_parameter('End trace', 'integer', 200, 1, 200) call AVSconnect_widget(param, 'idial') param = AVSadd_parameter('Trace Header','string_block',' ', & ' ',' ') call AVSconnect_widget(param, 'text_block_browser') call AVSadd_parameter_prop(param, 'height', 'integer', 2) call AVSadd_parameter_prop(param, 'width', 'integer', 7) param = AVSadd_parameter('Reel Header2','string_block',' ', & ' ',' ') call AVSconnect_widget(param, 'text_block_browser') call AVSadd_parameter_prop(param, 'height', 'integer', 2) call AVSadd_parameter_prop(param, 'width', 'integer', 5) param = AVSadd_parameter('Reel Header1','string_block',' ', & ' ',' ') call AVSconnect_widget(param, 'text_block_browser') call AVSadd_parameter_prop(param, 'height', 'integer', 2) call AVSadd_parameter_prop(param, 'width', 'integer', 12) call AVSset_compute_proc(Read_segy_compute) return end C **************************************** C Module Compute Routine C **************************************** integer function Read_segy_compute( Field_Output, $ Read_SEGY_File_Browser, Send_Data, max_samples, max_traces, $ Byte_order, Start_sample, End_sample, Start_trace, End_trace, $ Trace_Header, Reel_Header2, Reel_Header1) implicit none C IAC CODE CHANGE : include 'avs/avs.inc' INCLUDE '/usr/avs/include/avs.inc' integer Field_Output character*(*) Read_SEGY_File_Browser integer Send_Data integer max_traces, max_samples, Byte_order integer Start_trace, Start_sample, End_trace, End_sample character*(*) Trace_Header character*(*) Reel_Header2 character*(*) Reel_Header1 common /char_stuff/ cbuf character*3240 cbuf external CFunf_close integer CFunf_close integer dimso, ofield, pfield real Output_data, Output_points dimension dimso(3), Output_data(1), Output_points(1) character*64 field_descriptor character*128 errbuf logical auto_byte_order integer nsamps, ntraces, byte_count, swapflag integer junk, iresult, status integer VAL_N_MIN, VAL_N_MAX VAL_N_MIN = IOR(AVS_VALUE, AVS_MINVAL) VAL_N_MAX = IOR(AVS_VALUE, AVS_MAXVAL) C Ensure that parameters are sensible C On a change of file, set End_Sample to zero so that we read only C the header, on the first pass if(avsparameter_changed('Read SEGY File Browser') .ne. 0) then End_sample = 0 Start_sample = 0 call avsmodify_parameter('End sample',VAL_N_MIN,0,0,0) call avsmodify_parameter('Start sample',VAL_N_MIN,0,0,0) endif if(avsparameter_changed('Traces/file') .ne. 0) then call avsmodify_parameter('End trace',AVS_MAXVAL,0,0, & max_traces) endif if(avsparameter_changed('Samples/trace') .ne. 0) then call avsmodify_parameter('End sample',AVS_MAXVAL,0,0, & max_samples) endif if(avsparameter_changed('Start trace') .ne. 0) then if(Start_trace .gt. End_trace) then End_trace = Start_trace endif call avsmodify_parameter('End trace',VAL_N_MIN, & End_trace,Start_trace,0) endif if(avsparameter_changed('End trace') .ne. 0) then if(End_trace .lt. Start_trace) then Start_trace = End_trace endif call avsmodify_parameter('Start trace',VAL_N_MAX, & Start_trace,0,End_trace) endif if(avsparameter_changed('End sample') .ne. 0) then if(End_sample .lt. Start_sample) then Start_sample = End_sample endif call avsmodify_parameter('Start sample',VAL_N_MAX, & Start_sample,0,End_sample) endif C The first time through, the filname will be NULL. Return a silent C error indicating that downstream modules should not be executed. if (Read_SEGY_File_Browser .eq. ' ') goto 9999 C Read the headers call read_header( Read_SEGY_File_Browser, nsamps, ntraces, & auto_byte_order, byte_order, byte_count, swapflag) if ((nsamps .gt. 0) .and. (nsamps .ne. max_samples)) then max_samples = nsamps call avsmodify_parameter('Samples/trace',AVS_VALUE, & max_samples,0,0) if (Start_sample .gt. max_samples) & call avsmodify_parameter('Start sample',AVS_VALUE, & max_samples,0,0) if (End_sample .gt. max_samples) & call avsmodify_parameter('End sample',AVS_VALUE, & max_samples,0,0) call avsmodify_parameter('End sample',AVS_MAXVAL,0,0, & max_samples) call avsmodify_parameter('Start sample',AVS_MAXVAL,0,0, & max_samples) endif if ((ntraces .gt. 0) .and. (ntraces .ne. max_traces)) then max_traces = ntraces call avsmodify_parameter('Traces/file',AVS_VALUE, & max_traces,0,0) if (Start_trace .gt. max_traces) & call avsmodify_parameter('Start trace',AVS_VALUE, & max_traces,0,0) if (End_trace .gt. max_traces) & call avsmodify_parameter('End trace',AVS_VALUE, & max_traces,0,0) call avsmodify_parameter('End trace',AVS_MAXVAL,0,0, & max_traces) call avsmodify_parameter('Start trace',AVS_MAXVAL,0,0, & max_traces) endif C Free old field data if (Field_Output .ne. 0) call AVSfield_free(Field_Output) dimso(1) = End_sample - Start_sample +1 dimso(2) = End_trace - Start_trace +1 dimso(3) = 1 field_descriptor = 'field 3D irregular scalar real 3-space' Field_Output = AVSdata_alloc(field_descriptor, dimso) if (Field_Output .eq. 0) then write(errbuf,90) field_descriptor 90 format('Error allocating field ',A) call AVSerror(errbuf) goto 200 endif C Set up to read all the data next time, if no samples selected if(End_sample .eq. 0) then call avsmodify_parameter('End sample',VAL_N_MIN, & max_samples,1,0) call avsmodify_parameter('Start sample',VAL_N_MIN, & 1,1,0) goto 200 endif iresult = AVSfield_data_offset(Field_Output, Output_data, & ofield) iresult = AVSfield_points_offset(Field_Output, Output_points, & pfield) junk = 2 * dimso(2) call read_data( Output_data(ofield+1), Output_points(pfield+1), & auto_byte_order, Byte_order, byte_count, swapflag, & Start_trace, Start_sample, & dimso(2), dimso(1), junk) 200 Read_segy_compute = 1 c Close tape status = CFunf_close() if(status .ne. 0) call AVSerror('Error closing file') return 9999 Read_segy_compute = 0 return end c Read the file/tape headers and display the info in text browsers c Also return the number of traces and samples defined in header2 subroutine read_header(filename, nsamples, ntraces, auto_byte_or $der, $ byte_order, byte_count,swapflag) C IAC CODE CHANGE : include 'avs/avs.inc' INCLUDE '/usr/avs/include/avs.inc' character*(*) filename integer nsamples, ntraces logical auto_byte_order integer byte_order, byte_count, swapflag common /char_stuff/ cbuf character*3240 cbuf external CFunf_open external CFunf_read integer CFunf_open integer CFunf_read character*128 errbuf integer header1(800) integer header2(100) byte bheader1(3200) c header 2 has 3 4-byte values followed by 24 2-byte values integer header2a(3) integer*2 header2b(24),tmp character*81 string character*24 hdr1, hdr2, hdr3, hdr4, hdr5 character*24 hdr6, hdr7, hdr8, hdr9, hdr10 character*24 hdr11, hdr12, hdr13, hdr14, hdr15 character*24 hdr16, hdr17, hdr18, hdr19, hdr20 character*24 hdr21, hdr22, hdr23, hdr24, hdr25 character*24 hdr26, hdr27 character cr integer j,k,k1,k2,jp integer status integer dontswap / 0 / integer hdr1_size / 3200/ integer hdr2a_size / 3/ integer hdr2b_size / 24 / equivalence (header1,bheader1) equivalence (header2,header2a) equivalence (header2(4),header2b) C EBCDIC conversion character*256 ebcdic character*64 e1,e2,e3,e4 e1 = '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' // & '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' e2 = '^^^^^^^^^^.^(+|&^^^^^^^^^!$*);^-' // & '/^^^^^^^^^,%_>?^^^^^^^^^ :#@''="' e3 = 'abcdefghi^^^^^^^jklmnopqr^^^^^^^' // & '~stuvwxyz^^^^^^^^^^^^^^^^^^^^^^^' e4 = 'ABCDEFGHI^^^^^^^JKLMNOPQR^^^^^^^' // & '^STUVWXYZ^^^^^^0123456789^^^^^^^' ebcdic = e1//e2//e3//e4 cr = char(10) status = CFunf_open(filename) if(status .ne. 0)goto 999 C This is a tricky bit! C The module first checks to see whether the first 4 bytes of the C file can be interpreted as a Fortran-style byte count containing C the value 3200 (the size of the first SEG Y header) C Four possible byte-ordering patterns are checked. C If none of them match, it is assumed that there are no byte-counts C in the data, and the "byte count" widget is used to provide the C byte ordering pattern. auto_byte_order = .TRUE. byte_count = CFunf_byte_order(hdr1_size, swapflag) if(swapflag .eq. 0)then C no byte count in the first word - not a Fortran-written file C couldnt determine the byte order C use the byte_order variable as a flag to indicate no byte counts auto_byte_order = .FALSE. C use the widget value to allow the operator to guess the byte order swapflag = byte_order C set up the byte-swapping data as CFunf_byte_order would have status = CFset_byte_order(swapflag) C close and re-open the file to start again from the first byte status = CFunf_close() if(status .ne. 0) call AVSerror('Error closing file') status = CFunf_open(filename) else byte_order = swapflag call avsmodify_parameter('Byte order',AVS_VALUE, & byte_order,0,3) endif C Read SEGY reel header 1 C Don't swap bytes here - character string data status = CFunf_read(hdr1_size,dontswap,bheader1) if(status .ne. 0)then write(errbuf,1006)status call AVSerror(errbuf) close(10) return endif c Convert each 80 character "card image" from EBCDIC to ASCII c adding carriage returns cbuf = ' ' do k=1,40 k1 = (k-1)*81 + 1 k2 = k1+80 do j=1,80 jp=bheader1((k-1)*80+j) if(jp.le.0)jp = 256+jp string(j:j) = ebcdic(jp:jp) enddo string(81:81) = cr cbuf(k1:k2) = string(1:81) enddo call avsmodify_parameter('Reel Header1',AVS_VALUE, cbuf, & 0,0) byte_count = 3200 if (auto_byte_order) then byte_count = CFunf_byte_count(swapflag) if(byte_count .ne. 3200)then C write(6,*)string write(errbuf,1008)byte_count call AVSerror(errbuf) close(10) return endif endif c Read SEGY reel header 2 if (auto_byte_order) then byte_count = CFunf_byte_count(swapflag) if(byte_count .ne. 400)then write(errbuf,1007)byte_count call AVSerror(errbuf) close(10) return endif endif byte_count = 400 status = CFunf_read(byte_count,byte_order,header2) if(status .ne. 0)then call AVSerror(errbuf) close(10) return endif 7003 format('auto_byte_order: ',L2,'byte_order is ',I6) if (auto_byte_order) byte_count = CFunf_byte_count(swapflag) c Need to restore the 2-byte integers in header 2 at this point c Don't make CFunf_read more complicated for the sake of the c small overhead of sorting this header c Need an example of a SEGY data file with real data to test this! if( (swapflag .eq. 2) .or. (swapflag .eq. 3)) then do j=1,hdr2b_size,2 tmp = header2b(j) header2b(j) = header2b(j+1) header2b(j+1) = tmp enddo endif C use the number of traces from header 2 if plausible if( header2b(2) .gt. 0)then ntraces = header2b(2) else ntraces = 4000 endif C if there is a byte count, use it to deduce the samples per trace nsamples = header2b(5) if (auto_byte_order) then byte_count = CFunf_byte_count(swapflag) if(header2b(5) .le. 0) header2b(5) = byte_count/4 - 60 nsamples = header2b(5) else if(nsamples .le. 0)nsamples = 1125 endif C write(6,7002)nsamples, ntraces 7002 format('samples ',I12,', traces ',I12) c Note that only the first 60 bytes of Header 2 are defined c and so only these are displayed 1000 format(A, I15, A1) 1001 format(A, I7, A1) write(hdr1, 1000) 'Job ID: ', header2a(1),cr write(hdr2, 1000) 'Line : ', header2a(2),cr write(hdr3, 1000) 'Reel : ', header2a(3),cr write(hdr4, 1001) 'Data traces/rec:', header2b(1),cr write(hdr5, 1001) 'Aux traces/rec :', header2b(2),cr write(hdr6, 1001) 'Interval (reel):', header2b(3),cr write(hdr7, 1001) 'Interval (orig):', header2b(4),cr write(hdr8, 1001) 'Smp/trace(reel):', header2b(5),cr write(hdr9, 1001) 'Smp/trace(orig):', header2b(6),cr write(hdr10,1001) 'Data Format :', header2b(7),cr write(hdr11,1001) 'CDP fold :', header2b(8),cr write(hdr12,1001) 'Trace sort code:', header2b(9),cr write(hdr13,1001) 'Vert. sum code :', header2b(10),cr write(hdr14,1001) 'Sweep freq strt:', header2b(11),cr write(hdr15,1001) 'Sweep freq end :', header2b(12),cr write(hdr16,1001) 'Sweep length :', header2b(13),cr write(hdr17,1001) 'Sweep type code:', header2b(14),cr write(hdr18,1001) 'Sweep trace no.:', header2b(15),cr write(hdr19,1001) 'Taper len strt :', header2b(16),cr write(hdr20,1001) 'Taper len end :', header2b(17),cr write(hdr21,1001) 'Taper type :', header2b(18),cr write(hdr22,1001) 'Correlated :', header2b(19),cr write(hdr23,1001) 'Bin gain recvrd:', header2b(20),cr write(hdr24,1001) 'Amp recovery :', header2b(21),cr write(hdr25,1001) 'Measuremnt unit:', header2b(22),cr write(hdr26,1001) 'Impulse polarty:', header2b(23),cr write(hdr27,1001) 'Vibratory code :', header2b(24),cr cbuf = hdr1 // hdr2 // hdr3 // hdr4 // hdr5 & // hdr6 // hdr7 // hdr8 // hdr9 // hdr10 & // hdr11 // hdr12 // hdr13 // hdr14 // hdr15 & // hdr16 // hdr17 // hdr18 // hdr19 // hdr20 & // hdr21 // hdr22 // hdr23 // hdr24 // hdr25 & // hdr26 // hdr27 call avsmodify_parameter('Reel Header2',AVS_VALUE, cbuf, & ' ',' ') c return c Errors 999 write(errbuf,1009)status call AVSerror(errbuf) return 1007 format('Error reading header2: byte count is ',I8) 1006 format('Error reading header1: status is stupid',I8) 1008 format('Error reading header1: byte count is ',I8) 1009 format('Error opening file',I8) 1088 format('Error reading header1 you stupid: byte count is ',I8) end c Read the data from the SEG Y file/tape c (the file is already open, and the CFunf_io routines know where it is) subroutine read_data(trace, points, & auto_byte_order, byte_order, byte_count, swapflag, & Start_trace, Start_sample, ntraces, nsamples,junk1) C IAC CODE CHANGE : include 'avs/avs.inc' INCLUDE '/usr/avs/include/avs.inc' real trace(nsamples,ntraces) real points(nsamples,junk1) logical auto_byte_order integer byte_order, byte_count, swapflag integer Start_trace, Start_sample, ntraces, nsamples, junk1 external CFunf_read integer CFunf_read real buf(4096) integer j,k,ds,d1,End_trace, End_sample integer status, b_c integer time real lat, lon common /char_stuff/ tbuf character*3240 tbuf character*128 errbuf integer header3(60) integer header3a(7) integer*2 header3b(4) integer header3c(8) integer*2 header3d(2) integer header3e(4) integer*2 header3f(46) integer header3g(1) integer*2 header3h(28) equivalence (header3,header3a) equivalence (header3(8),header3b) equivalence (header3(10),header3c) equivalence (header3(18),header3d) equivalence (header3(19),header3e) equivalence (header3(23),header3f) equivalence (header3(45),header3g) equivalence (header3(46),header3h) character*34 thdr1, thdr2, thdr3, thdr4, thdr5 character*34 thdr6, thdr7, thdr8, thdr9, thdr10 character*34 thdr11, thdr12, thdr13, thdr14, thdr15 character*34 thdr16, thdr17, thdr18, thdr19, thdr20 character*34 thdr21, thdr22, thdr23, thdr24, thdr25 character*34 thdr26, thdr27, thdr28, thdr29, thdr30 character*34 thdr31, thdr32, thdr33, thdr34, thdr35 character*34 thdr36, thdr37, thdr38, thdr39, thdr40 character*34 thdr41, thdr42, thdr43, thdr44, thdr45 character*34 thdr46, thdr47, thdr48, thdr49, thdr50 character*34 thdr51, thdr52, thdr53, thdr54, thdr55 character*34 thdr56, thdr57, thdr58, thdr59, thdr60 character*34 thdr61, thdr62, thdr63, thdr64, thdr65 character*34 thdr66, thdr67, thdr68, thdr69, thdr70 character*34 thdr71, thdr72, thdr73, thdr74 character cr cr = char(10) c Read traces End_trace = Start_trace + ntraces - 1 End_sample = Start_sample + nsamples - 1 open(unit=15 , file = 'don4.flt', status = 'old') do j=1,End_trace C write(6,*),'processing trace ',j c Always read the entire trace, or tape i/o may fail if (auto_byte_order) then byte_count = CFunf_byte_count(swapflag) if(byte_count .ne. 240)then write(errbuf,1001)byte_count call AVSerror(errbuf) close(10) return endif endif byte_count = 240 status = CFunf_read(byte_count,byte_order,header3) if(status .ne. 0)then call AVSerror('Error reading trace') return endif byte_count = 16384 status = CFunf_read(byte_count,byte_order,buf) if(status .eq. 0)then c Transfer the required data to the output field if ( j .ge. Start_trace) then j1 = j - Start_trace +1 read (15,*) time, lat, lon C In this version, try to keep values in range 0 to 1 C Note that y and z values are determined by the contents of don4.flt C which are in turn set by latmin, latmax, longmin, longmax in write_don4 xscale = 1./nsamples yscale = 1. zscale = 1. C had been set to lat * 1.e06 and lon * 1.e06 previously lat = lat * yscale lon = lon * zscale do d1 = 1, nsamples C ---------------------------------------------------------------------- c - alternative based on external file for coordinates c open (unit = 11, file = 'data', status = 'old') c write (11,30) j1, k, buf(k) c30 format(i4, i8, f20.6) c points(k,j1) = (-1*header3e(1)/360000.) c points(k,j1+ntraces) = (header3e(2)/360000.) c points(k,j1+2*ntraces) = (k - 1) c points(k,j1) = (k - 1) * 100 c points(k,j1+ntraces) = (-1*header3e(1)/360000.*10000 $00) c points(k,j1+2*ntraces) = (header3e(2)/360000.*100000 $0) C ---------------------------------------------------------------------- trace(d1,j1) = buf(d1 + Start_sample - 1) points(d1,j1+2*ntraces) = lat points(d1,j1+ntraces) = lon points(d1,j1) = (d1 - 1) * xscale enddo endif else call AVSerror('Error reading trace') End_trace = j endif enddo close (unit = 15) 1010 format(A, I7, A1) 1011 format(A, I7, A1) 1012 format(A, F10.6, A1) 1013 format(A, I16, A1) write(thdr1,1010) 'Trace Sequence No Line : ', header3a(1),cr write(thdr2,1010) 'Trace Sequence No Reel : ', header3a(2),cr write(thdr3,1010) 'Original Field No : ', header3a(3),cr write(thdr4,1011) 'Trace Number Original : ', header3a(4),cr write(thdr5,1011) 'Energy Source Point No : ', header3a(5),cr write(thdr6,1011) 'CDP Ensemble Number : ', header3a(6),cr write(thdr7,1011) 'Trace No. CDP Ensemble : ', header3a(7),cr write(thdr8,1011) 'Trace Identification # : ', header3b(1),cr write(thdr9,1011) 'No. Vertically Summed T: ', header3b(2),cr write(thdr10,1011) 'No. Horizontally Stack : ', header3b(3),cr write(thdr11,1011) 'Data Use : ', header3b(4),cr write(thdr12,1011) 'Dist. Source Pt to Rec : ', header3c(1),cr write(thdr13,1011) 'Receiver Group Elev : ', header3c(2),cr write(thdr14,1011) 'Surfave Elevation @ Sor: ', header3c(3),cr write(thdr15,1011) 'Source Depth Below Sur : ', header3c(4),cr write(thdr16,1011) 'Datum Elevation @ Rec : ', header3c(5),cr write(thdr17,1011) 'Datum Elevation @ Sor : ', header3c(6),cr write(thdr18,1011) 'Water Depth @ Source : ', header3c(7),cr write(thdr19,1011) 'Water Depth @ Group : ', header3c(8),cr write(thdr20,1011) 'Scaler Applied to Elev : ', header3d(1),cr write(thdr21,1011) 'Scaler Applied to Coord: ', header3d(2),cr write(thdr22,1012) 'X - long : ', header3e(1)/360000.,cr write(thdr23,1012) 'Y - lat : ', header3e(2)/360000.,cr write(thdr24,1011) 'Group Coord X : ', header3e(3),cr write(thdr25,1011) 'Group Coord Y : ', header3e(4),cr write(thdr26,1011) 'Coord. Units : ', header3f(1),cr write(thdr27,1011) 'Weathering Velocity : ', header3f(2),cr write(thdr28,1011) 'Subweathering Velocity : ', header3f(3),cr write(thdr29,1011) 'Uphole Time @ Source : ', header3f(4),cr write(thdr30,1011) 'Uphole Time @ Group : ', header3f(5),cr write(thdr31,1011) 'Source Static Corr : ', header3f(6),cr write(thdr32,1011) 'Group Static Corr : ', header3f(7),cr write(thdr33,1011) 'Total Static Applied : ', header3f(8),cr write(thdr34,1011) 'Lag Time A : ', header3f(9),cr write(thdr35,1011) 'Lag Time B : ', header3f(10),cr write(thdr36,1011) 'Delay Recording Time : ', header3f(11),cr write(thdr37,1011) 'Mute Time Start : ', header3f(12),cr write(thdr38,1011) 'Mute Time End : ', header3f(13),cr write(thdr39,1011) 'Number of Samples Trace: ', header3f(14),cr write(thdr40,1011) 'Sample Interval in Ms : ', header3f(15),cr write(thdr41,1011) 'Gain Type of Field Inst: ', header3f(16),cr write(thdr42,1011) 'Inst. Gain Constant : ', header3f(17),cr write(thdr43,1011) 'Inst. Early or Init gn : ', header3f(18),cr write(thdr44,1011) 'Correlated 1-no 2-yes : ', header3f(19),cr write(thdr45,1011) 'Sweep Freq at Start : ', header3f(20),cr write(thdr46,1011) 'Sweep Freq at End : ', header3f(21),cr write(thdr47,1011) 'Sweep Length in ms : ', header3f(22),cr write(thdr48,1011) 'Sweep Type : ', header3f(23),cr write(thdr49,1011) 'Sweep Trace Taper st : ', header3f(24),cr write(thdr50,1011) 'Sweep Trace Taper en : ', header3f(25),cr write(thdr51,1011) 'Taper Type : ', header3f(26),cr write(thdr52,1011) 'Alias Filter Freq : ', header3f(27),cr write(thdr53,1011) 'Alias Filter Slope : ', header3f(28),cr write(thdr54,1011) 'Notch Filter Freq : ', header3f(29),cr write(thdr55,1011) 'Notch Filter Slope : ', header3f(30),cr write(thdr56,1011) 'Low Cut Freq : ', header3f(31),cr write(thdr57,1011) 'High Cut Freq : ', header3f(32),cr write(thdr58,1011) 'Low Cut Slope : ', header3f(33),cr write(thdr59,1011) 'High Cut Slope : ', header3f(34),cr write(thdr60,1011) 'Year : ', header3f(35),cr write(thdr61,1011) 'Day : ', header3f(36),cr write(thdr62,1011) 'Hour : ', header3f(37),cr write(thdr63,1011) 'Minute : ', header3f(38),cr write(thdr64,1011) 'Second : ', header3f(39),cr write(thdr65,1011) 'Time Basis Code 2-gmt : ', header3f(40),cr write(thdr66,1011) 'Trace Weighting Factor : ', header3f(41),cr write(thdr67,1011) 'Geophone Group No of rl: ', header3f(42),cr write(thdr68,1011) 'Geophone Group No of tr: ', header3f(43),cr write(thdr69,1011) 'Geophone Group No of lt: ', header3f(44),cr write(thdr70,1011) 'Gap Size : ', header3f(45),cr write(thdr71,1011) 'Overtravel Taper @ line: ', header3f(46),cr write(thdr72,1013) 'Pointer bottom: ', header3g(1),cr write(thdr73,1011) 'Bottom Hardness : ', header3h(1),cr write(thdr74,1011) 'Water Column Delay : ', header3h(2),cr tbuf = thdr1 // thdr2 // thdr3 // thdr4 // thdr5 & // thdr6 // thdr7 // thdr8 // thdr9 // thdr10 & // thdr11 // thdr12 // thdr13 // thdr14 // thdr15 & // thdr16 // thdr17 // thdr18 // thdr19 // thdr20 & // thdr21 // thdr22 // thdr23 // thdr24 // thdr25 & // thdr26 // thdr27 // thdr28 // thdr29 // thdr30 & // thdr31 // thdr32 // thdr33 // thdr34 // thdr35 & // thdr36 // thdr37 // thdr38 // thdr39 // thdr40 & // thdr41 // thdr42 // thdr43 // thdr44 // thdr45 & // thdr46 // thdr47 // thdr48 // thdr49 // thdr50 & // thdr51 // thdr52 // thdr53 // thdr54 // thdr55 & // thdr56 // thdr57 // thdr58 // thdr59 // thdr60 & // thdr61 // thdr62 // thdr63 // thdr64 // thdr65 & // thdr66 // thdr67 // thdr68 // thdr69 // thdr70 & // thdr71 // thdr72 // thdr73 // thdr74 call avsmodify_parameter('Trace Header',AVS_VALUE, tbuf, & ' ',' ') return 1001 format('error reading trace ',I6) end