CTITLEMDQON3 -- TRANSPOSE OF MNOQD3 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. THOMPSON 00000020 CA DESIGNER D.D. THOMPSON 00000030 CA LANGUAGE S/370 FORTRAN H 00000040 CA SYSTEM IBM OR CRAY CA WRITTEN SEPTEMBER, 1979 00000050 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00000060 C REVISED 07-07-86 JMP. DUAL IBM/CRAY VERSION. C REVISED 05-05-88 LWC. DECLARE SYSTEM VARIABLES C INTEGER. C REVISED 11-13-89 RDK. REMOVE EXTERNAL FOR S1ATP. CA 00000070 CA 00000080 CA CALL MDQON3 (Q, ICDP, KCDP, LINE, LD, NLINE, D, XCDP, XRNMO, 00000090 CA ZA, ZB, ZC, NUMC, NUML) 00000100 CA 00000110 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000120 CA 00000130 CA IN Q R8 LAG VALUES FOR EACH TRACE. (LENGTH LINE 00000140 CA (NLINE) ) (REJECTED TRACES ARE INDICATED BY 00000150 CA Q > 1.0E6) 00000160 CA IN ICDP I4 ARRAY OF INDEX POSITIONS CORRESPONDING TO 00000170 CA THE LAST TRACE IN EACH CDP. LENGTH<=NLINE*LD.00000180 CA IN KCDP I4 ARRAY OF STARTING CDP NUMBERS FOR EACH LINE. 00000190 CA LENGTH = NLINE 00000200 CA IN LINE I4 POINTER ARRAY INDICATING LAST ELEMENT IN Q 00000210 CA FOR EACH LINE. (LENGTH = NLINE) 00000220 CA IN LD I4 MAXIMUM CDP # WHICH OCCURS ON ANY LINE. 00000230 CA IN NLINE I4 NUMBER OF LINES 00000240 CA IN D R4 OFFSET SQUARED FOR EACH TRACE. LENGTH = 00000250 CA LINE(NLINE) 00000260 CA OUT XCDP R8 OUTPUT CDP AVERAGE FOR EACH CDP. ARRANGED 00000270 CA BY LINES WITH LD ENTRIES/LINE. NOTE SOME OF 00000280 CA THESE CDP ARE NOT REPRESENTED BY TRACES. 00000290 CA LENGTH = LD*NLINE. 00000300 CA OUT XRNMO R8 OUTPUT RNMO FOR EACH CDP ARRANGED AS XCDP. 00000310 CA LENGTH = LD*NLINE 00000320 CA IN ZA R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00000330 CA IN ZB R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00000340 CA IN ZC R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00000350 CA IN NUMC I4 # OF CDP ON EACH SIDE OF CENTER IN RNMO 00000360 CA AVERAGE. 00000370 CA IN NUML I4 # OF LINES ON EACH SIDE OF CENTER IN RNMO 00000380 CA AVERAGE. 00000390 CA 00000400 CA THIS ROUTINE PERFORMS THE TRANSPOSE OPERATION OF THAT OF THE 00000410 CA ROUTINE MNOQD3. 00000420 CA 00000430 C *** SEE THE SECOND PART OF APPENDIX A IN THE TECHNICAL NOTES 00000440 C FOR THE PROCESS 'TRAX'. COMMENTS HERE WILL REFERENCE THE 00000450 C STEP NUMBERS AND VARIABLE NAMES DESCRIBED THERE FOR THE 00000460 C TRANSPOSE OPERATION. 00000470 C 00000480 C 00000490 SUBROUTINE MDQON3(Q, ICDP, KCDP, LINE, LD, NLINE, D, XCDP, XRNMO, 00000500 * ZA, ZB, ZC, NUMC, NUML) 00000510 C 00000520 C 00990000 C *********** WARNING ************************************* 01000000 C *** NO IMPLICIT INTEGER STATEMENT **************** 01010000 C ********************************************************* 01020000 C 01030000 C EXTERNAL S1ATP 00000530 C 00000540 C INTEGER ARRAYS IN PARAMETER LIST 00000550 C 00000560 INTEGER ICDP (1) 00000570 INTEGER KCDP (1) 00000580 INTEGER LINE (1) 00000590 INTEGER SYSTEM 01330000 INTEGER SYBYPW 01340000 INTEGER SYLOCF 01350000 INTEGER JAPNMS 01360000 C 00000600 C REAL ARRAYS IN PARAMETER LIST 00000610 C 00000620 REAL D (1) 00000630 DOUBLE PRECISION Q (1) 00000640 DOUBLE PRECISION XCDP (1) 00000650 DOUBLE PRECISION XRNMO (1) 00000660 DOUBLE PRECISION ZA (1) 00000670 DOUBLE PRECISION ZB (1) 00000680 DOUBLE PRECISION ZC (1) 00000690 C 00000700 C REAL VARIABLES -- LOCAL 00000710 C 00000720 DOUBLE PRECISION Q2 00000730 DOUBLE PRECISION SD 00000740 DOUBLE PRECISION SW 00000750 DOUBLE PRECISION SX 00000760 DOUBLE PRECISION SX2 00000770 DOUBLE PRECISION SY 00000780 DOUBLE PRECISION SYD 00000790 C COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS C IF (1 .EQ. 2) CALL S1ATP C IF (SYBYPW .EQ. 8) THEN NDPW = 1 ELSE NDPW = 2 ENDIF C 00000800 C DETERMINE MAX NUMBER OF DEPTH POINTS. 00000810 C 00000820 LDD = LD * NLINE 00000830 LDD2 = NDPW * LDD C 00000850 C SET NUMBER OF CDP (MUM) AND NUMBER OF LINES (LUM) FOR RNM0 00000860 C RNMO AVERAGING. THESE ARE NORMALLY SET TO PARAMETER VALUES 00000870 C NUMC AND NUML BUT CANNOT BE GREATER THAN 1/4 THE NUMBER OF 00000880 C CDP OR LINES IN THE DATA. 00000890 C 00000900 MUM = NUMC 00000910 IF (MUM*4+3 .GT. LD) MUM = (LD-3) / 4 00000920 MUMP = MUM + 1 00000930 LDM = LD - MUM 00000940 LDMP = LDM + 1 00000950 LUM = NUML 00000960 IF (LUM*4+3 .GT. NLINE) LUM = (NLINE-3) / 4 00000970 LUMP = LUM + 1 00000980 NLNM = NLINE - LUM 00000990 NLNMP = NLNM + 1 00001000 LUMLD = LUM * LD 00001010 C 00001020 C CLEAR SCRATCH ARRAYS AND XCDP AND XRNM0 ARRAYS. 00001030 C 00001040 CALL ARSET(ZA, LDD2, 0.) 00001050 CALL ARSET(ZB, LDD2, 0.) 00001060 CALL ARSET(ZC, LDD2, 0.) 00001070 CALL ARSET(XCDP, LDD2, 0.) 00001080 CALL ARSET(XRNMO, LDD2, 0.) 00001090 C 00001100 C PREPARE TO EVALUATE CDP SUMS DESCRIBED IN STEP #1. 00001110 C 00001120 II = 0 00001130 III = 0 00001140 KEY2 = 1 00001150 KEY = 0 00001160 L = 1 00001170 KK = 0 00001180 C 00001190 C INITIALIZE SUMS FOR NEW CDP. 00001200 C 00001210 10 SW = 0. 00001220 SYD = 0. 00001230 SY = 0. 00001240 SX = 0. 00001250 SX2 = 0. 00001260 KK = KK + 1 00001270 III = III + 1 00001280 IIIC = ICDP(III) 00001290 IF (KEY2 .EQ. 0) GO TO 20 00001300 C 00001310 C UPDATE POINTERS FOR NEW LINES. 00001320 C 00001330 II = II + 1 00001340 IILD = (II-1) * LD 00001350 NTT = LINE(II) 00001360 KEY2 = 0 00001370 KK = KCDP(II) 00001380 C 00001390 20 DO 30 I = L, IIIC 00001400 Q2 = Q(I) 00001410 C 00001420 C IF TRACE NOT REJECTED UPDATE SUMS. 00001430 C 00001440 IF (Q2 .GT. 1.0E6) GO TO 30 00001450 D2 = D(I) 00001460 SW = SW + 1.0 00001470 SYD = Q2 * D2 + SYD 00001480 SY = Q2 + SY 00001490 SX = D2 + SX 00001500 SX2 = D2 * D2 + SX2 00001510 C 00001520 30 CONTINUE 00001530 C 00001540 C END OF CDP. UPDATE POINTERS AND IF ALL TRACES ARE NOT REJECTED 00001550 C STORE KERNELS DECRIBED IN STEP #1. 00001560 C 00001570 L = IIIC + 1 00001580 IF (IIIC .EQ. NTT) KEY2 = 1 00001590 IF (II .EQ. NLINE .AND. IIIC .EQ. NTT) KEY = 1 00001600 IF (SW .EQ. 0.) GO TO 40 00001610 INDX = KK + IILD 00001620 ZA(INDX) = SYD - SY * SX / SW 00001630 ZB(INDX) = SX2 - SX * SX / SW 00001640 XCDP(INDX) = SY / SW 00001650 XRNMO(INDX) = SX / SW 00001660 C 00001670 40 CONTINUE 00001680 IF (KEY .EQ. 0) GO TO 10 00001690 C 00001700 C STEP1 COMPLETE. BEGIN STEP2 TO FORM Q (NOT THE SAME AS VARIABLE 00001710 C Q HERE) LOOP THRU EACH LINE. 00001720 C 00001730 K = 0 00001740 C 00001750 DO 100 I = 1, NLINE 00001760 SD = 0. 00001770 KK = K + MUM 00001780 KL = K - MUM 00001790 C 00001800 C IF CDP AVERAGE RANGE NOT ZERO INITIALIZE SLIDING SUM 00001810 C FOR Q IN STEP 2 AT START OF LINE WITH PARTIAL SUMS. 00001820 C Q WILL BE STORED IN VARIABLE ZC. 00001830 C 00001840 IF(MUM .LE. 0) GO TO 70 00001850 C 00001860 DO 50 J = 1, MUM 00001870 50 SD = SD + ZB(J+K) 00001880 C 00001890 DO 60 J = 1, MUM 00001900 SD = SD + ZB(J+KK) 00001910 60 ZC(J+K) = SD 00001920 C 00001930 C FORM SLIDING SUM FOR Q ON MIDDLE OF LINE FOR STEP 2. 00001940 C 00001950 70 DO 80 J = MUMP, LDM 00001960 SD = SD + ZB(J+KK) 00001970 ZC(J+K) = SD 00001980 80 SD = SD - ZB(J+KL) 00001990 C 00002000 C IF CDP AVERAGE RANGE NOT ZERO FINISH OFF SUMS ON END OF LINE. 00002010 C 00002020 IF(MUM .LE. 0) GO TO 100 00002030 C 00002040 DO 90 J = LDMP, LD 00002050 ZC(J+K) = SD 00002060 90 SD = SD - ZB(J+KL) 00002070 C 00002080 100 K = K + LD 00002090 C 00002100 C END OF STEP 2. BEGIN STEP 3. 00002110 C 00002120 C 00002130 IF(LUM .GT. 0) GO TO 150 00002140 C 00002150 C SPECIAL CASE STEP 3. NUMBER OF LINES FOR ANMO AVERAGE IS ZERO. 00002160 C FORM P AND G AND REPLACE CONTENTS OF Z VARIABLE ZA WITH G. 00002170 C 00002180 DO 140 I = 1, LD 00002190 SD = 0. 00002200 KK = I + LUMLD 00002210 KL = I - LUMLD 00002220 JJ = LD * (LUMP-1) 00002230 C 00002240 DO 130 J = LUMP, NLNM 00002250 SD = SD + ZC(JJ+KK) 00002260 JJPI = JJ + I 00002270 IF(DABS(SD) .GT. 1.E-30) GO TO 110 00002280 ZA(JJPI) = 0. 00002290 GO TO 120 00002300 C 00002310 110 ZA(JJPI) = ZA(JJPI) / SD 00002320 C 00002330 120 SD = SD - ZC(JJ+KL) 00002340 C 00002350 130 JJ = JJ + LD 00002360 C 00002370 140 CONTINUE 00002380 C 00002390 C END OF STEP 3 FOR CASE THAT NUMBER OF LINES TO AVERAGE IS ZERO. 00002400 C LOOP THRU CROSS LINES. 00002410 C 00002420 GO TO 260 00002430 C 00002440 150 DO 250 I = 1, LD 00002450 SD = 0. 00002460 KK = I +LUMLD 00002470 KL = I -LUMLD 00002480 JJ = 0 00002490 C 00002500 C INITIALIZE SLIDING SUM FOR P ON BEGINNING OF CROSS LINE. COMPUTE 00002510 C G FOR START OF CROSS LINES AND STORE IN VARIABLE ZA. 00002520 C 00002530 DO 160 J = 1, LUM 00002540 SD = SD + ZC(JJ+I) 00002550 C 00002560 160 JJ = JJ +LD 00002570 C 00002580 JJ=0 00002590 C 00002600 DO 180 J = 1, LUM 00002610 SD = SD + ZC(JJ+KK) 00002620 JJPI = JJ + I 00002630 IF(DABS(SD) .GT. 1.E-30) GO TO 170 00002640 ZA(JJPI) = 0. 00002650 GO TO 180 00002660 C 00002670 170 ZA(JJPI) = ZA(JJPI) / SD 00002680 C 00002690 180 JJ = JJ + LD 00002700 C 00002710 JJ = LD * (LUMP-1) 00002720 C 00002730 C FORM P AND G FOR MIDDLE OF CROSS LINE. STORE G IN VARIABLE ZA. 00002740 C 00002750 DO 210 J = LUMP, NLNM 00002760 SD = SD + ZC(JJ+KK) 00002770 JJPI = JJ + I 00002780 IF(DABS(SD).GT.1.E-30) GO TO 190 00002790 ZA(JJPI)=0. 00002800 GO TO 200 00002810 C 00002820 190 ZA(JJPI) = ZA(JJPI) / SD 00002830 C 00002840 200 SD = SD - ZC(JJ+KL) 00002850 C 00002860 210 JJ = JJ + LD 00002870 C 00002880 JJ = LD * (NLNMP-1) 00002890 C 00002900 C FORM P AND G FOR END OF CROSS LINE AND STORE G IN VARIABLE ZA. 00002910 C 00002920 DO 240 J = NLNMP, NLINE 00002930 JJPI = JJ + I 00002940 IF(DABS(SD) .GT. 1.E-30) GO TO 220 00002950 ZA(JJPI) = 0. 00002960 GO TO 230 00002970 C 00002980 220 ZA(JJ+I) = ZA(JJ+I) / SD 00002990 C 00003000 230 SD = SD - ZC(JJ+KL) 00003010 C 00003020 240 JJ = JJ + LD 00003030 C 00003040 250 CONTINUE 00003050 C 00003060 C END OF STEP3 FOR CASE THAT NUMBER OF LINES TO AVERAGE IS NOT ZERO.00003070 C CLEAR VARIABLE ZC TO BE REUSED TO COMPUTE H IN STEP 4. 00003080 C 00003090 260 CALL ARSET(ZC, LDD2, 0.) 00003100 K = 0 00003110 IF(MUM .GT. 0) GO TO 290 00003120 C 00003130 C COMPUTE H IN STEP4 FOR SPECIAL CASE THAT NUMBER CDP TO AVERAGE 00003140 C IS ZERO. STORE H IN VARIABLE ZC. 00003150 C 00003160 DO 280 I = 1, NLINE 00003170 SD = 0. 00003180 KK = K + MUM 00003190 KL = K - MUM 00003200 C 00003210 DO 270 J = MUMP, LDM 00003220 SD = SD + ZA(J+KK) 00003230 ZC(J+K) = SD 00003240 C 00003250 270 SD = SD - ZA(J+KL) 00003260 C 00003270 280 K = K + LD 00003280 C 00003290 C END OF STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS ZERO. 00003300 C 00003310 GO TO 360 00003320 C 00003330 C BEGIN STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS NOT ZERO. 00003340 C 00003350 290 DO 350 I = 1, NLINE 00003360 SD = 0. 00003370 KK = K + MUM 00003380 KL = K - MUM 00003390 C 00003400 C INITIALIZE SLIDING SUM H FOR START OF LINE. 00003410 C 00003420 DO 300 J = 1, MUM 00003430 300 SD = SD + ZA(J+K) 00003440 C 00003450 DO 310 J = 1, MUM 00003460 SD = SD + ZA(J+KK) 00003470 310 ZC(J+K) = SD 00003480 C 00003490 C FORM SLIDING SUM H FOR MIDDLE OF LINE. 00003500 C 00003510 320 DO 330 J = MUMP, LDM 00003520 SD = SD + ZA(J+KK) 00003530 ZC(J+K) = SD 00003540 330 SD = SD - ZA(J+KL) 00003550 C 00003560 C FINISH END OF LINE FOR H. 00003570 C 00003580 DO 340 J = LDMP, LD 00003590 ZC(J+K) = SD 00003600 340 SD = SD - ZA(J+KL) 00003610 C 00003620 350 K = K + LD 00003630 C 00003640 C END OF STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS NOT ZERO. 00003650 C BEGIN STEP 5. 00003660 C 00003670 360 IF(LUM .GT. 0) GO TO 390 00003680 C 00003690 C SPECIAL CASE OF STEP5 WHERE NUMBER OF LINES TO 00003700 C AVERAGE IS ZERO. COMPUTE BETA AND ALPHA AND 00003710 C AND STORE IN ZRNMO AND XCDP, RESPECTIVELY. 00003720 C 00003730 DO 380 I = 1, LD 00003740 SD = 0. 00003750 KK = I + LUMLD 00003760 KL = I - LUMLD 00003770 JJ = LD * (LUMP-1) 00003780 C 00003790 DO 370 J = LUMP, NLNM 00003800 JJPI = JJ + I 00003810 SD = SD + ZC(JJ+KK) 00003820 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 00003830 XRNMO(JJPI) = SD 00003840 SD = SD - ZC(JJ+KL) 00003850 C 00003860 370 JJ = JJ + LD 00003870 C 00003880 380 CONTINUE 00003890 C 00003900 C END OF SPECIAL CASE FOR STEP 5. 00003910 C 00003920 GO TO 450 00003930 C 00003940 C BEGIN STEP 5 FOR CASE WHERE NUMBER OF LINES TO AVERAGE IS 00003950 C NOT ZERO. STORE BETA IN VARIABLE XRNMO AND ALPHA IN XCDP. 00003960 C 00003970 390 DO 440 I = 1, LD 00003980 SD = 0. 00003990 KK = I + LUMLD 00004000 KL = I - LUMLD 00004010 JJ = 0 00004020 C 00004030 C INITIALIZE PARTIAL SUMS FOR START OF CROSSLINE. 00004040 C 00004050 DO 400 J = 1, LUM 00004060 SD = SD + ZC(JJ+I) 00004070 400 JJ = JJ + LD 00004080 C 00004090 JJ = 0 00004100 C 00004110 DO 410 J = 1, LUM 00004120 JJPI = JJ + I 00004130 SD = SD + ZC(JJ+KK) 00004140 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 00004150 XRNMO(JJPI) = SD 00004160 C 00004170 410 JJ = JJ + LD 00004180 C 00004190 JJ = LD * (LUMP-1) 00004200 C 00004210 DO 420 J = LUMP, NLNM 00004220 JJPI = JJ + I 00004230 SD = SD + ZC(JJ+KK) 00004240 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 00004250 XRNMO(JJPI) = SD 00004260 SD = SD - ZC(JJ+KL) 00004270 C 00004280 420 JJ = JJ + LD 00004290 C 00004300 JJ = LD * (NLNMP-1) 00004310 C 00004320 C COMPLETE PARTIAL SUMS FOR END OF CROSSLINE. 00004330 C 00004340 DO 430 J = NLNMP, NLINE 00004350 JJPI = JJ + I 00004360 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 00004370 XRNMO(JJPI) = SD 00004380 SD = SD - ZC(JJ+KL) 00004390 C 00004400 430 JJ = JJ + LD 00004410 C 00004420 440 CONTINUE 00004430 C 00004440 C END OF STEP 5 FOR CASE WHERE NUMBER OF LINES TO AVERAGE IS 00004450 C NOT ZERO. BEGIN STEP 6. CORRECT THE INPUT LAG VALUES 00004460 C (VARIABLE Q) WITH QUADRATIC AND CONSTANT COEFFICIENTS STORED 00004470 C IN VARIABLE XRNMO AND XCDP, RESPECTIVELY. 00004480 C 00004490 450 KT = 0 00004500 KK = 0 00004510 III = 0 00004520 C 00004530 DO 480 I = 1, NLINE 00004540 KL = KT + 1 00004550 KT = LINE(I) 00004560 K = KCDP(I) 00004570 III = III + 1 00004580 IIIC = ICDP(III) 00004590 KKK = KK + K 00004600 C 00004610 DO 470 J = KL, KT 00004620 IF(J .LE. IIIC) GO TO 460 00004630 K = K + 1 00004640 KKK = KK + K 00004650 III = III + 1 00004660 IIIC = ICDP(III) 00004670 C 00004680 460 Q2 = Q(J) 00004690 IF(Q2 .LE. 1.0E6) Q(J) = Q2 - XCDP(KKK) - XRNMO(KKK) * D(J) 00004700 C 00004710 470 CONTINUE 00004720 C 00004730 480 KK = KK + LD 00004740 C 00004750 RETURN 00004760 END 00004770