CTITLEMDQONX -- TRANSPOSE OF MNOQDX 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. THOMPSON 00020000 CA DESIGNER D.D. THOMPSON 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN SEPTEMBER, 1979 00060000 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00070000 C REVISED 01-15-85 REP. ADD CALLS TO USBFRX AND ADD IX TO 00080000 C ARGUMENT LIST. 00090000 C REVISED 08-14-85 REP. CHANGE NAME FROM MDQON3. 00100000 C REVISED 11-09-88 ESN. INCORPORATE MEMORY PATH. 00110006 CA 00120000 CA 00130000 CA CALL MDQONX (Q, IX, ICDP, KCDP, LINE, LD, NLINE, D, XCDP, XRNMO, 00140000 CA ZA, ZB, ZC, NUMC, NUML) 00150000 CA 00160000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00170000 CA 00180000 CA IN Q R8 LAG VALUES FOR EACH TRACE. (LENGTH LINE 00190000 CA (NLINE) ) (REJECTED TRACES ARE INDICATED BY 00200000 CA Q > 1.0E6) 00210000 CA IN IX I4 INDEX OF BEGINING MINUS ONE OF ARRAYS Q & D. 00220000 CA IN ICDP I4 ARRAY OF INDEX POSITIONS CORRESPONDING TO 00230000 CA THE LAST TRACE IN EACH CDP. LENGTH<=NLINE*LD.00240000 CA IN KCDP I4 ARRAY OF STARTING CDP NUMBERS FOR EACH LINE. 00250000 CA LENGTH = NLINE 00260000 CA IN LINE I4 POINTER ARRAY INDICATING LAST ELEMENT IN Q 00270000 CA FOR EACH LINE. (LENGTH = NLINE) 00280000 CA IN LD I4 MAXIMUM CDP # WHICH OCCURS ON ANY LINE. 00290000 CA IN NLINE I4 NUMBER OF LINES 00300000 CA IN D R4 OFFSET SQUARED FOR EACH TRACE. LENGTH = 00310000 CA LINE(NLINE) 00320000 CA OUT XCDP R8 OUTPUT CDP AVERAGE FOR EACH CDP. ARRANGED 00330000 CA BY LINES WITH LD ENTRIES/LINE. NOTE SOME OF 00340000 CA THESE CDP ARE NOT REPRESENTED BY TRACES. 00350000 CA LENGTH = LD*NLINE. 00360000 CA OUT XRNMO R8 OUTPUT RNMO FOR EACH CDP ARRANGED AS XCDP. 00370000 CA LENGTH = LD*NLINE 00380000 CA IN ZA R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00390000 CA IN ZB R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00400000 CA IN ZC R8 SCRATCH ARRAY OF LENGTH = NLINE*LD 00410000 CA IN NUMC I4 # OF CDP ON EACH SIDE OF CENTER IN RNMO 00420000 CA AVERAGE. 00430000 CA IN NUML I4 # OF LINES ON EACH SIDE OF CENTER IN RNMO 00440000 CA AVERAGE. 00450000 CA 00460000 CA THIS ROUTINE PERFORMS THE TRANSPOSE OPERATION OF THAT OF THE 00470000 CA ROUTINE MNOQDX. 00480000 CA 00490000 C *** SEE THE SECOND PART OF APPENDIX A IN THE TECHNICAL NOTES 00500000 C FOR THE PROCESS 'TRAX'. COMMENTS HERE WILL REFERENCE THE 00510000 C STEP NUMBERS AND VARIABLE NAMES DESCRIBED THERE FOR THE 00520000 C TRANSPOSE OPERATION. 00530000 C 00540000 C 00550000 SUBROUTINE MDQONX(Q, IX, ICDP, KCDP, LINE, LD, NLINE, D, XCDP, 00560000 * XRNMO, ZA, ZB, ZC, NUMC, NUML) 00570000 C 00580000 COMMON COM(1) 00590000 INTEGER COM 00600004 REAL XCOM(1) 00610003 REAL*8 ZCOM(1) 00620001 EQUIVALENCE (COM(1),XCOM(1),ZCOM(1)) 00630001 C 00640000 C COMMON CONTAINING BUFFERING INFORMATION 00650000 C 00660000 COMMON /BFINFO/ BYND(15), BIND(15), BOFF(15), BQND(15) 00670000 C 00680000 INTEGER BYND, BIND, BOFF, BQND 00690000 C 00700000 C 00710000 C INTEGER VARIABLES 00720000 C 00730000 INTEGER B1 00740000 INTEGER B2 00750000 INTEGER IX 00760000 C 00770000 C INTEGER ARRAYS IN PARAMETER LIST 00780000 C 00790000 INTEGER ICDP (1) 00800000 INTEGER KCDP (1) 00810000 INTEGER LINE (1) 00820000 C 00830000 C REAL ARRAYS IN PARAMETER LIST 00840000 C 00850000 REAL*4 D (1) 00860000 REAL*8 Q (1) 00870000 REAL*8 XCDP (1) 00880000 REAL*8 XRNMO (1) 00890000 REAL*8 ZA (1) 00900000 REAL*8 ZB (1) 00910000 REAL*8 ZC (1) 00920000 C 00930000 C REAL VARIABLES -- LOCAL 00940000 C 00950000 REAL*8 D2 00960005 REAL*8 Q2 00970005 REAL*8 SD 00980000 REAL*8 SW 00990000 REAL*8 SX 01000000 REAL*8 SX2 01010000 REAL*8 SY 01020000 REAL*8 SYD 01030000 C 01040000 C DETERMINE MAX NUMBER OF DEPTH POINTS. 01050000 C 01060000 LDD = LD * NLINE 01070000 LDD2 = 2 * LDD 01080000 C 01090000 C SET NUMBER OF CDP (MUM) AND NUMBER OF LINES (LUM) FOR RNM0 01100000 C RNMO AVERAGING. THESE ARE NORMALLY SET TO PARAMETER VALUES 01110000 C NUMC AND NUML BUT CANNOT BE GREATER THAN 1/4 THE NUMBER OF 01120000 C CDP OR LINES IN THE DATA. 01130000 C 01140000 MUM = NUMC 01150000 IF (MUM*4+3 .GT. LD) MUM = (LD-3) / 4 01160000 MUMP = MUM + 1 01170000 LDM = LD - MUM 01180000 LDMP = LDM + 1 01190000 LUM = NUML 01200000 IF (LUM*4+3 .GT. NLINE) LUM = (NLINE-3) / 4 01210000 LUMP = LUM + 1 01220000 NLNM = NLINE - LUM 01230000 NLNMP = NLNM + 1 01240000 LUMLD = LUM * LD 01250000 C 01260000 C CLEAR SCRATCH ARRAYS AND XCDP AND XRNM0 ARRAYS. 01270000 C 01280000 CALL ARSET(ZA, LDD2, 0.) 01290000 CALL ARSET(ZB, LDD2, 0.) 01300000 CALL ARSET(ZC, LDD2, 0.) 01310000 CALL ARSET(XCDP, LDD2, 0.) 01320000 CALL ARSET(XRNMO, LDD2, 0.) 01330000 C 01340000 C PREPARE TO EVALUATE CDP SUMS DESCRIBED IN STEP #1. 01350000 C 01360000 II = 0 01370000 III = 0 01380000 KEY2 = 1 01390000 KEY = 0 01400000 L = 1 01410000 KK = 0 01420000 C 01430000 C INITIALIZE SUMS FOR NEW CDP. 01440000 C 01450000 10 SW = 0. 01460000 SYD = 0. 01470000 SY = 0. 01480000 SX = 0. 01490000 SX2 = 0. 01500000 KK = KK + 1 01510000 III = III + 1 01520000 IIIC = ICDP(III) 01530000 IF (KEY2 .EQ. 0) GO TO 20 01540000 C 01550000 C UPDATE POINTERS FOR NEW LINES. 01560000 C 01570000 II = II + 1 01580000 IILD = (II-1) * LD 01590000 NTT = LINE(II) 01600000 KEY2 = 0 01610000 KK = KCDP(II) 01620000 C 01630000 20 CONTINUE 01640000 IF (BQND(12) .EQ. 0) THEN 01650000 DO 30 I = L, IIIC 01660000 CALL USBFRX (Q, I+IX, B1, 0, BQND) 01670000 Q2 = Q(B1) 01680000 C 01690000 C IF TRACE NOT REJECTED UPDATE SUMS. 01700000 C 01710000 IF (Q2 .GT. 1.0E6) GO TO 30 01720000 CALL USBFRX (D, I+IX, B2, 0, BOFF) 01730000 D2 = D(B2) 01740000 SW = SW + 1.0 01750000 SYD = Q2 * D2 + SYD 01760000 SY = Q2 + SY 01770000 SX = D2 + SX 01780000 SX2 = D2 * D2 + SX2 01790000 30 CONTINUE 01800000 ELSE 01810000 B1 = (BQND(12)+1) / 2 01820003 DO 35 I = L, IIIC 01830000 Q2 = ZCOM(B1+I+IX-1) 01840000 C 01850000 C IF TRACE NOT REJECTED UPDATE SUMS. 01860000 C 01870000 IF (Q2 .GT. 1.0E6) GO TO 35 01880000 D2 = XCOM(BOFF(12)+I+IX-1) 01890000 SW = SW + 1.0 01900000 SYD = Q2 * D2 + SYD 01910000 SY = Q2 + SY 01920000 SX = D2 + SX 01930000 SX2 = D2 * D2 + SX2 01940000 35 CONTINUE 01950000 ENDIF 01960000 C 01970000 C END OF CDP. UPDATE POINTERS AND IF ALL TRACES ARE NOT REJECTED 01980000 C STORE KERNELS DECRIBED IN STEP #1. 01990000 C 02000000 L = IIIC + 1 02010000 IF (IIIC .EQ. NTT) KEY2 = 1 02020000 IF (II .EQ. NLINE .AND. IIIC .EQ. NTT) KEY = 1 02030000 IF (SW .EQ. 0.) GO TO 40 02040000 INDX = KK + IILD 02050000 ZA(INDX) = SYD - SY * SX / SW 02060000 ZB(INDX) = SX2 - SX * SX / SW 02070000 XCDP(INDX) = SY / SW 02080000 XRNMO(INDX) = SX / SW 02090000 C 02100000 40 CONTINUE 02110000 IF (KEY .EQ. 0) GO TO 10 02120000 C 02130000 C STEP1 COMPLETE. BEGIN STEP2 TO FORM Q (NOT THE SAME AS VARIABLE 02140000 C Q HERE) LOOP THRU EACH LINE. 02150000 C 02160000 K = 0 02170000 C 02180000 DO 100 I = 1, NLINE 02190000 SD = 0. 02200000 KK = K + MUM 02210000 KL = K - MUM 02220000 C 02230000 C IF CDP AVERAGE RANGE NOT ZERO INITIALIZE SLIDING SUM 02240000 C FOR Q IN STEP 2 AT START OF LINE WITH PARTIAL SUMS. 02250000 C Q WILL BE STORED IN VARIABLE ZC. 02260000 C 02270000 IF(MUM .LE. 0) GO TO 70 02280000 C 02290000 DO 50 J = 1, MUM 02300000 50 SD = SD + ZB(J+K) 02310000 C 02320000 DO 60 J = 1, MUM 02330000 SD = SD + ZB(J+KK) 02340000 60 ZC(J+K) = SD 02350000 C 02360000 C FORM SLIDING SUM FOR Q ON MIDDLE OF LINE FOR STEP 2. 02370000 C 02380000 70 DO 80 J = MUMP, LDM 02390000 SD = SD + ZB(J+KK) 02400000 ZC(J+K) = SD 02410000 80 SD = SD - ZB(J+KL) 02420000 C 02430000 C IF CDP AVERAGE RANGE NOT ZERO FINISH OFF SUMS ON END OF LINE. 02440000 C 02450000 IF(MUM .LE. 0) GO TO 100 02460000 C 02470000 DO 90 J = LDMP, LD 02480000 ZC(J+K) = SD 02490000 90 SD = SD - ZB(J+KL) 02500000 C 02510000 100 K = K + LD 02520000 C 02530000 C END OF STEP 2. BEGIN STEP 3. 02540000 C 02550000 C 02560000 IF(LUM .GT. 0) GO TO 150 02570000 C 02580000 C SPECIAL CASE STEP 3. NUMBER OF LINES FOR ANMO AVERAGE IS ZERO. 02590000 C FORM P AND G AND REPLACE CONTENTS OF Z VARIABLE ZA WITH G. 02600000 C 02610000 DO 140 I = 1, LD 02620000 SD = 0. 02630000 KK = I + LUMLD 02640000 KL = I - LUMLD 02650000 JJ = LD * (LUMP-1) 02660000 C 02670000 DO 130 J = LUMP, NLNM 02680000 SD = SD + ZC(JJ+KK) 02690000 JJPI = JJ + I 02700000 IF(DABS(SD) .GT. 1.E-30) GO TO 110 02710000 ZA(JJPI) = 0. 02720000 GO TO 120 02730000 C 02740000 110 ZA(JJPI) = ZA(JJPI) / SD 02750000 C 02760000 120 SD = SD - ZC(JJ+KL) 02770000 C 02780000 130 JJ = JJ + LD 02790000 C 02800000 140 CONTINUE 02810000 C 02820000 C END OF STEP 3 FOR CASE THAT NUMBER OF LINES TO AVERAGE IS ZERO. 02830000 C LOOP THRU CROSS LINES. 02840000 C 02850000 GO TO 260 02860000 C 02870000 150 DO 250 I = 1, LD 02880000 SD = 0. 02890000 KK = I +LUMLD 02900000 KL = I -LUMLD 02910000 JJ = 0 02920000 C 02930000 C INITIALIZE SLIDING SUM FOR P ON BEGINNING OF CROSS LINE. COMPUTE 02940000 C G FOR START OF CROSS LINES AND STORE IN VARIABLE ZA. 02950000 C 02960000 DO 160 J = 1, LUM 02970000 SD = SD + ZC(JJ+I) 02980000 C 02990000 160 JJ = JJ +LD 03000000 C 03010000 JJ=0 03020000 C 03030000 DO 180 J = 1, LUM 03040000 SD = SD + ZC(JJ+KK) 03050000 JJPI = JJ + I 03060000 IF(DABS(SD) .GT. 1.E-30) GO TO 170 03070000 ZA(JJPI) = 0. 03080000 GO TO 180 03090000 C 03100000 170 ZA(JJPI) = ZA(JJPI) / SD 03110000 C 03120000 180 JJ = JJ + LD 03130000 C 03140000 JJ = LD * (LUMP-1) 03150000 C 03160000 C FORM P AND G FOR MIDDLE OF CROSS LINE. STORE G IN VARIABLE ZA. 03170000 C 03180000 DO 210 J = LUMP, NLNM 03190000 SD = SD + ZC(JJ+KK) 03200000 JJPI = JJ + I 03210000 IF(DABS(SD).GT.1.E-30) GO TO 190 03220000 ZA(JJPI)=0. 03230000 GO TO 200 03240000 C 03250000 190 ZA(JJPI) = ZA(JJPI) / SD 03260000 C 03270000 200 SD = SD - ZC(JJ+KL) 03280000 C 03290000 210 JJ = JJ + LD 03300000 C 03310000 JJ = LD * (NLNMP-1) 03320000 C 03330000 C FORM P AND G FOR END OF CROSS LINE AND STORE G IN VARIABLE ZA. 03340000 C 03350000 DO 240 J = NLNMP, NLINE 03360000 JJPI = JJ + I 03370000 IF(DABS(SD) .GT. 1.E-30) GO TO 220 03380000 ZA(JJPI) = 0. 03390000 GO TO 230 03400000 C 03410000 220 ZA(JJ+I) = ZA(JJ+I) / SD 03420000 C 03430000 230 SD = SD - ZC(JJ+KL) 03440000 C 03450000 240 JJ = JJ + LD 03460000 C 03470000 250 CONTINUE 03480000 C 03490000 C END OF STEP3 FOR CASE THAT NUMBER OF LINES TO AVERAGE IS NOT ZERO.03500000 C CLEAR VARIABLE ZC TO BE REUSED TO COMPUTE H IN STEP 4. 03510000 C 03520000 260 CALL ARSET(ZC, LDD2, 0.) 03530000 K = 0 03540000 IF(MUM .GT. 0) GO TO 290 03550000 C 03560000 C COMPUTE H IN STEP4 FOR SPECIAL CASE THAT NUMBER CDP TO AVERAGE 03570000 C IS ZERO. STORE H IN VARIABLE ZC. 03580000 C 03590000 DO 280 I = 1, NLINE 03600000 SD = 0. 03610000 KK = K + MUM 03620000 KL = K - MUM 03630000 C 03640000 DO 270 J = MUMP, LDM 03650000 SD = SD + ZA(J+KK) 03660000 ZC(J+K) = SD 03670000 C 03680000 270 SD = SD - ZA(J+KL) 03690000 C 03700000 280 K = K + LD 03710000 C 03720000 C END OF STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS ZERO. 03730000 C 03740000 GO TO 360 03750000 C 03760000 C BEGIN STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS NOT ZERO. 03770000 C 03780000 290 DO 350 I = 1, NLINE 03790000 SD = 0. 03800000 KK = K + MUM 03810000 KL = K - MUM 03820000 C 03830000 C INITIALIZE SLIDING SUM H FOR START OF LINE. 03840000 C 03850000 DO 300 J = 1, MUM 03860000 300 SD = SD + ZA(J+K) 03870000 C 03880000 DO 310 J = 1, MUM 03890000 SD = SD + ZA(J+KK) 03900000 310 ZC(J+K) = SD 03910000 C 03920000 C FORM SLIDING SUM H FOR MIDDLE OF LINE. 03930000 C 03940000 320 DO 330 J = MUMP, LDM 03950000 SD = SD + ZA(J+KK) 03960000 ZC(J+K) = SD 03970000 330 SD = SD - ZA(J+KL) 03980000 C 03990000 C FINISH END OF LINE FOR H. 04000000 C 04010000 DO 340 J = LDMP, LD 04020000 ZC(J+K) = SD 04030000 340 SD = SD - ZA(J+KL) 04040000 C 04050000 350 K = K + LD 04060000 C 04070000 C END OF STEP 4 FOR CASE THAT NUMBER CDP TO AVERAGE IS NOT ZERO. 04080000 C BEGIN STEP 5. 04090000 C 04100000 360 IF(LUM .GT. 0) GO TO 390 04110000 C 04120000 C SPECIAL CASE OF STEP5 WHERE NUMBER OF LINES TO 04130000 C AVERAGE IS ZERO. COMPUTE BETA AND ALPHA AND 04140000 C AND STORE IN ZRNMO AND XCDP, RESPECTIVELY. 04150000 C 04160000 DO 380 I = 1, LD 04170000 SD = 0. 04180000 KK = I + LUMLD 04190000 KL = I - LUMLD 04200000 JJ = LD * (LUMP-1) 04210000 C 04220000 DO 370 J = LUMP, NLNM 04230000 JJPI = JJ + I 04240000 SD = SD + ZC(JJ+KK) 04250000 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 04260000 XRNMO(JJPI) = SD 04270000 SD = SD - ZC(JJ+KL) 04280000 C 04290000 370 JJ = JJ + LD 04300000 C 04310000 380 CONTINUE 04320000 C 04330000 C END OF SPECIAL CASE FOR STEP 5. 04340000 C 04350000 GO TO 450 04360000 C 04370000 C BEGIN STEP 5 FOR CASE WHERE NUMBER OF LINES TO AVERAGE IS 04380000 C NOT ZERO. STORE BETA IN VARIABLE XRNMO AND ALPHA IN XCDP. 04390000 C 04400000 390 DO 440 I = 1, LD 04410000 SD = 0. 04420000 KK = I + LUMLD 04430000 KL = I - LUMLD 04440000 JJ = 0 04450000 C 04460000 C INITIALIZE PARTIAL SUMS FOR START OF CROSSLINE. 04470000 C 04480000 DO 400 J = 1, LUM 04490000 SD = SD + ZC(JJ+I) 04500000 400 JJ = JJ + LD 04510000 C 04520000 JJ = 0 04530000 C 04540000 DO 410 J = 1, LUM 04550000 JJPI = JJ + I 04560000 SD = SD + ZC(JJ+KK) 04570000 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 04580000 XRNMO(JJPI) = SD 04590000 C 04600000 410 JJ = JJ + LD 04610000 C 04620000 JJ = LD * (LUMP-1) 04630000 C 04640000 DO 420 J = LUMP, NLNM 04650000 JJPI = JJ + I 04660000 SD = SD + ZC(JJ+KK) 04670000 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 04680000 XRNMO(JJPI) = SD 04690000 SD = SD - ZC(JJ+KL) 04700000 C 04710000 420 JJ = JJ + LD 04720000 C 04730000 JJ = LD * (NLNMP-1) 04740000 C 04750000 C COMPLETE PARTIAL SUMS FOR END OF CROSSLINE. 04760000 C 04770000 DO 430 J = NLNMP, NLINE 04780000 JJPI = JJ + I 04790000 XCDP(JJPI) = XCDP(JJPI) - XRNMO(JJPI) * SD 04800000 XRNMO(JJPI) = SD 04810000 SD = SD - ZC(JJ+KL) 04820000 C 04830000 430 JJ = JJ + LD 04840000 C 04850000 440 CONTINUE 04860000 C 04870000 C END OF STEP 5 FOR CASE WHERE NUMBER OF LINES TO AVERAGE IS 04880000 C NOT ZERO. BEGIN STEP 6. CORRECT THE INPUT LAG VALUES 04890000 C (VARIABLE Q) WITH QUADRATIC AND CONSTANT COEFFICIENTS STORED 04900000 C IN VARIABLE XRNMO AND XCDP, RESPECTIVELY. 04910000 C 04920000 450 KT = 0 04930000 KK = 0 04940000 III = 0 04950000 C 04960000 DO 480 I = 1, NLINE 04970000 KL = KT + 1 04980000 KT = LINE(I) 04990000 K = KCDP(I) 05000000 III = III + 1 05010000 IIIC = ICDP(III) 05020000 KKK = KK + K 05030000 C 05040000 IF (BQND(12) .EQ. 0) THEN 05050000 DO 470 J = KL, KT 05060000 IF(J .LE. IIIC) GO TO 460 05070000 K = K + 1 05080000 KKK = KK + K 05090000 III = III + 1 05100000 IIIC = ICDP(III) 05110000 C 05120000 460 CONTINUE 05130000 CALL USBFRX (Q, J+IX, B1, 1, BQND) 05140000 CALL USBFRX (D, J+IX, B2, 0, BOFF) 05150000 Q2 = Q(B1) 05160000 IF(Q2 .LE. 1.0E6) Q(B1) = Q2 - XCDP(KKK) - XRNMO(KKK) * D(B2) 05170000 C 05180000 470 CONTINUE 05190000 ELSE 05200000 B1 = (BQND(12)+1) / 2 05210003 DO 476 J = KL, KT 05220000 IF(J .LE. IIIC) GO TO 473 05230000 K = K + 1 05240000 KKK = KK + K 05250000 III = III + 1 05260000 IIIC = ICDP(III) 05270000 C 05280000 473 CONTINUE 05290000 IF(ZCOM(B1+J+IX-1) .LE. 1.0E6) 05300000 * ZCOM(B1+J+IX-1) = ZCOM(B1+J+IX-1) - 05310002 * XCDP(KKK) - XRNMO(KKK) * 05320000 * XCOM(BOFF(12)+J+IX-1) 05330000 C 05340000 476 CONTINUE 05350000 ENDIF 05360000 C 05370000 480 KK = KK + LD 05380000 C 05390000 RETURN 05400000 END 05410000