CTITLEMNOQAD -- MNOQAD (PLUS - MODELM, MTRANS, AND MSCINM) 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RANDY PROBST 00000020 CA DESIGNER D.D. THOMPSON R&D 00000030 CA LANGUAGE VS FORTRAN 00000040 CA SYSTEM IBM OR CRAY 00000041 CA WRITTEN 5/18/79 00000050 C REVISED 4/03/80 POLAK - CODE OPTIMIZATION 00000060 C REVISED 4/29/86 PONTON - DUAL IBM/CRAY VERSION. 00000061 C REVISED 11/13/89 RDK - REMOVE EXTERNAL FOR S1ATP. 00000061 CA 00000070 CA 00000080 CA CALL MNOQAD (Q,QQ,IND,LD,LS,NT,D,W,X,Z,NUM,BUFV,XX,ISW) 00000090 CA INPUT IND = BIASED STACKING TABLES I400000100 CA MIN DIMENSION (3,NT) 00000110 CA IND(1,I)= BIASED DEPTH POINT INDEX FOR TRACE I 00000120 CA IND(2,I)= BIASED RECEIVER INDEX FOR TRACE I 00000130 CA IND(3,I)= BIASED SHOT INDEX FOR TRACE I 00000140 CA BIASES ARE DETERMINED SO THAT: 00000150 CA THE LOWEST DEPTH POINT INDEX TO APPEAR IS > OR = 1 00000160 CA LOWEST RECEIVER INDEX TO APPEAR IS > OR = LD+1 00000170 CA LOWEST SHOT INDEX TO APPEAR IS > OR = LR+1. 00000180 CA IT IS ASSUMED THAT THE DEPTH POINT,RECEIVER AND SHOT00000190 CA INDICES ARE EACH PROPORTIONAL TO GROUND POSITION 00000200 CA FROM SOME REFERENCE POINT. EACH OF THE 3 PARAMETER 00000210 CA TYPES,HOWEVER, MAY HAVE A DIFFERENT PROPORTIONALITY 00000220 CA FACTOR AND REFERENCE POINT. 00000230 CA INPUT D = ARRAY OF OFFSET D1TANCES SQUARED. R4 00000240 CA (IT IS RECOMMENDED THAT THE DISTANCES BE 00000250 CA NORMALIZED TO MAX. OF 1 BEFORE SQUARING.) 00000260 CA INPUT W = TRACE WEIGHT ARRAY R400000270 CA THE ERROR IN THE STATIC PREDICTED BY THE MODEL 00000280 CA FOR TRACE I IS WEIGHTED BY W(I) IN THE LEAST 00000290 CA SQUARES OPTIMIZATION. (LENGTH NT) 00000300 CA INPUT NUM = NUMBER OF CDP ON EACH SIDE OF CENTRAL CDP TO R400000310 CA INCLUDE IN AVERAGE FOR QUADRATIC COEFFICNTNT 00000320 CA (NOTE NUM = 0 IS OK) 00000330 CA OUTPUT X = OUTPUT OF STATIC AND RNMO FACTORS R800000340 CA X(1)--X(LD) =DEPTH POINT FACTORS 00000350 CA X(LD+1)--X(LR) = NOT USED 00000360 CA X(LR+1)--X(LS)= NOT USED 00000370 CA X(LS+1)--X(LS+LD) = RNMO STATIC FACTORS. 00000380 CA (IF DSQ IS NORMALIZED TO 1, THEN THESE TERMS WILL BE00000390 CA THE ACTUAL RNMO OF A TRACE HAVING MAX. OFFSET DIS- 00000400 CA TANCE IF IT WERE TO APPEAR IN EACH CDP.) 00000410 CA INPUT Q = INPUT ARRAY OF MEASURED STATICS FOR EACH TRACE R400000420 CA STATICS NEED ONLY BE RELATIVE WITHIN EACH GATHER 00000430 CA Y IS PRESERVED UPON RETURN. 00000440 CA OUTPUT QQ = ADJUSTED LAG ARRAY R800000450 CA WORK Z = WORK ARRAY OF MIN LENGTH LS+LD R800000460 CA (ELEMENTS LD+1 -> LS NOT USED) 00000470 CA INPUT NT = NUMBER OF TRACES I400000480 CA INPUT LD > OR = THE LAST BIASED CDP INDEX TO APPEAR. I400000490 CA INPUT LS > OR = THE LAST BIASED SHOT INDEX TO APPEAR. I400000500 CA INPUT BUFV = USBUFR VARIABLE ARRAY I400000510 CA INPUT XX = INPUT ARRAY FOR ISW = 3 (USED TO BUILD QQ) R800000520 CA INPUT ISW = PROCESSING CONTROL SWITCH I400000530 CA = 1 -> MNOQAD / MTRANS / MSCINM I400000540 CA = 2 -> MODELM / MNOQAD / MTRANS 00000550 CA = 3 -> MODELM / MNOQAD 00000560 CA 00000570 CA THIS ROUTINE REMOVES CONSTANT AND QUADRATIC LEAST SQUARE 00000580 CA COMPONENTS FROM INPUT LAG VALUES AND LOADS THEM INTO THE 00000590 CA OUTPUT LAG ARRAY. IT INITIALIZES THE SOLUTION ARRAY WITH 00000600 CA ZERO STATICS AND THE COMPUTED ZERO AND 2 SECOND DEGREE 00000610 CA COEFFICIENTS IN THE CDP AND RNMO COMPONENTS, RESPECTIVELY. 00000620 CAEND 00000630 SUBROUTINE MNOQAD (Q,QQ,IND,LD,LS,NT,D,W,X,Z,NUM,BUFV,XX,ISW) 00000640 C 00000650 REAL Q(1) 00000660 DOUBLE PRECISION QQ(1) , XQ 00000670 INTEGER IND(1), BUFV(8) 00000680 REAL D(1) 00000690 REAL W(1) 00000700 DOUBLE PRECISION X(1) 00000710 DOUBLE PRECISION XX(1) 00000720 DOUBLE PRECISION Z(1) 00000730 INTEGER DA, DPFACT 00000740 INTEGER S1CPCH 00000741 DOUBLE PRECISION SN 00000750 DOUBLE PRECISION SD 00000760 C 00000770 C EXTERNAL S1ATP 00000780 C 00000781 COMMON /SYSTEM/SYSTEM, SYBYPW, SYLOCF, JAPNMS 00000782 C 00000790 C INITIALIZATION 00000800 C 00000810 C 00000820 IF (1 .EQ. 2) CALL S1ATP C IF (S1CPCH(SYSTEM, 1, 'CRAY', 1, 4) .EQ. 0) THEN 00000821 NDPW = 1 00000822 ELSE 00000824 NDPW = 2 00000825 ENDIF 00000827 C 00000828 CALL ARSET (Z, NDPW*LD, 0.) 00000831 CALL ARSET (X, NDPW*LD, 0.) 00000840 CALL ARSET (Z(LS+1), NDPW*LD, 0.) 00000850 CALL ARSET (X(LS+1), NDPW*LD, 0.) 00000860 SN = 0.0 00000870 SD = 0.0 00000880 KEY = 0 00000890 L = 1 00000900 MUM = NUM 00000910 IF (NUM*4+3 .GT. LD) MUM = (LD-3) / 4 00000920 MUMT = MUM * 2 00000930 MUMTP = MUMT + 1 00000940 ILAST = 0 00000950 I = 1 00000960 DA = 1 00000970 CALL USBUFR (0, IND, BUFV, DA, I) 00000980 K = IND(1) 00000990 GO TO (10, 50, 90), ISW 00001000 C 00001010 C 10 CASE 1: ISW = 1 00001020 10 SW = 0. 00001030 SYD = 0. 00001040 SY = 0. 00001050 SX = 0. 00001060 SX2 = 0. 00001070 20 CONTINUE 00001080 KK = IND(I) 00001090 IF (KK .NE. K) GO TO 30 00001100 ID2 = (I+NDPW-1)/NDPW 00001110 QQ(ID2) = Q(I) 00001120 C WEIGHTS SHOULD BE SQUARED BEFORE COMING TO THIS ROUTINE. 00001130 C W2 = W(I) * W(I) 00001140 W2 = W(I) 00001150 D1 = D(I) 00001160 TEMP = D1 * W2 00001170 SW = SW + W2 00001180 SYD = QQ(ID2) * TEMP + SYD 00001190 SY = QQ(ID2) * W2 + SY 00001200 SX = TEMP + SX 00001210 SX2 = D1 * TEMP + SX2 00001220 I = I + BUFV(4) 00001230 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00001240 + CALL USBUFR (4, IND, BUFV, DA, I) 00001250 ILAST = ILAST + 1 00001260 IF (ILAST .LT. NT) GO TO 20 00001270 C 00001280 KEY = 1 00001290 30 IF (SW .EQ. 0.) GO TO 40 00001300 K1 = K + LS 00001310 TEMP = SX / SW 00001320 Z(K) = SYD - SY * TEMP 00001330 Z(K1) = SX2 - SX * TEMP 00001340 X(K) = SY / SW 00001350 X(K1) = TEMP 00001360 40 CONTINUE 00001370 K = KK 00001380 L = I 00001390 IF (KEY .EQ. 0) GO TO 10 00001400 C 00001410 C FINISH CASE 1: ISW = 1 00001420 GO TO 115 00001430 C 00001440 C 50 CASE 2: ISW = 2 00001450 50 SW = 0. 00001460 SYD = 0. 00001470 SY = 0. 00001480 SX = 0. 00001490 SX2 = 0. 00001500 60 CONTINUE 00001510 KK = IND(I) 00001520 IF (KK .NE. K) GO TO 70 00001530 ID2 = (I+NDPW-1)/NDPW 00001540 QQ(ID2) = X(IND(I+1)) + X(IND(I+2)) 00001550 C WEIGHTS SHOULD BE SQUARED BEFORE COMING TO THIS ROUTINE. 00001560 C W2 = W(I) * W(I) 00001570 W2 = W(I) 00001580 D1 = D(I) 00001590 TEMP = D1 * W2 00001600 SW = SW + W2 00001610 SYD = QQ(ID2) * TEMP + SYD 00001620 SY = QQ(ID2) * W2 + SY 00001630 SX = TEMP + SX 00001640 SX2 = D1 * TEMP + SX2 00001650 I = I + BUFV(4) 00001660 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00001670 + CALL USBUFR (4, IND, BUFV, DA, I) 00001680 ILAST = ILAST + 1 00001690 IF (ILAST .LT. NT) GO TO 60 00001700 C 00001710 KEY = 1 00001720 70 IF (SW .EQ. 0.) GO TO 80 00001730 K1 = K + LS 00001740 TEMP = SX / SW 00001750 Z(K) = SYD - SY * TEMP 00001760 Z(K1) = SX2 - SX * TEMP 00001770 X(K) = SY / SW 00001780 X(K1) = TEMP 00001790 80 CONTINUE 00001800 K = KK 00001810 L = I 00001820 IF (KEY .EQ. 0) GO TO 50 00001830 C 00001840 C FINISH CASE 2: ISW = 2 00001850 GO TO 115 00001860 C 00001870 C 90 CASE 3: ISW = 3 00001880 90 SW = 0. 00001890 SYD = 0. 00001900 SY = 0. 00001910 SX = 0. 00001920 SX2 = 0. 00001930 100 CONTINUE 00001940 KK = IND(I) 00001950 IF (KK .NE. K) GO TO 105 00001960 ID2 = (I+NDPW-1)/NDPW 00001970 QQ(ID2) = XX(IND(I+1)) + XX(IND(I+2)) 00001980 C WEIGHTS SHOULD BE SQUARED BEFORE COMING TO THIS ROUTINE. 00001990 C W2 = W(I) * W(I) 00002000 W2 = W(I) 00002010 D1 = D(I) 00002020 TEMP = D1 * W2 00002030 SW = SW + W2 00002040 SYD = QQ(ID2) * TEMP + SYD 00002050 SY = QQ(ID2) * W2 + SY 00002060 SX = TEMP + SX 00002070 SX2 = D1 * TEMP + SX2 00002080 I = I + BUFV(4) 00002090 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00002100 + CALL USBUFR (4, IND, BUFV, DA, I) 00002110 ILAST = ILAST + 1 00002120 IF (ILAST .LT. NT) GO TO 100 00002130 C 00002140 KEY = 1 00002150 105 IF (SW .EQ. 0.) GO TO 110 00002160 K1 = K + LS 00002170 TEMP = SX / SW 00002180 Z(K) = SYD - SY * TEMP 00002190 Z(K1) = SX2 - SX * TEMP 00002200 X(K) = SY / SW 00002210 X(K1) = TEMP 00002220 110 CONTINUE 00002230 K = KK 00002240 L = I 00002250 IF (KEY .EQ. 0) GO TO 90 00002260 C 00002270 C FINISH CASE 3: ISW = 3 00002280 115 CALL USBUFR (-2, IND, BUFV, DA, I) 00002290 C 00002300 IF (MUMT .LE. 0) GO TO 125 00002310 DO 120 00002320 *I = 1, MUMT 00002330 SN = SN + Z(I) 00002340 120 SD = SD + Z(LS + I) 00002350 125 DO 130 00002360 *I = MUMTP, LD 00002370 I1 = I - MUM 00002380 I2 = I - MUMT 00002390 I3 = LS + I1 00002400 I4 = LS + I2 00002410 SN = SN + Z(I) 00002420 SD = SD + Z(LS+I) 00002430 B = 0. 00002440 IF (DABS(SD) .GT. 1.E-30) B = SN / SD 00002450 X(I1) = X(I1) - X(I3) * B 00002460 X(I3) = B 00002470 SN = SN - Z(I2) 00002480 130 SD = SD - Z(I4) 00002490 B = X(LS+MUM+1) 00002500 IF (MUM .LE. 0) GO TO 151 00002510 DO 140 00002520 *I = 1, MUM 00002530 I1 = I + LS 00002540 X(I) = X(I) - X(I1) * B 00002550 140 X(I1) = B 00002560 B = X(LS + LD - MUM) 00002570 K = LD - MUM + 1 00002580 DO 150 00002590 *I = K, LD 00002600 I1 = I + LS 00002610 X(I) = X(I) - X(I1) * B 00002620 X(I1) = B 00002630 150 CONTINUE 00002640 C 00002650 151 I = 1 00002660 DA = 1 00002670 CALL USBUFR (0, IND, BUFV, DA, I) 00002680 GO TO (160, 180, 200), ISW 00002690 C 00002700 C 160 CASE 1: ISW = 1 00002710 160 DO 170 00002720 *J= 1, NT 00002730 K = IND(I) 00002740 K1 = IND(I + 1) 00002750 K2 = IND(I + 2) 00002760 W2 = W(I) 00002770 ID2 = (I+NDPW-1)/NDPW 00002780 QQ(ID2) = (QQ(ID2) - X(K) - X(LS+K) * D(I)) * W2 00002790 Z(K1) = Z(K1) + QQ(ID2) 00002800 Z(K2) = Z(K2) + QQ(ID2) 00002810 I = I + BUFV(4) 00002820 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00002830 + CALL USBUFR (4, IND, BUFV, DA, I) 00002840 170 CONTINUE 00002850 C 00002860 C FINISH CASE 1: ISW = 1 00002870 GO TO 220 00002880 C 00002890 C 180 CASE 2: ISW = 2 00002900 180 DO 190 00002910 *J= 1, NT 00002920 K = IND(I) 00002930 W2 = W(I) 00002940 ID2 = (I+NDPW-1)/NDPW 00002950 QQ(ID2) = (QQ(ID2) - X(K) - X(LS+K) * D(I)) * W2 00002960 I = I + BUFV(4) 00002970 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00002980 + CALL USBUFR (4, IND, BUFV, DA, I) 00002990 190 CONTINUE 00003000 C 00003010 C FINISH CASE 2: ISW = 2 00003020 GO TO 220 00003030 C 00003040 C 200 CASE 3: ISW = 3 00003050 200 DO 210 00003060 *J= 1, NT 00003070 K = IND(I) 00003080 ID2 = (I+NDPW-1)/NDPW 00003090 QQ(ID2) = (QQ(ID2) - X(K) - X(LS+K) * D(I)) 00003100 I = I + BUFV(4) 00003110 IF ( ((I-1)/BUFV(7)*BUFV(7)+1) .EQ. I) 00003120 + CALL USBUFR (4, IND, BUFV, DA, I) 00003130 210 CONTINUE 00003140 C 00003150 C FINISH CASE 3: ISW = 3 00003160 220 CALL USBUFR (-2, IND, BUFV, DA, I) 00003170 RETURN 00003180 END 00003190