CTITLESAEGEN0 - EVENT GENERATION C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C C DESIGNER D CORRIGAN C AUTHOR D CORRIGAN C LANGUAGE VS FORTRAN C SYSTEM IBM / CRAY C DATE 06-26-89 C REVISED 04-16-90 JJC - MODIFIED TO MEET EDP STARDARDS. C REVISED 04-25-90 JJC - ADDED TO CHECK PROCESSING RANGE C AND DEAD TRACES. C REVISED 07-05-90 CLJ - CORRECTED SPELLING OF CDPN C REVISED 07-09-90 CLJ - ADDED FILE MODE OPTION C REVISED 07-17-90 CLJ - ALLOW A MAXIMUM OF 50 EVENTS C WHILE FIXING READ OF EVENT C PARMS (NOT NECESSARILY A C MULTIPLE OF 96 WORDS) C REVISED 07-18-90 CLJ - FOR CFT77 COMPATIBILITY ON CRAY C REVISED 07-19-90 CLJ - REMOVE COMMON P AND ADD KPNA,KPRNO, C AND KPPRNT TO ARGUMENT LIST C C C CALL SAEGEN0(LKPNA,LKPRNO,KPPRNT,OH,ICC,AUTO3,IABORT,RA) C CALL SAEGEN1(OH,OTR,VEL,PASS,IABORT,RA,SA) C CALL SAEGEN2(OH,OTR,VEL,PASS,IABORT,RA,SA) C CALL SAEGEN3(OH,OTR,VEL,PASS,IABORT,RA,SA) C C C PURPOSE: REPLACE SEISMIC DATA WITH SYNTHETIC C EVENTS WHICH ARE LINEAR OR HYPERBOLIC C C ===================================================================== C C LOCAL OR INTERNAL ARRAYS. 00410000 C 00420000 C IPM = INDEX TO THE SEISMIC PARAMETER ARRAY I4 C IXT = INDEX TO THE ARRAY OF ZERO OFFSET TIME I4 C IXV = INDEX TO THE ARRAY OF VELOCITY I4 C IXA = INDEX TO THE ARRAY OF AMPLITUDE I4 C IXF = INDEX TO THE ARRAY OF DOMINANT FREQUENCY I4 C IXY = INDEX TO THE ARRAY OF EVENT TYPE I4 C NE = NUMBER OF EVENTS I4 C SPE = ENDING SHOT/DEPTH POINT NUMBER I4 00430000 C SPT = STARTING SHOT/DEPTH POINT DEPTH NUMBER I4 00440000 C C ===================================================================== 00860002 C FORMAT OF OUTPUT PARAMETER RECORDS 00870002 C 00880002 C C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 00890002 C 00900002 C C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00910002 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 00920002 C | EGEN | | INVOC. | PTS | SPT | SPE | # OF |N|P| NOT | NO. | 00930002 C |_______|_NUMBER_|_______|_______|_______|_PARMS_|_|M|_USED|_EVENTS| 00940002 C 00950002 C C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 00960002 C |_______|________|_______|_______|_______|_______|________|________| 00970002 C | T0 | VM | AM | F0 | TY | T0 | VM | AM | 00980002 C |_(E1)__|_(E1)___|_(E1)__|_(E1)__|_(E1)__|_(E2)__|__(E2)__|__(E2)__| 00990002 C 01000002 C C WORD 17 WORD 18 WORD 19 WORD 99 01010002 C |_______|________|_______| ............................. |________| 01020002 C | F0 | TY | | ............................. | | 01030002 C |_(E2)__|_(E2)___|_______| ............................. |________| 01040002 C . . . 01050002 C WORD 100WORD 101WORD 102 WORD 103WORD 104 01060002 C |_______|________|_______|_______|_______| (CONTINUE TO NEXT RECORDS 01070002 C | T0 | VM | AM | F0 | TY | IF NECESSARY) 01080002 C |_(EN)__|_(EN)___|_(EN)__|_(EN)__|_(EN)__| 01090002 C 01100002 C ===================================================================== 01850000 C LAYOUT OF BLANK COMMON 01860000 C 01870000 C IXT --> ________________________________ 01880000 C | NE | 01890000 C IXV --> |______________________________| 01930000 C | NE | 01940000 C IXA --> |______________________________| 01980000 C | NE | 01990000 C IXF --> |______________________________| 02040000 C | NE | 02050000 C IXY --> |______________________________| 02070000 C | NE | 02080000 C |______________________________| 02100000 C 02140000 C ===================================================================== C SUBROUTINE SAEGEN0(LKPNA,LKPRNO,KPPRNT,OH,ICC,AUTO3,IABORT,RA) C C IMPLICIT INTEGER (A-Z) C C DIMENSION OH(1), OTR(1), RA(1), SA(1),VEL(1) EXTERNAL FOSCDK C C COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN COMMON /USER/ SLOCAL(50), ULOCAL(100) C INTEGER YES INTEGER NO INTEGER YES3 INTEGER NO3 INTEGER DATTR (96) 01370002 INTEGER DENTRY (104) 01380002 C REAL XATTR(96) C REAL OH REAL RA REAL OTR REAL SA REAL VEL REAL SR REAL SCF REAL DTX REAL SRS REAL ZERO REAL PI REAL ASI REAL XD REAL TS REAL TX REAL FT REAL TC REAL T1 REAL T2 REAL DT REAL ARG C C 01390002 EQUIVALENCE (DCTYP , DENTRY (03)) 01400002 EQUIVALENCE (SPT , DENTRY (04)) 01410002 EQUIVALENCE (SPE , DENTRY (05)) 01420002 EQUIVALENCE (NOPAR , DENTRY (06)) 01430002 EQUIVALENCE (PMODE , DENTRY (07)) 01440002 EQUIVALENCE (NE , DENTRY (08)) 01450002 EQUIVALENCE (DATTR(1), DENTRY (09)) 01460002 EQUIVALENCE (DATTR(1), XATTR (01)) 01460002 C 01470002 C CJJ EQUIVALENCE ( ,ULOCAL( 1)) EQUIVALENCE (SR ,ULOCAL( 2)) EQUIVALENCE (IPR ,ULOCAL( 3)) EQUIVALENCE (MODE ,ULOCAL( 4)) EQUIVALENCE (NTRC ,ULOCAL( 5)) EQUIVALENCE (ITRC ,ULOCAL( 6)) EQUIVALENCE (JTRC ,ULOCAL( 7)) CJJ EQUIVALENCE ( ,ULOCAL( 9)) EQUIVALENCE (IXT ,ULOCAL(10)) EQUIVALENCE (IXV ,ULOCAL(11)) EQUIVALENCE (IXA ,ULOCAL(12)) EQUIVALENCE (IXF ,ULOCAL(13)) EQUIVALENCE (IXY ,ULOCAL(14)) EQUIVALENCE (SCF ,ULOCAL(15)) EQUIVALENCE (DTX ,ULOCAL(16)) EQUIVALENCE (SRS ,ULOCAL(17)) C C DATA ZERO/ 0. / DATA PI/3.14159265/ DATA YES /0/ DATA NO /1/ DATA YES3 /2/ DATA NO3 /3/ C C======================================================================= C C C INITIALIZE VARIABLES C KPNA = LKPNA KPRNO = LKPRNO IPR = KPPRNT C IABORT = NO ASI = SI SR = ASI/1000. AUTO3 = YES SRS = SR/1000. C C READ FIRST PARAMETER RECORD C LA = 1 50 CALL FORP (KPNA, KPRNO, LA, 104, DENTRY, * 60) IF (S1CPCH(DCTYP, 1, 'PTS ', 1, 4) .NE. 0) GO TO 50 C C RESERVED COMMON BLANK C IPM = 1 IXT = IPM + 50 * NE IXV = IXT + NE IXA = IXV + NE IXF = IXA + NE IXY = IXF + NE ICC = IXY + NE 60 CONTINUE C C RERETRIEVE PARAMETER RECORDS C K = 1 LA = 1 70 CALL FORP (KPNA, KPRNO, LA, 104, DENTRY, * 80) IF (S1CPCH(DCTYP, 1, 'PTS ', 1, 4) .NE. 0) GO TO 70 CALL ARMVE (XATTR(1), RA(K), NOPAR) K = K + NOPAR GO TO 70 C 80 CONTINUE C JJ = 1 DO 90 IE = 1, NE RA(IXT+IE-1) = RA(JJ ) RA(IXV+IE-1) = RA(JJ+1) RA(IXA+IE-1) = RA(JJ+2) RA(IXF+IE-1) = RA(JJ+3) RA(IXY+IE-1) = RA(JJ+4) JJ = JJ + 5 90 CONTINUE C MODE = 0 IF (S1CPCH(PMODE, 2, 'D', 1, 1) .EQ. 0) MODE = 1 IF (S1CPCH(PMODE, 2, 'F', 1, 1) .EQ. 0) MODE = 2 C C PRINT PARAMETERS C WRITE(IPR,8020) SPT, SPE, NE 8020 FORMAT('0 INPUT PARAMETERS - ',/, * ' FIRST INPUT RECORD = ',I5,/, * ' LAST INPUT RECORD = ',I5,/, * ' NUMBER OF EVENTS = ',I5 ) C RETURN C C C SAEGEN1 ENTRY STARTS HERE C******************************************************************* C ENTRY SAEGEN1(OH,OTR,VEL,PASS,IABORT,RA,SA) C C******************************************************************* C IABORT = NO PASS = YES C C******************************************************************* C ENTRY SAEGEN2(OH,OTR,VEL,PASS,IABORT,RA,SA) C C******************************************************************* C CJJ C SHOT POINT MODE IF (MODE .EQ. 0) THEN IF (SSP.LT.SPT .OR. SSP.GT.SPE ) RETURN C C DEPTH POINT MODE ELSE IF (MODE .EQ. 1) THEN IF (CDPN.LT.SPT .OR. CDPN.GT.SPE) RETURN C C FILE MODE ELSE IF (MODE .EQ. 2) THEN IF (FN.LT.SPT .OR. FN.GT.SPE) RETURN ELSE ENDIF C IF (TICD .NE. 1) RETURN C XD = XDST CALL SCOPY( NS,ZERO,0,OTR,1 ) C C FOR EACH EVENT: C C 1. COMPUTE TIME FOR THIS OFFSET C 2. ADD EVENT INTO TRACE C DO 1140 IE = 1,NE TS = RA(IXT+IE-1)/1000. TX = XD/RA(IXV+IE-1) FT = RA(IXF+IE-1) DTX = 1.1/FT SCF = PI*PI*FT*FT C C IF( RA(IXY+IE-1).EQ.1.0 ) THEN TC = SQRT( TS*TS + TX*TX ) ELSE TC = TS + TX ENDIF C C T1 = TC - DTX T2 = TC + DTX I1 = T1/SRS + 1 I2 = T2/SRS + 1 I1 = MAX0( 1,I1 ) I2 = MIN0( NS,I2 ) C C DO 1120 IT = I1,I2 DT = TC - SRS*(IT-1) ARG = SCF*DT*DT OTR(IT) = OTR(IT) + RA(IXA+IE-1)*(1.-2.*ARG)*EXP(-ARG) 1120 CONTINUE C C 1140 CONTINUE C C RETURN C C******************************************************************* C ENTRY SAEGEN3(OH,OTR,VEL,PASS,IABORT,RA,SA) C C******************************************************************* C C NOTHING TO DO C PASS = NO RETURN C END