CTITLESAQTRP -- DRAW TRACES ON COLOR PLOTS C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C CA AUTHOR P. COOPER CA DESIGNER P. COOPER CA LANGUAGE VS-FORTRAN CA WRITTEN 02-20-81 / 07-20-81 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON. C REVISED 05-31-84 BY RDK. ADD 'THL' TO ARGUMENT LIST. C REVISED 07-18-84 BY CMP. CHANGE APPLICON CALLS TO UNIRAS. C REVISED 07-12-85 BY RKG. ADD TRACE OFFSET OPTION. C REVISED 03-09-87 BY JMP. ADD DAINC ARGUMENT. C REVISED 1-29-91 CLJ - ADDED TRACE OVERLAY DECIMATION OPTION CA CA CA CALL SAQTRP (KPWRKD, DA, NR, IDIR, RH, R, G, SQ, CA XP, YP, XX, YY, ILTF, XPJ0, YP0, IPL, CA LPL, LAGC, L, TSP, RGSCL, XSCL, YSCL, XBL, CA OVERLY, IVAC, TRW, ISDPLN, ISDP, IEDP, THL, VLCOP, CA DAINC, ITRDEC ) CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN KPWRKD I4 COMMON P WORK DISK CA IN DA I4 DISK ADDRESS CA IN NR I4 NUMBER OF RECORDS TO PLOT CA IN IDIR I4 DIRECTION FLAG CA IN RH R4 WORK SPACE FOR INPUT TRACE HEADER CA IN R I4 WORK SPACE FOR INPUT TRACE CA IN G R4 WORK SPACE FOR TRACES CA IN SQ R4 WORK AREA FOR SQUARES CA IN XP R4 X WORK ARRAY CA IN YP R4 Y WORK ARRAY CA IN XX R4 X WORK ARRAY CA IN YY R4 Y WORK ARRAY CA IN ILTF I4 LIVE TRACE FLAG ARRAY CA IN XPJ0 R4 X PLOT ZERO CA IN YP0 R4 Y DIRECTION PLOT ZERO CA IN IPL I4 STARTING SAMPLE OF PLOT CA IN LPL I4 LENGTH OF PLOT CA IN LAGC R4 LENGTH OF AGC CA IN L R4 LENGTH OF PLOT CA IN TSP R4 TRACE SPACING CA IN RGSCL R4 SCALAR FOR INPUT CA IN XSCL R4 X PLOT SCALE CA IN YSCL R4 Y PLOT SCALE CA IN XBL R4 VARIABLE AREA FILL FLAG CA IN OVERLY I4 OVERLY FLAG CA IN IVAC I4 VARIABLE AREA FILL COLOR CA IN TRW R4 TRACE WIDTH CA IN ISDPLN R4 STARTING DEPTH POINT OF THE LINE CA IN ISDP R4 STARTING DEPTH POINT OF THIS PANEL CA IN IEDP R4 ENDING DEPTH POINT OF THIS PANEL CA IN THL I4 TRACE HEADER LENGTH IN WORDS CA IN VLCOP R4 TRACE PLOT OFFSET BIAS. CA IN DAINC I4 TRACE INCREMENT ON DATASET. CA IN ITRDEC I4 TRACE OVERLAY DECIMATION FACTOR CA CA CA THIS PROGRAM PLOTS SEISMIC TRACES FOR SDQULR. CA CAEND C ARGUMENT TYPE LENGTH DESCRIPTION C G R4 PL.LNT. WORK ARRAY C R R4 PL.LNT. WORK ARRAY C RH R4 96 HEADER WORK ARRAY C SQ R4 PL.LNT. WORK ARRAY C XP R4 PL.LNT WORK ARRAY C XX R4 PL.LNT. WORK ARRAY C YP R4 PL.LNT. WORK ARRAY C YY R4 PL.LNT. WORK ARRAY C ILTF I4 NO.DPS. LIVE TRACE FLAG C C ARGUMENT TYPE DESCRIPTION C K I4 DO LOOP COUNTER C L I4 LENGTH OF INPUT BUFFER C DA I4 DISK ADDRESS OF INPUT C GL R4 USED FOR AGC CALCULATION C G1 R4 USED FOR AGC CALCULATION C IR I4 DO LOOP COUNTER FOR NUMBER OF RECORDS C KK I4 VARIABLE AREA COUNTER C KX I4 SAMPLE TO PLOT COUNTER C K1 I4 AGC COUNTER C K2 I4 AGC COUNTER C LM I4 AGC INDEX FOR LAST APPLICATION C NR I4 NUMBER OF TOTAL RECORDS TO PLOT C RK R4 TEMPORARY VARIABLE C XK R4 X-COORDINATE C YK R4 Y-COORDINATE C AMX R4 AMPLITUDE MAXIMUM SET TO 16383. C FKM R4 FLOATING POINT K MINUS ONE C IDA I4 DISK ADDRESS TO USE TO RETRIEVE ACTUAL INPUT TO PLOT C IPL I4 INITIAL PLOT SAMPLE C IRR I4 INDEX TAKING DIRECTION INTO ACCOUNT C LPL I4 LENGTH OF PLOT C RGK R4 TEMPORARY VARIABLE C SSQ R4 SQUARED VARIABLE C TMX R4 TRACE MAXIMUM C TRW R4 WIGGLE TRACE WIDTH C TSP R4 TRACE SPACING C XBL R4 VARIABLE AREA TO FILL C XDK R4 X DIFFERENCE C XKX R4 X OFFSET TO PLOT C YP0 R4 Y PLOT ZERO C FAGC R4 AGC VARIABLE C ICDP I4 CDP NUMBER OF TRACE THAT IS BEING PLOTTED C IDIR I4 DIRECTION FLAG FOR 'LR' OR 'RL' C IEDP I4 ENDING DEPTH POINT OF THE LINE C IRGK I4 SCALED R VALUE C ISDP I4 STARTING DEPTH POINT NUMBER OF THE LINE C ISGN I4 SIGN C IVAC I4 VARIABLE AREA COLOR C LAGC I4 LENGTH OF AGC C RGKA R4 TEMPORARY VARIBLE C SQDD R8 | C SQKD R8 |-- VARIABLES USED TO CALCULATE AGC C SSQD R8 | C XKM1 R4 X VARIABLE C XPJ0 R4 X-COORDINATE TO PLOT C XSCL R4 X SCALAR C XXKK R4 X VARIABLE C YKM1 R4 Y VARIABLE C YPJ0 R4 Y-COORDINATE TO PLOT C YSCL R4 Y SCALAR C YYKK R4 Y VARIABLE C IGCSW I4 SWITCH FOR AGC C LAGCH I4 | C LAGCM I4 | C RGSCL R4 |-- VARIABLES USED TO CALCULATE AGC C RRSCL R4 | C SQKPD R4 | C ISDPLN I4 CLIPPING MINIMUM VALUE C KPWRKD I4 WORK FILE ADDRESS C LAGCHM I4 VARIABLE USED TO CALCULATE AGC C OVERLY I4 OVERLAY FLAG C C SUBROUTINE SAQTRP (KPWRKD, DA, NR, IDIR, RH, * R, G, SQ, XP, YP, * XX, YY, ILTF, XPJ0, YP0, * IPL, LPL, LAGC, L, TSP, * RGSCL, XSCL, YSCL, XBL, OVERLY, * IVAC, TRW, ISDPLN, ISDP, IEDP, * THL, VLCOP,DAINC, ITRDEC ) C C DECLARE ARRAYS IN ARGUMENT LIST C INTEGER RH(1) INTEGER ILTF(1) REAL SQ(1) REAL G(1) REAL XP(1) REAL YP(1) REAL XX(1) REAL YY(1) REAL R(1) REAL VLCOP C C DECLARE OTHER ARGUMENT VARIABLES C INTEGER OVERLY INTEGER DA INTEGER DAINC INTEGER THL INTEGER BEGDA INTEGER ENDDA C C SET UP REAL VARIABLES C REAL*8 SSQD REAL*8 SQKD REAL*8 SQDD REAL*8 SQKPD C REAL AMX /16383.0/ C C CALCULATE VARIABLES FOR AGC C IGCSW = LAGC LAGC = IABS(LAGC) IF (IGCSW .LE. 0) GO TO 10 LAGCH = LAGC / 2 + 1 LAGC = 2 * LAGCH - 1 LAGCHM = LAGCH - 1 LAGCM = LAGC - 1 LM = L - LAGCHM FAGC = LAGC 10 CONTINUE C C SET UP LOOP INDICES C LAST = DA + (NR - 1) * DAINC IF (IDIR .LT. 0) THEN BEGDA = LAST ENDDA = DA INCDA = -DAINC ELSE BEGDA = DA ENDDA = LAST INCDA = DAINC ENDIF C KNTTR = 0 C C LOOP TO READ IN TRACES AND PLOT C DO 200 IDAA = BEGDA, ENDDA, INCDA IDA = IDAA C C INCREMENT TRACE COUNTER KNTTR = KNTTR + 1 C C SET ARRAY FOR INPUT TO ZERO C CALL ARSET (RH(1), THL+L, 0) C C READ IN TRACE AND CHECK IF IN RANGE TO PLOT C CALL FORDSD (KPWRKD, IDA, RH) C 20 CALL USRTHV (RH, 'THCDPN ', ICDP) C IF (ISDP .GT. ICDP .OR. ICDP .GT. IEDP) GO TO 200 C C CHECK IF LIVE TRACE C IF (ILTF(ICDP-ISDPLN+1) .EQ. 0) GO TO 120 C C CHECK IF NEED TO APPLY AGC C IF (IGCSW) 30 , 120 , 50 C C APPLY ABSOLUTE SCALAR C 30 CONTINUE C DO 40 K = 1, L R(K) = AMX * COS(R(K)) 40 CONTINUE C GO TO 120 C C COMPUTE AGC AND APPLY FOR LENGTH OF PLOT C 50 CONTINUE C DO 60 K = 1, L IRGK = RGSCL * R(K) RGK = IRGK RK = RGK / RGSCL SQ(K) = RK * RK 60 CONTINUE C SSQD = 0.0 C DO 70 K = 1, LAGCM SQKD = SQ(K) SSQD = SSQD + SQKD 70 CONTINUE C SQKPD = 0.0 K1 = 0 C DO 80 K = LAGCH, LM K1 = K1 + 1 K2 = K1 + LAGCM SQKD = SQ(K2) SQDD = SQKD - SQKPD SSQD = SSQD + SQDD SQKPD = SQ(K1) SSQ = SSQD IF (SSQ.LE.0.0) SSQ = 1.0 G(K) = SQRT(FAGC / SSQ) 80 CONTINUE C G1 = G(LAGCH) GL = G(LM) C DO 90 K = 1, LAGCHM K2 = LM + K G(K) = G1 G(K2) = GL 90 CONTINUE C TMX = 0.0 C DO 100 K = 1, L RGK = R(K) * G(K) R(K) = RGK RGKA = ABS(RGK) IF (RGKA .GT. TMX) TMX = RGKA 100 CONTINUE C IF (TMX .EQ. 0.0) TMX = 1.0 RRSCL = AMX / TMX C DO 110 K = 1, L R(K) = RRSCL * R(K) 110 CONTINUE C 120 CONTINUE C C ******************** CREATE COLOR PLOT ********************** C C CALCULATE BEGINNING X AND Y COORDINATES C XPJ0 = XPJ0 + TSP YPJ0 = YP0 KK = 0 ISGN = -1 KX = IPL - 1 C C CHECK FOR TRACE OVERLAY DECIMATION IF (ITRDEC .GT. 1) THEN IF (MOD(KNTTR, ITRDEC) .NE. 1) GO TO 200 END IF C C DO 180 K = 1, LPL FKM = K - 1 KX = KX + 1 RK = R(KX) - VLCOP C C REVERSE POLARITY OF TRACE PLOT IF ASKED C IF (OVERLY .EQ. 2) RK = -RK C C CALCULATE X AND Y FOR THIS SAMPLE FOR WIGGLE TRACE C XKX = XSCL * RK XK = XPJ0 + XKX YK = YPJ0 - FKM * YSCL XP(K) = XK YP(K) = YK C C CHECK FOR VARIABLE AREA C IF (XKX .LE. XBL) GO TO 130 IF (ISGN .GT. 0) GO TO 170 ISGN = 1 GO TO 140 C 130 IF (ISGN .LT. 0) GO TO 180 ISGN = -1 C C CALCULATE X'S AND Y'S FOR VARIABLE AREA C 140 KK = KK + 1 IF (K .GT. 1) GO TO 150 XX(KK) = XPJ0 + XBL YY(KK) = YPJ0 GO TO 170 C 150 XXKK = XPJ0 + XBL XKM1 = XP(K-1) YKM1 = YP(K-1) XDK = XK - XKM1 YYKK = YKM1 IF (XDK .NE. 0.0) YYKK = YKM1 + (XXKK-XKM1) * (YK-YKM1) / XDK XX(KK) = XXKK YY(KK) = YYKK IF (KK .EQ. 1) GO TO 170 C 160 KK = KK + 1 XX(KK) = XX(1) YY(KK) = YY(1) C C DRAW VARIABLE AREA WITH POLYGON ROUTINE C CALL GSURF (XX, YY, KK, IVAC, 0) KK = 0 GO TO 180 C 170 KK = KK + 1 XX(KK) = XK YY(KK) = YK IF (K .LT. LPL) GO TO 180 KK = KK + 1 XX(KK) = XPJ0 + XBL YY(KK) = YK GO TO 160 C 180 CONTINUE C C DRAW WIGGLE TRACE FOR OVERLAY C CALL GWICOL (TRW, 1) CALL GVECT (XP, YP, LPL) C C 200 CONTINUE C RETURN END