CTITLESAFXINC -- CREATE OUTPUT HEADERS 00010009 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D CORRIGAN 00020009 CA DESIGNER D CORRIGAN 00030009 CA LANGUAGE FORTRAN 77 00040009 CA SYSTEM IBM / CRAY 00050010 CA WRITTEN AUGUST 1991 00060009 C REVISED 02-10-92 JJC RENAMED SAFXIN3 TO SAFXINC. 00070009 CA 00080009 CA CALL SAFXINC( LHDR,H1,H2,OH,IMODE,ISGL,IFN1,JTRC ) 00090009 CA 00100009 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00110009 CA 00120009 CA INPUT LHDR I4 HEADER LENGTH 00130009 CA INPUT H1 R4 FIRST INPUT HEADER 00140009 CA INPUT H2 R4 SECOND INPUT HEADER 00150009 CA INPUT IMODE I4 CROSS CORRELATION 00160009 CA INPUT ISGL I4 AUXILIARY ARRAYS 00170009 CA INPUT IFN1 I4 AUXILIARY ARRAYS 00180009 CA INPUT JTRC I4 AUXILIARY ARRAYS 00190009 CA OUTPUT OH R4 LENGTH OF OP 00200009 CA 00210009 CA CREATE OUTPUT HEADERS FOR INTERPOLATED TRACES 00220009 CA USING SPATIAL PREDICTION METHOD 00230009 CA 00240009 SUBROUTINE SAFXINC( LHDR,H1,H2,OH,IMODE,ISGL,IFN1,JTRC ) 00250008 C 00260011 IMPLICIT INTEGER (A-Z) 00270011 C 00280000 REAL H1(1),H2(1) 00290000 REAL OH(1) 00300000 C 00310000 CHARACTER*8 A1(2) 00320000 CHARACTER*8 A2(2) 00330000 CHARACTER*8 A3(1) 00340000 C 00350000 DATA N1 / 2 / 00360000 DATA N2 / 2 / 00370000 DATA N3 / 1 / 00380000 C 00390000 DATA A1 / 'THXDST ','THCDPN ' / 00400000 DATA A2 / 'THXDST ','THCDPN ' / 00410000 DATA A3 / 'THXDST ' / 00420000 C 00430000 C MOVE H1 TO OH 00440000 C 00450000 CALL SCOPY( LHDR,H1,1,OH,1 ) 00460000 C 00470007 C GET TICD-S AND FLV-S 00480007 C 00490007 CALL USRTHV( H1,'THTICD ',ID1 ) 00500007 CALL USRTHV( H2,'THTICD ',ID2 ) 00510007 CALL USRTHV( H1,'THFLV ',IFL1 ) 00520007 CALL USRTHV( H2,'THFLV ',IFL2 ) 00530007 IF( ID1.NE.1 .AND. ID2.NE.1 ) GO TO 100 00540007 C 00550007 C SET TICD AND FLV 00560007 C 00570007 IF( ID1.EQ.1 .AND. ID2.EQ.1 ) THEN 00580007 IFLV = (IFL1+IFL2)/2 00590007 ELSEIF( ID1.EQ.1 ) THEN 00600007 IFLV = IFL1 00610007 ELSEIF( ID2.EQ.1 ) THEN 00620007 IFLV = IFL2 00630007 ENDIF 00640007 CALL USSTHV( OH,'THTICD ',1 ) 00650007 CALL USSTHV( OH,'THFLV ',IFLV ) 00660007 C 00670000 100 IF( ISGL.GT.0 ) THEN 00680007 C 00690000 C POST-STACK PROCESSING 00700000 C 00710000 ICDP = IFN1 + JTRC - 1 00720000 CALL USSTHV( OH,'THCDPN ',ICDP ) 00730000 RETURN 00740000 ENDIF 00750000 C 00760000 IF( IMODE.EQ.2 ) THEN 00770000 C 00780000 C SHOTPOINT MODE 00790000 C 00800000 CALL USSTHV( OH,'THORTN ',JTRC ) 00810000 NI = N2 00820000 DO 200 I = 1,NI 00830000 CALL USRTHV( H1,A2(I),IA1 ) 00840000 CALL USRTHV( H2,A2(I),IA2 ) 00850000 IA = (IA1+IA2)/2 00860000 CALL USSTHV( OH,A2(I),IA ) 00870005 200 CONTINUE 00880000 C 00890000 ELSE IF( IMODE.EQ.3 ) THEN 00900003 C 00910000 C DEPTH POINT MODE 00920000 C 00930000 CALL USSTHV( OH,'THCDPT ',JTRC ) 00940004 NI = N3 00950000 DO 300 I = 1,NI 00960000 CALL USRTHV( H1,A3(I),IA1 ) 00970000 CALL USRTHV( H2,A3(I),IA2 ) 00980000 IA = (IA1+IA2)/2 00990000 CALL USSTHV( OH,A3(I),IA ) 01000005 300 CONTINUE 01010000 C 01020000 ELSE 01030000 C 01040000 C FILE MODE 01050005 C 01060000 CALL USSTHV( OH,'THCDPN ',JTRC ) 01070000 NI = N1 01080000 DO 500 I = 1,NI 01090000 CALL USRTHV( H1,A1(I),IA1 ) 01100000 CALL USRTHV( H2,A1(I),IA2 ) 01110000 IA = (IA1+IA2)/2 01120000 CALL USSTHV( OH,A1(I),IA ) 01130005 500 CONTINUE 01140000 C 01150000 ENDIF 01160000 C 01170000 C 01180000 RETURN 01190000 END 01200000