CTITLESAGCF2 -- READ CFS CARDS FOR SAGM3D - SECONDARY READ 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR K. GRAY 00000201 CA DESIGNER K. GRAY 00000301 CA LANGUAGE FORTRAN 00000401 CA SYSTEM IBM AND CRAY 00000501 CA WRITTEN 08-03-84 00000601 CA REVISED 03-15-85 RDK. DUAL CFT/VSFORTRAN VERSION. 00000701 CA REVISED 03-20-89 TJT. SINGLE SOURCE CODE FOR IBM AND CRAY. 00000801 CA 00000900 C 00001200 CA SUBROUTINE SAGCF2 ( STSPNO, SPNIBN, STFILE, ENFILE, SPADV, RVADV, 00001300 CA * CLDDEF, CLD, REFFLG, FSTAN, PERPOS, POSINC, INLNOS, INLINC, 00001400 CA * INKNTR , CARD ) 00001500 CA 00001600 CA 00001900 CA THIS SUBROUTINE IS CALLED BY SAGM3D TO READ AND PROCESS CFS 00002000 CA CARDS. 00002100 CA 00002300 CA 00002400 CA IN/OUT ARG TYPE LENGTH DESCRIPTION 00002500 CA 00002600 CA IN/OUT STSPNO I*4 1 STARTING SHOTPOINT 00002700 CA IN/OUT SPNIBN I*4 1 SHOTPOINT NUMBER INCREMENT 00002800 CA IN/OUT STFILE I*4 1 STARTING CONSECUTIVE FILE NUMBER 00002900 CA IN/OUT ENFILE I*4 1 ENDING CONSECUTIVE FILE NUMBER 00003000 CA IN/OUT SPADV R*4 1 SHOTPOINT ADVANCE 00003100 CA IN/OUT RVADV R*4 1 RECEIVER ADVANCE 00003200 CA IN/OUT CLDDEF I*4 1 NUMERIC ID FLAG, 0=NON-BLANK, 1=BLANK 00003300 CA IN/OUT CLD I*4 1 NUMERIC ID 00003400 CA IN/OUT REFFLG I*4 1 REC. STN NEAR SHOT FLAG,0=BLANK,1=NO 00003500 CA IN/OUT FSTAN R*4 1 RECEIVER STATION NEAREST SHOT FROM DF6 00003600 CA IN/OUT PERPOS R*4 1 PERPENDICULAR OFFSET 00003700 CA IN/OUT POSINC R*4 1 PERPENDICULAR OFFSET INCREMENT 00003800 CA IN/OUT INLNOS R*4 1 INLINE OFFSET 00003900 CA IN/OUT INLINC R*4 1 INLINE OFFSET INCREMENT 00004000 CA IN/OUT INKNTR R*4 1 RECEIVER ADVANCE DELAY 00004100 CA IN CARD I*4 20 BUFFER TO HOLD INPUT CARD 00004200 CA 00004400 C EJECT 00004500 C 00005000 SUBROUTINE SAGCF2 ( STSPNO, SPNIBN, STFILE, ENFILE, SPADV, RVADV, 00005100 * CLDDEF, CLD, REFFLG, FSTAN, PERPOS, POSINC, INLNOS, INLINC, 00005200 * INKNTR , CARD ) 00005300 C 00005500 IMPLICIT INTEGER (A - Z) 00005600 C 00005800 REAL SPADV 00005900 REAL RVADV 00006000 REAL FSTAN 00006100 REAL PERPOS 00006200 REAL POSINC 00006300 REAL INLNOS 00006400 REAL INLINC 00006500 C 00006800 CHARACTER*80 CARD 00006900 CHARACTER*5 BLNKC 00007000 C 00007100 DATA BLNKC / ' ' / 00007200 C 00007600 C STARTING SHOTPOINT NO. 00007700 STSPNO = S1CVBN (CARD, 11, 5) 00007800 C SHOTPOINT NO. INCREMENT 00007900 COUT IF (S1CPCH (CARD, 16, BLNKC, 1, 5) .NE. 0)SPNIBN = 00008000 IF ( CARD(16:20) .NE. BLNKC(1:5) )SPNIBN = 00008201 * S1CVBN(CARD, 16, 5) 00008300 C STARTING FILE NO. 00008400 STFILE = S1CVBN (CARD, 21, 5) 00008500 C ENDING FILE NO. 00008600 ENFILE = STFILE 00008700 COUT IF (S1CPCH (CARD, 26, BLNKC, 1, 5) .NE. 0)ENFILE = 00008800 IF ( CARD(26:30) .NE. BLNKC(1:5) )ENFILE = 00008901 * S1CVBN (CARD, 26, 5) 00009000 C 00009100 COUT IF (S1CPCH (CARD, 31, BLNKC, 1, 5) .NE. 0) 00009200 IF ( CARD(31:35) .NE. BLNKC(1:5) ) 00009301 * CALL USCHFT (CARD, 31, 5,SPADV) 00009400 C 00009500 COUT IF (S1CPCH (CARD, 36, BLNKC, 1, 5) .NE. 0) 00009600 IF ( CARD(36:40) .NE. BLNKC(1:5) ) 00009701 * CALL USCHFT (CARD, 36, 5, RVADV) 00009800 C 00009900 CLDDEF = 0 00010000 COUT IF (S1CPCH (CARD, 41, BLNKC, 1, 5) .EQ. 0) CLDDEF = 1 00010100 IF ( CARD(41:45) .EQ. BLNKC(1:5) ) CLDDEF = 1 00010201 C 00010300 COUT IF (S1CPCH (CARD, 41, BLNKC, 1, 5) .NE. 0)CLD = 00010400 IF ( CARD(41:45) .NE. BLNKC(1:5) )CLD = 00010501 * S1CVBN (CARD, 41, 5) 00010600 C 00010700 REFFLG = 0 00010800 COUT IF (S1CPCH (CARD, 46, BLNKC, 1, 5) .NE. 0)REFFLG = 1 00010900 COUT IF (S1CPCH (CARD, 46, BLNKC, 1, 5) .NE. 0)FSTAN = 00011000 IF ( CARD(46:50) .NE. BLNKC(1:5) )REFFLG = 1 00011101 IF ( CARD(46:50) .NE. BLNKC(1:5) )FSTAN = 00011201 * S1CVBN (CARD, 46, 5) 00011300 C 00011400 C 00011500 COUT IF (S1CPCH (CARD, 51, BLNKC, 1, 5) .NE. 0) 00011600 IF ( CARD(51:55) .NE. BLNKC(1:5) ) 00011701 * CALL USCHFT(CARD, 51, 5, PERPOS) 00011800 C 00011900 COUT IF (S1CPCH (CARD, 56, BLNKC, 1, 5) .NE. 0) 00012000 IF ( CARD(56:60) .NE. BLNKC(1:5) ) 00012101 * POSINC = S1CVBN (CARD, 56, 5) 00012200 C * CALL USCHFT (CARD, 56, 5, POSINC) 00012300 C 00012400 COUT IF (S1CPCH (CARD, 61, BLNKC, 1, 5) .NE. 0) 00012500 IF ( CARD(61:65) .NE. BLNKC(1:5) ) 00012601 * CALL USCHFT (CARD, 61, 5, INLNOS) 00012700 C 00012900 COUT IF (S1CPCH (CARD, 66, BLNKC, 1, 5) .NE. 0) 00013000 IF ( CARD(66:70) .NE. BLNKC(1:5) ) 00013101 * INLINC = S1CVBN (CARD, 66, 5) 00013200 C * CALL USCHFT (CARD, 66, 5, INLINC) 00013300 C 00013400 INKNTR = 1 00013500 COUT IF (S1CPCH (CARD, 76, BLNKC, 1, 5) .NE. 0)INKNTR = 00013600 IF ( CARD(76:80) .NE. BLNKC(1:5) )INKNTR = 00013701 * S1CVBN (CARD, 76, 5) 00013800 C 00013900 C 00014001 RETURN 00014300 END 00014700