CTITLEMODNDX -- FIND GREATEST COMMON DIVISOR OF SHOT & RECVR IN IND 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 3/15/76 00060000 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00070000 C REVISED 08-13-85 REP. ADD CALLS TO USBFRX (NAME CHANGE FROM 00080000 C MODIND) 00090000 C REVISED 08-14-85 REP. CHANGE NAME FROM MODIN3. 00100000 CA 00110000 CA CALL MODNDX (IND, NT, KR, KS) 00120000 CA 00130000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00140000 CA 00150000 CA IN IND I4 ARRAY TO FIND GREATEST COMMON DIVISORS 00160000 CA IN NT I4 NUMBER OF ELEMENTS IN IND 00170000 CA OUT KR I4 RECEIVER INCREMENT 00180000 CA OUT KS I4 SHOT INCREMENT 00190000 CA 00200000 CA MODNDX FINDS THE GREATEST COMMON DIVISOR OF BOTH THE RECEIVER 00210000 CA AND SHOT ELEMENTS OF THE IND ARRAY SO THAT THE INDEX ARRAY CAN 00220000 CA BE REINDEXED SO AS TO USE AS LITTLE SPACE AS POSSIBLE FOR THE 00230000 CA CONJUGATE GRADIENT SOLUTION ARRAY. 00240000 C 00250000 SUBROUTINE MODNDX (IND, NT, KR, KS) 00260000 C 00270000 COMMON COM (1) 00280000 INTEGER COM 00290002 REAL XCOM (1) 00300001 REAL*8 ZCOM (1) 00310000 EQUIVALENCE (COM(1),XCOM(1),ZCOM(1)) 00320000 C 00330000 C COMMON BUFFERING INFORMATION BLOCK 00340000 C 00350000 COMMON /BFINFO/ BYND(15), BIND(15), BOFF(15), BQND(15) 00360000 C 00370000 INTEGER BYND, BIND, BOFF, BQND 00380000 C 00390000 C 00400000 C INTEGER ARRAY IN PARAMETER LIST 00410000 C 00420000 INTEGER IND (2,1) 00430000 C 00440000 C INTEGER VARIABLES LOCAL 00450000 C 00460000 INTEGER B 00470000 C 00480000 C FIND 2 DIFFERENT RECEIVER NUMBERS 00490000 C 00500000 J = 2 00510000 IF (BIND(12) .EQ. 0) THEN 00520000 CALL USBFRX (IND, 1, B, 0, BIND) 00530000 JR1 = IND(1,B) 00540000 ELSE 00550000 JR1 = COM(BIND(12)) 00560000 ENDIF 00570000 10 CONTINUE 00580000 IF (BIND(12) .EQ. 0) THEN 00590000 CALL USBFRX (IND, J, B, 0, BIND) 00600000 JR2 = IND(1,B) 00610000 ELSE 00620000 JR2 = COM(BIND(12)+2*J-2) 00630000 ENDIF 00640000 J = J + 1 00650000 IF (JR2 .EQ. JR1) GO TO 10 00660000 C 00670000 C FIND TWO DIFFERENT SHOT NUMBERS 00680000 C 00690000 J = 2 00700000 IF (BIND(12) .EQ. 0) THEN 00710000 CALL USBFRX (IND, 1, B, 0, BIND) 00720000 JS1 = IND(2,B) 00730000 ELSE 00740000 JS1 = COM(BIND(12)+1) 00750000 ENDIF 00760000 20 CONTINUE 00770000 IF (BIND(12) .EQ. 0) THEN 00780000 CALL USBFRX (IND, J, B, 0, BIND) 00790000 JS2 = IND(2,B) 00800000 ELSE 00810000 JS2 = COM(BIND(12)+2*J-1) 00820000 ENDIF 00830000 J = J + 1 00840000 IF (JS2 .EQ. JS1) GO TO 20 00850000 C 00860000 C MINR = DIFFERENCE BETWEEN TWO RECEIVER NUMBERS 00870000 C MINS = DIFFERENCE BETWEEN TWO SHOT NUMBERS 00880000 C 00890000 MINR = IABS(JR2 - JR1) 00900000 MINS = IABS(JS2 - JS1) 00910000 C 00920000 C FIND RECEIVER INCREMENT 00930000 C 00940000 C RECEIVER INCREMENT MUST BE LESS THAN OR EQUAL TOMINR 00950000 C AND MINR MUST BE A MULTIPLE OF RECEIVER INC. 00960000 C 00970000 LM = MINR - 1 00980000 IF (LM .LE. 0) GO TO 50 00990000 DO 40 I = 1, LM 01000000 MM = MINR / I 01010000 IF ((MINR / MM) * MM .NE. MINR) GO TO 40 01020000 MA = MOD(JR1, MM) 01030000 C 01040000 C MM IS A DIVISOR OF MINR IS IT THE GREATEST COMMON 01050000 C DIVISOR OF ALL RECEIVER NUMBERS? 01060000 C 01070000 IF (BIND(12) .EQ. 0) THEN 01080000 DO 30 J = 1, NT 01090000 CALL USBFRX (IND, J, B, 0, BIND) 01100000 INDEX = IND(1,B) 01110000 IF (MA .NE. MOD(INDEX, MM)) GO TO 40 01120000 30 CONTINUE 01130000 ELSE 01140000 DO 35 J = 1, NT 01150000 INDEX = COM(BIND(12)+2*J-2) 01160000 IF (MA .NE. MOD(INDEX, MM)) GO TO 40 01170000 35 CONTINUE 01180000 ENDIF 01190000 C 01200000 GO TO 60 01210000 C 01220000 40 CONTINUE 01230000 C 01240000 50 KR = 1 01250000 C 01260000 GO TO 100 01270000 C 01280000 60 KR = MM 01290000 C 01300000 C FIND SHOT INCREMENT 01310000 C 01320000 C SHOT INCREMENTS MUST BE LESS THAN OR EQUAL TOMINS 01330000 C AND MINS MUST BE A MULTIPLE OF SHOT INCREMENT 01340000 C 01350000 100 LM = MINS - 1 01360000 IF (LM .LE. 0) GO TO 130 01370000 C 01380000 DO 120 I = 1, LM 01390000 MM = MINS / I 01400000 IF ((MINS / MM) * MM .NE. MINS) GO TO 120 01410000 MA = MOD(JS1, MM) 01420000 C 01430000 C MM IS A DIVISOR OF MINS IS IT THE GREATEST COMMON 01440000 C DIVISOR OF ALL SHOT NUMBERS? 01450000 C 01460000 IF (BIND(12) .EQ. 0) THEN 01470000 DO 110 J = 1, NT 01480000 CALL USBFRX (IND, J, B, 0, BIND) 01490000 INDEX = IND(2,B) 01500000 IF (MA .NE. MOD(INDEX, MM)) GO TO 120 01510000 110 CONTINUE 01520000 ELSE 01530000 DO 115 J = 1, NT 01540000 INDEX = COM(BIND(12)+2*J-1) 01550000 IF (MA .NE. MOD(INDEX, MM)) GO TO 120 01560000 115 CONTINUE 01570000 ENDIF 01580000 C 01590000 GO TO 140 01600000 C 01610000 120 CONTINUE 01620000 C 01630000 130 KS = 1 01640000 RETURN 01650000 01660000 140 KS = MM 01670000 RETURN 01680000 END 01690000