CTITLEUSSLN -- SEARCH FOR SHOTPOINT LOCATION NUMBER 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR RALPH E. MCMILLAN 00030000 CA DESIGNER RALPH E. MCMILLAN 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 03/24/76 00070000 C REVISED 05-09-83 PKC. ADDED CHECK FOR MAX. SHOTPOINT. 00080000 C REVISED 3-08-84 FAC. TRCHDR ARRAY SIZE INCREASED TO 190. 00090000 C REVISED 7-10-84 GRAY - DYNAMICALLY ALLOCATED THE NEEDED ARRAYS 00100000 C BY USING BLANK COMMON SPACE. 00110000 C REVISED 6-03-85 RDK. DUAL IBM/CRAY SOURCE CODE. 00120000 C REVISED 07-12-85 DCB. MODIFIED CODE NOT TO REQUIRE GM3D IN PRO- 00130000 C CESSING SEQUENCE, IF PROCESSING MODE IS 00140000 C 'S' AND ONLY ONE RANGE CARD IS PRESENT. 00150000 C INSTEAD OF RETURNING A SHOTPOINT LOCATION 00160000 C FROM A GM3D TRACE HEADER FOR SHOTPOINT 00170000 C 'SPNO', THE ARGUMENT 'VALUE' IS SET TO 00180000 C 'SPNO' * 100 AND RETURNED. 00190000 C REVISED 07-19-85 DCB. ADDED LOGIC TO REQUIRE GM3D FOR PROCESS 00200000 C DATM, REGARDLESS OF THE NUMBER OF RANGE 00210000 C CARDS PRESENT FOR THE PROCESS. 00220000 C REVISED 07-30-85 DCB. ADDED LOGIC TO USE GM3D TRACE HEADER IN- 00230000 C FORMATION, IF GM3D IS IN PROCESSING SE- 00240000 C QUENCE. ADDED LOGIC TO REQUIRE GM3D FOR 00250000 C PROCESS EDIT. 00260000 C REVISED 02-13-87 MJM. CHECK FOR EXISTANCE OF GM3DPARM FILE 00270000 C INSTEAD OF FOR GM3D IN PROC CARD TO 00280000 C EASE THE USE OF FSPREP. 00290000 C REVISED 01-19-89 LWC. ADDED LOGIC TO REQUIRE GM3D FOR PROCESS 00300000 C HZAA, REGARDLESS OF THE NUMBER OF RANGE 00310000 C CARDS PRESENT FOR THE PROCESS. 00320000 C REVISED 03-02-89 ESN. IF MODE IS BLANK ON 'KPNA' CARD, 00330000 C DEFAULT TO LINE CARD. 00340000 CA 00350000 CA 00360000 CA CALL USSLN (SPNO, LCTPSP, VALUE, &STMT) 00370000 CA INPUT SPNO = SHOTPOINT NUMBER I4 00380000 CA INPUT LCTPSP = NUMBER OF TRACES PER SHOTPOINT I4 00390000 CA OUTPUT VALUE = SHOTPOINT LOCATION NUMBER I4 00400000 CA STMT = ERROR RETURN 00410000 CA 00420000 CA 00430000 CA USSLN RETURNS A LINE LOCATION NUMBER FOR A GIVEN SHOTPOINT 00440000 CA NUMBER. 00450000 CA 00460000 C 00470000 C 00480000 C 00490000 C LOCAL ARRAYS 00500000 C SP (MAXSPS) = ARRAY TO HOLD SHOTPOINT NUMBERS I4 00510000 C SPLOC (MAXSPS) = ARRAY TO HOLD SHOTPOINT LOCATIONS I4 00520000 C TRCHDR ( 190) = TRACE HEADER ARRAY I4 00530000 C 00540000 C THE ARRAYS SP AND SPLOC NOW REFER TO ADDRESSES WITHIN BLANK 00550000 C COMMON. THE ARRAY LENGTHS ARE MAXSPS = LCNSP (NUMBER OF SHOTPOINTS 00560000 C FROM THE LINE CARD. 00570000 C 00580000 C 00590000 C EJECT 00600000 SUBROUTINE USSLN (SPNO, LCTPSP, VALUE, *) 00610000 C 00620000 IMPLICIT INTEGER (A-Z) 00630000 C 00640000 C REAL ARRAYS IN PARAMETER LIST. 00650000 C 00660000 C INTEGER ARRAYS IN PARAMETER LIST. 00670000 C 00680000 C INTEGER ARRAYS -- LOCAL (NOW BLANK COMMON STORAGE USED) 00690000 C 00700000 CKG INTEGER SP (MAXSPS) 00710000 CKG INTEGER SPLOC (MAXSPS) 00720000 C 00730000 INTEGER TRCHDR ( 190) 00740000 INTEGER CARD ( 20) 00750000 INTEGER LINCRD ( 20) 00760000 C 00770000 C CHARACTER VARIABLES AND CONSTANTS 00780000 C 00790000 CHARACTER*8 GMTEST,GMNAME 00800000 C 00810000 C REAL VARIABLES AND CONSTANTS 00820000 C 00830000 C INTEGER VARIABLES AND CONSTANTS 00840000 C 00850000 INTEGER KDFCF 00860000 C 00870000 C 00880000 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 00890000 C 00900000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 7/09/84 00910000 COMMON /P/ STARTP ( 2) , M00000( 9) 00920000 COMMON /P/ LCNSP , M00044( 92) 00930000 COMMON /P/ KPNA 00940000 COMMON /P/ KPRNO 00950000 COMMON /P/ KPOCUR , M00424( 11) 00960000 COMMON /P/ KPIRSM 00970000 COMMON /P/ KPNRSM 00980000 COMMON /P/ KPIUSM 00990000 COMMON /P/ KPNUSM , M00484 01000000 COMMON /P/ KPRTF , M00492( 11) 01010000 COMMON /P/ KPBUGF , M00540( 226) 01020000 COMMON /P/ ENDP 01030000 C 01040000 C BLANK COMMON WILL BE USED TO DYNAMICALLY ALLOCATE NEEDED ARRAYS 01050000 C 01060000 COMMON COM(1) 01070000 C 01080000 C INITIALIZATION 01090000 C 01100000 DATA TRCHDR /190*0/ 01110000 DATA KDFCF /1/ 01120000 DATA GMNAME /'GM3DPARM'/ 01130000 DATA ICRAY /'CRAY'/ 01140000 C 01150000 C 01160000 C================================================================= 01170000 C 01180000 C 01190000 C DYNAMICALLY ALLOCATE THE REQUIRED ARRAYS WITHIN BLANK COMMON 01200000 C 01210000 C KPIUSM - FORTRAN INDEX TO THE FIRST WORD OF UNRESERVED BLANK COMMON 01220000 C KPNUSM - NUMBER OF WORDS AVAILABLE IN BLANK COMMON 01230000 C 01240000 C 01250000 C INITIALIZATION 01260000 C 01270000 C IF GM3DPARM IS ALLOCATED, THEN USE GM3D TRACE HEADER INFORMATION (IBM)01280000 C IF GM3D IS IN PROC CARD, THEN USE GM3D TRACE HEADER INFORMATION (CRAY)01290000 C 01300000 C 01310000 IF (SYSTEM .EQ. ICRAY) THEN 01320000 CALL JSPAC1 (KPNA, KPRNO, KPOCUR, 'GM3D', SKPRNO) 01330000 IF (SKPRNO .GE. 0) GO TO 300 01340000 ELSE 01350000 GMTEST = GMNAME 01360000 CALL CKDD (GMTEST) 01370000 IF (S1CPCH(GMTEST,1,'MISSING',1,7) .NE. 0) GO TO 300 01380000 END IF 01390000 C 01400000 C IF PROCESSING MODE IS 'S' AND ONLY ONE RANGE CARD IS PRESENT, THEN 01410000 C GM3D IS NOT REQUIRED IN PROCESSING SEQUENCE. 01420000 C 01430000 DA = 1 01440000 NOC = 0 01450000 CALL FORC (KPNA, KPRNO, DA, CARD, *70) 01460000 DA = 1 01470000 IF (S1CPCH(CARD,7,' ',1,1) .EQ. 0) THEN 01480000 CALL FORC ('LINE', 0, DA, LINCRD, *70) 01490000 CALL S1MVCH (LINCRD, 7, CARD, 7, 1) 01500000 DA = 1 01510000 ENDIF 01520000 IF (S1CPCH(CARD,7,'S',1,1) .EQ. 0) THEN 01530000 C 01540000 C THE FOLLOWING PROCESSES ARE EXCEPTIONS. GM3D IS ALWAYS REQUIRED FOR 01550000 C THEM, REGARDLESS OF THE NUMBER OF RANGE CARDS PRESENT FOR THE PROCESS.01560000 C 01570000 IF (S1CPCH(KPNA,1,'DATM',1,4) .EQ. 0) GO TO 300 01580000 IF (S1CPCH(KPNA,1,'EDIT',1,4) .EQ. 0) GO TO 300 01590000 IF (S1CPCH(KPNA,1,'HZAA',1,4) .EQ. 0) GO TO 300 01600000 C 01610000 100 CALL FORC (KPNA, KPRNO, DA, CARD, *200) 01620000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 100 01630000 NOC = NOC + 1 01640000 GO TO 100 01650000 200 IF (NOC .EQ. 1) THEN 01660000 VALUE = SPNO * 100 01670000 RETURN 01680000 END IF 01690000 END IF 01700000 C 01710000 300 IF (KDFCF .EQ. 0) GO TO 40 01720000 KDFCF = 0 01730000 C 01740000 MAXSPS = LCNSP 01750000 C 01760000 C 01770000 C ESTABLISH POINTERS TO START OF ARRAYS 01780000 C 01790000 C ARRAY 01800000 IC1 = KPIUSM 01810000 C SP 01820000 C 01830000 IC2 = IC1 + MAXSPS 01840000 C SPLOC 01850000 C 01860000 C 01870000 C 01880000 C ICM1, ICM2 --- POINT TO THE LAST WORD OF THE PREV ARRAY 01890000 C 01900000 ICM1 = IC1 - 1 01910000 ICM2 = IC2 - 1 01920000 C 01930000 NWORDS = MAXSPS * 2 01940000 C 01950000 C 01960000 CALL UPRESM (NWORDS) 01970000 IF (NWORDS .EQ. 0) GO TO 2000 01980000 C 01990000 CKG IZ1 = LOC(COM(IC1) ) 02000000 CKG IZ2 = LOC(COM(IC2) ) 02010000 C 02020000 CKG WRITE (6,99001) NWORDS, IC1,IC2,MAXSPS,KPIUSM,IZ1,IZ2 02030000 C9001 FORMAT(/////,' NWORDS, IC1,IC2,MAXSPS,KPIUSM,IZ1,IZ2 ' ,7I9) 02040000 C 02050000 C 02060000 C 02070000 C-----------------------------------------------------------------------02080000 C 02090000 C 02100000 DA = 1 02110000 CALL USRHDR (TRCHDR, DA, *20) 02120000 CALL USRTHV (TRCHDR, 'THNSSP ', NSSP) 02130000 IF (NSSP .GT. MAXSPS) GO TO 60 02140000 C 02150000 C READ THE TRACE HEADERS TO BUILD THE LOCATION TABLE 02160000 C 02170000 DA = 1 02180000 N = 1 02190000 CKG SP(1) = -999999 02200000 COM(ICM1 + 1) = -999999 02210000 C 02220000 10 CALL USRHDR (TRCHDR, DA, *20) 02230000 CKG CALL USRTHV (TRCHDR, 'THSSP ', SP(N)) 02240000 CKG CALL USRTHV (TRCHDR, 'THSLN ', SPLOC(N)) 02250000 C 02260000 CALL USRTHV (TRCHDR, 'THSSP ', COM(ICM1 + N) ) 02270000 CALL USRTHV (TRCHDR, 'THSLN ', COM(ICM2 + N) ) 02280000 C 02290000 DA = DA + LCTPSP - 1 02300000 N = N + 1 02310000 GO TO 10 02320000 C 02330000 20 TNSP = N - 1 02340000 N = 1 02350000 CN = 1 02360000 C 02370000 C WRITE (6,9005) 02380000 C9005 FORMAT(10X, ' USSLN DUMP') 02390000 C WRITE (6,9010) (COM(ICM1+JJJ),COM(ICM2+JJJ),JJJ=1,TNSP) 02400000 C9010 FORMAT(10X, 2I10) 02410000 C 02420000 GO TO 40 02430000 C 02440000 C INCREMENT THE POINTER AND COMPARE AGAINST THE STARTING 02450000 C POINT 02460000 C 02470000 30 N = N + 1 02480000 IF (N .EQ. CN) RETURN1 02490000 C 02500000 40 IF (NSSP .GT. MAXSPS) GO TO 60 02510000 C 02520000 CKG IF (SPNO .EQ. SP(N)) GO TO 50 02530000 IF (SPNO .EQ. COM(ICM1 + N) ) GO TO 50 02540000 C 02550000 IF (N .LT. TNSP) GO TO 30 02560000 N = 0 02570000 GO TO 30 02580000 C 02590000 C RETURN SHOTPOINT LOCATION 02600000 C 02610000 50 CONTINUE 02620000 C 02630000 CKG VALUE = SPLOC(N) 02640000 VALUE = COM(ICM2 + N) 02650000 C 02660000 CN = N 02670000 RETURN 02680000 C 02690000 60 WRITE (6, 9000 ) MAXSPS, NSSP 02700000 9000 FORMAT ('0 *** MAXIMUM NUMBER OF SHOTPOINTS CANNOT EXCEED ', 02710000 * I7, ' ***',/4X,'*** NUMBER OF SHOTPOINTS FROM GEOMTRY IS ', 02720000 * I7,' ***') 02730000 RETURN1 02740000 C 02750000 70 WRITE (6, 1000) KPNA, KPRNO 02760000 1000 FORMAT ('0*** CARDS MISSING FOR ',A4,I1,' ***') 02770000 KPRTF = -1 02780000 RETURN 02790000 C 02800000 C 02810000 C 02820000 2000 WRITE (6, 9100) 02830000 C 02840000 9100 FORMAT ( /, ' *** NOT ENOUGH MEMORY AVAILABLE - USSLN *** ',//) 02850000 C 02860000 KPRTF = -1 02870000 C 02880000 RETURN 02890000 C 02900000 CKG DEBUG UNIT(6),INIT 02910000 C 02920000 END 02930000