CTITLESPNAVC -- DETERMINE NAVIGATION SHOTPOINT 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA AUTHOR STU NELAN 00030000 CA DESIGNER STU NELAN 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 10/25/90 00070000 C REVISED MM/DD/YY III ... 00080000 CA 00090000 CA 00100000 CA CALL SPNAVC (NO PARAMETERS) 00110000 CA 00120000 CA 00130000 CA THIS PREPARATION ROUTINE SCRUTINIZES USER INPUT DATA CARDS 00140000 CA FOR POSSIBLE ERRORS. IF NO ERRORS ARE FOUND, THE PARAMETERS 00150000 CA LISTED ON THE INPUT CARDS ARE USED TO DEVELOP PROCESSING 00160000 CA PARAMETERS FOR USE BY THIS PREPARATION ROUTINE'S 00170000 CA CORRESPONDING PROCESSOR. THESE PARAMETERS ARE STORED ON 00180000 CA DISK FOR ACCESS AT PROCESSING TIME. 00190000 C 00200000 C=======================================================================00210000 C EJECT 00220000 C=======================================================================00230000 C 00240000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 00250000 C 00260000 C DATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA I4 00270000 C DENTRY ( 104) = ARRAY FOR STORAGE OF LOCAL PARAMETERS I4 00280000 C 00290000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00300000 C 00310000 C BLNK = CHARACTER STRING " " CH4 00320000 C CARD = ARRAY TO HOLD 80-CHAR. CARD INPUT DATA CH80 00330000 C DAC = COUNTER FOR CARD READ SUBROUTINE I4 00340000 C DAP = COUNTER FOR PARAMETER READ & WRITE SUBROUTINES I4 00350000 C DCTYP = PARAMETER RECORD TYPE CH4 00360000 C DEPTHP = CHARACTER STRING "DEPTH PT" CH8 00370000 C GATH = PROCESS MODE I4 00380000 C L1 = MINIMUM LINE NUMBER I4 00390000 C L2 = MAXIMUM LINE NUMBER I4 00400000 C NOC = NUMBER OF CARDS READ I4 00410000 C NOPAR = NUMBER OF PARAMETERS I4 00420000 C NOREC = NUMBER OF RECORDS I4 00430000 C PMODE = PROCESSING MODE I4 00440000 C PTS = CHARACTER STRING " PTS" CH4 00450000 C R1 = STARTING SHOTPOINT, DP, FILE I4 00460000 C R2 = ENDING SHOTPOINT, DP, FILE I4 00470000 C SPLOCN = SHOTPOINT LOCATION I4 00480000 C SPT = STARTING SHOTPOINT OR DEPTH POINT I4 00490000 C TYPPNT = CHARACTER STRING OF PROCESSING MODE CH8 00500000 C 00510000 C=======================================================================00520000 C EJECT 00530000 C=======================================================================00540000 C 00550000 CU PROCESS NAVC -- DETERMINE NAVIGATION SHOTPOINT 00560000 CU DATA CARD (1) -- DEFINES PROCESSING RANGE AND PARAMETERS 00570000 CU 00580000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 00590000 CU 00600000 CU REQ OR OPT 00610000 CU DF COLS DEFINITION OR DEFAULT 00620000 CU -- ----- ---------- -----------00630000 CU 1 1- 4 'NAVC' | REQ |00640002 CU 2 - 5 PROCESS NUMBER | 0 |00650002 CU 3 - 6 NOT USED | |00660002 CU 4 - 7 PROCESSING MODE |LINE CARD|00670002 CU 'D' = DEPTH POINT MODE | |00680002 CU 5 8-10 FOR PROGRAMMING USE | |00690002 CU 6 11-15 BEGINNING DEPTH POINT | REQ |00700002 CU 7 16-20 ENDING DEPTH POINT | REQ |00710002 CU 8 21-25 ANTENNA TO GUN DISTANCE | REQ |00720002 CU 9 26-30 CDP INTERVAL |NOTE DF9 |00730002 CU 31-80 NOT USED | |00740002 CU -----------00750000 CU 00760000 CU DF NOTES 00770000 CU -- ----- 00780000 CU 00790000 CU THIS PROCESS CALCULATES THE ANTENNA SHOTPOINT POSITION FOR 00800000 CU STACKED DATA BY MOVING THE SHOT NEAREST THE DEPTH POINT (THDPNS) 00810000 CU BY THE NUMBER OF DEPTH POINTS DEFINED BY (DF8/DF9) AND STORED IN 00820000 CU THE TRACE HEADER ATTRIBUTE 'THANSP'. 00830000 CU 00840000 CU 8 A POSITIVE VALUE WILL MOVE THE SHOT POINT NUMBER TOWARDS THE 00850000 CU HIGHER NUMBERED DEPTH POINTS. 00860001 CU FLOATING POINT VALUE IS OKAY. 00870001 CU 00880000 CU 9 DEFAULT IS TRACE HEADER VALUE. IF VALUE NOT PRESENT IN TRACE 00890000 CU HEADER, DEFAULT IS ONE-HALF THE LINE CARD GROUP SPACING. A 00900000 CU CODED VALUE FOR DF9 OVERRIDES BOTH TRACE HEADER AND LINE CARD. 00910000 CU FLOATING POINT VALUE IS OKAY. 00920000 CUEND 00930000 C 00940000 C EJECT 00950000 C ===================================================================== 00960000 C FORMAT OF OUTPUT PARAMETER RECORDS 00970000 C 00980000 C ****** FIRST RECORD ****** PROCESSING RANGES ****** 00990000 C 01000000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01010000 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 01020002 C | NAVC | INVOC. | PTS | NOT | LRANG | # OF |N|P| NOT | NOT | 01030002 C |_______|_NUMBER_|_______|__USED_|_______|_PARMS_|_|M|_USED|__USED_| 01040002 C 01050000 C WORD 9 WORD 10 WORD 11 WORD 12 01060000 C |_______|________|_______|_______| 01070002 C | MIN | MAX |ANT TO | CDP | 01080002 C |___DP__|___DP___|GUN_DIS|_INTV__| 01090002 C 01100000 C WORD 13 WORD 104 01110000 C |_______| ..... |_______| 01120002 C | NOT | ..... | NOT | 01130002 C |_USED__| ..... |_USED__| 01140002 C 01150000 C ==================================================================== 01160000 C EJECT 01170000 C 01180000 SUBROUTINE SPNAVC 01190000 C 01200000 IMPLICIT INTEGER (A-Z) 01210000 C...TRANSLATED BY FPP 2.26B16 11/02/90 12:12:54 01220000 C...SWITCHES: OPTOFF=CVY,TDYON=TDYON=RENUMB=100:10,FORMAT=9000:10,CONC 01230000 C...SWITCHES: CHR=+,TDYON=BFJORSTV,TDYOFF=MY 01240000 C************************************************************** 01250000 C * 01260000 C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * 01270000 C * 01280000 C USPHD ARSET FORC S1CPCH S1MVCH S1CVBN * 01290000 C USCHFT FOWP FORP * 01300000 C * 01310000 C************************************************************** 01320000 C 01330000 C COMMON /P/ STATEMENTS GENERATED BY DCN 12/09/83 01340000 COMMON /P/ STARTP ( 2) 01350000 COMMON /P/ LCNAME 01360000 COMMON /P/ LC5 01370000 COMMON /P/ LCINT 01380000 COMMON /P/ LCTYP 01390000 COMMON /P/ LC10 01400000 COMMON /P/ LCBGSP 01410000 COMMON /P/ LCENSP 01420000 COMMON /P/ LC2130 ( 2) 01430000 COMMON /P/ LCNSP 01440000 COMMON /P/ LCTPSP 01450000 COMMON /P/ LCRL 01460000 COMMON /P/ LCSI 01470000 COMMON /P/ LCPI 01480000 COMMON /P/ LCGRPI 01490000 COMMON /P/ LCMXFD 01500000 COMMON /P/ LCANSP 01510000 COMMON /P/ LCMXLN 01520000 COMMON /P/ LCDRYF 01530000 COMMON /P/ LCWD20 ( 3) 01540000 COMMON /P/ ACNAME 01550000 COMMON /P/ AC0506 01560000 COMMON /P/ AC64BC 01570000 COMMON /P/ ACOPCD 01580000 COMMON /P/ ACQCF 01590000 COMMON /P/ ACDIST 01600000 COMMON /P/ ACPROJ 01610000 COMMON /P/ ACLNAM ( 5) 01620000 COMMON /P/ ACCOM ( 8) 01630000 COMMON /P/ AC7274 01640000 COMMON /P/ ACTYPE 01650000 COMMON /P/ ACNSP 01660000 COMMON /P/ ACUSER ( 5) 01670000 COMMON /P/ M00188 ( 52) 01680000 COMMON /P/ KPNA 01690000 COMMON /P/ KPRNO 01700000 COMMON /P/ KPOCUR 01710000 COMMON /P/ KPA 01720000 COMMON /P/ KPDBGS 01730000 COMMON /P/ KPDBGA 01740000 COMMON /P/ KPDBGN 01750000 COMMON /P/ KPWRKS 01760000 COMMON /P/ KPWRKD 01770000 COMMON /P/ KPWKS2 01780000 COMMON /P/ KPWKD2 01790000 COMMON /P/ KPWKS3 01800000 COMMON /P/ KPWKD3 01810000 COMMON /P/ KPFCF 01820000 COMMON /P/ KPIRSM 01830000 COMMON /P/ KPNRSM 01840000 COMMON /P/ KPIUSM 01850000 COMMON /P/ KPNUSM 01860000 COMMON /P/ KPTIME 01870000 COMMON /P/ KPRTF 01880000 COMMON /P/ KPDRTF 01890000 COMMON /P/ KPMOTF 01900000 COMMON /P/ KPNBR 01910000 COMMON /P/ KPIBN 01920000 COMMON /P/ KPITSV 01930000 COMMON /P/ KPTAMF 01940000 COMMON /P/ KPLOTF 01950000 COMMON /P/ KPMITF 01960000 COMMON /P/ KPPRNT 01970000 COMMON /P/ KPPLOT 01980000 COMMON /P/ KPPLTA 01990000 COMMON /P/ KPBUGF 02000000 COMMON /P/ KPWARN 02010000 COMMON /P/ M00544 (169) 02020000 COMMON /P/ APUNN1 02030000 COMMON /P/ APUNN2 02040000 COMMON /P/ APUNN3 02050000 COMMON /P/ APUNN4 02060000 COMMON /P/ APUNN5 02070000 COMMON /P/ APUNN6 02080000 COMMON /P/ APUNN7 02090000 COMMON /P/ APREG1 02100000 COMMON /P/ APREG2 02110000 COMMON /P/ APREG3 02120000 COMMON /P/ APREG4 02130000 COMMON /P/ APREG5 02140000 COMMON /P/ APREG6 02150000 COMMON /P/ APREG7 02160000 COMMON /P/ M01276 ( 42) 02170000 COMMON /P/ ENDP 02180000 C 02190000 C=================================================================== 02200000 C 02210000 C REAL ARRAYS--LOCAL 02220000 C 02230000 REAL XATTR ( 96) 02240000 C 02250000 C=================================================================== 02260000 C 02270000 C INTEGER ARRAYS--LOCAL 02280000 C 02290000 INTEGER DATTR ( 96) 02300000 INTEGER DENTRY (104) 02310000 INTEGER LRANG 02320000 C 02330000 C=================================================================== 02340000 C 02350000 C DENTRY EQUIVALENCE STATEMENTS 02360000 C 02370000 EQUIVALENCE (DCTYP , DENTRY (03)) 02380000 EQUIVALENCE (SPT , DENTRY (04)) 02390000 EQUIVALENCE (LRANG , DENTRY (05)) 02400000 EQUIVALENCE (NOPAR , DENTRY (06)) 02410000 EQUIVALENCE (PMODE , DENTRY (07)) 02420000 EQUIVALENCE (SPLOCN , DENTRY (08)) 02430000 EQUIVALENCE (DATTR(1) , DENTRY (09)) 02440000 EQUIVALENCE (DATTR(1) , XATTR (01)) 02450000 C 02460000 C================================================================= 02470000 C 02480000 C CHARACTER ARRAYS--LOCAL 02490000 C 02500000 C 02510000 C 02520000 C================================================================= 02530000 C 02540000 C CHARACTER VARIABLES--LOCAL 02550000 C 02560000 C 02570000 CHARACTER*80 CARD 02580000 CHARACTER*8 DEPTHP 02590000 CHARACTER*8 TYPPNT 02600000 DATA BLNK / ' ' / 02610000 DATA DATTR / 96 * 0 / 02620000 DATA DEPTHP / 'DEPTH PT' / 02630000 DATA PTS /' PTS'/ 02640000 C 02650000 C================================================================= 02660000 C 02670000 C PRINT HEADING 02680000 C 02690000 CALL USPHD ( 1, ACLNAM, KPNA, KPRNO, 0, 0, KPPRNT ) 02700000 C 02710000 C INTIALIZATION AREA 02720000 C 02730000 DENTRY(1) = KPNA 02740000 DENTRY(2) = KPRNO 02750000 DAP = 1 02760000 NOPAR = 0 02770000 NOREC = 0 02780000 NOC = 0 02790000 DCTYP = PTS 02800000 C 02810000 CALL ARSET ( DATTR, 96, BLNK ) 02820000 C 02830000 C READ FIRST CARD 02840000 C 02850000 DAC = 1 02860000 100 CONTINUE 02870000 CALL FORC ( KPNA, KPRNO, DAC, CARD, *130 ) 02880000 NOC = NOC + 1 02890000 C 02900000 C CHECK THE PROESSING MODE 02910000 C 02920000 IF (S1CPCH ( CARD, 7, BLNK, 1, 1 ) .EQ. 0) CALL S1MVCH ( LCTYP, 102930000 + , CARD, 7, 1 ) 02940000 C 02950000 IF (S1CPCH ( CARD, 7, 'D', 1, 1 ) .NE. 0) GO TO 200 02960000 TYPPNT = DEPTHP 02970000 C 02980000 C SET INTERPOLATION TYPE 02990000 C 03000000 110 CONTINUE 03010000 IF (S1CPCH ( CARD, 6, BLNK, 1, 1 ) .EQ. 0) CALL S1MVCH ( 'N', 1, 03020000 + CARD, 6, 1 ) 03030000 C 03040000 IF (S1CPCH ( CARD, 6, 'N', 1, 1 ) .NE. 0) GO TO 190 03050000 C 03060000 120 CONTINUE 03070000 CALL S1MVCH ( CARD, 6, PMODE, 1, 2 ) 03080000 C 03090000 C GET THE PROCESSING RANGE 03100000 C 03110000 R1 = S1CVBN ( CARD, 11, 5 ) 03120000 IF (R1 .EQ. 0) GO TO 210 03130000 R2 = S1CVBN ( CARD, 16, 5 ) 03140000 IF (R2 .EQ. 0) R2 = R1 03150000 C 03160000 DATTR(1) = R1 03170000 DATTR(2) = R2 03180000 C 03190000 C GET ANTENNA TO GUN DISTANCE 03200000 C 03210000 CALL USCHFT ( CARD, 21, 5, XATTR(3) ) 03220000 C 03230000 C GET CDP SPACING 03240000 C 03250000 CALL USCHFT ( CARD, 26, 5, XATTR(4) ) 03260000 C 03270000 GO TO 100 03280000 C 03290000 130 CONTINUE 03300000 IF (NOC .NE. 1) GO TO 180 03310000 C 03320000 C WRITE THE PROCESSING RANGE RECORD 03330000 C 03340000 NOPAR = 4 03350000 CALL FOWP ( KPNA, KPRNO, DAP, 104, DENTRY, *220 ) 03360000 NOREC = 1 03370000 C 03380000 C PRINT THE PARAMETERS THAT WILL BE USED 03390000 C 03400000 WRITE ( KPPRNT, 9020 ) TYPPNT, R1, R2 03410000 C 03420000 WRITE ( KPPRNT, 9030 ) XATTR(3) 03430000 C 03440000 GO TO 150 03450000 C 03460000 140 CONTINUE 03470000 KPRTF = -1 03480000 C 03490000 150 CONTINUE 03500000 IF (KPBUGF .NE. 0) THEN 03510000 C 03520000 C DUMP THE PARAMETER ENTRIES 03530000 C 03540000 DAP = 1 03550000 C 03560000 160 CONTINUE 03570000 CALL FORP ( KPNA, KPRNO, DAP, 104, DENTRY, *170 ) 03580000 WRITE ( KPPRNT, 9000 ) DENTRY 03590000 GO TO 160 03600000 ENDIF 03610000 C 03620000 C 03630000 170 CONTINUE 03640000 C 03650000 C PRINT THE TOTAL NUMBER OF RECORDS 03660000 C WRITTEN 03670000 C 03680000 IF (KPRTF .GE. 0) WRITE ( KPPRNT, 9010 ) KPNA, KPRNO, NOREC 03690000 RETURN 03700000 C 03710000 C ERROR MESSAGES 03720000 C 03730000 180 CONTINUE 03740000 WRITE ( KPPRNT, 9040 ) KPNA, KPRNO 03750000 GO TO 140 03760000 C 03770000 190 CONTINUE 03780000 WRITE ( KPPRNT, 9050 ) CARD 03790000 KPRTF = -1 03800000 CALL S1MVCH ( 'D', 1, CARD, 7, 1 ) 03810000 GO TO 120 03820000 C 03830000 200 CONTINUE 03840000 WRITE ( KPPRNT, 9060 ) CARD 03850000 KPRTF = -1 03860000 CALL S1MVCH ( 'N', 1, CARD, 6, 1 ) 03870000 GO TO 110 03880000 C 03890000 210 CONTINUE 03900000 WRITE ( KPPRNT, 9070 ) CARD 03910000 GO TO 140 03920000 C 03930000 220 CONTINUE 03940000 WRITE ( KPPRNT, 9080 ) 03950000 GO TO 140 03960000 C 03970000 C FORMAT STATEMENTS 03980000 C 03990000 9000 FORMAT (1X,A4,I1,5X,A4,3I5,1X,A4,I5/4(1X,24I5/)) 04000000 C 04010000 9010 FORMAT('0*** ',A4,I1,' COMPLETED -- NO ERRORS,', 04020000 + /' *** TOTAL NUMBER OF PARAMETER RECORDS = ',I5) 04030000 C 04040000 9020 FORMAT (5X,A8,' RANGE: ',I5,' TO ',I5,/) 04050000 C 04060000 9030 FORMAT (5X,'ANTENNA TO GUN DISTANCE IS ',F8.0,/) 04070000 C 04080000 9040 FORMAT ('0*** NO DATA CARD FOR ',A4,I1,' ***'/) 04090000 C 04100000 9050 FORMAT ('0*** INVALID INTERPOLATION TYPE ***' / 10X,A80) 04110000 C 04120000 9060 FORMAT ('0*** INVALID PROCESSING MODE ***' / 10X,A80) 04130000 C 04140000 9070 FORMAT ('0*** NO PROCESSING RANGE PRESENT ***' / 10X,A80) 04150000 C 04160000 9080 FORMAT ('0*** FOWP HAD A WRITE ERROR ***') 04170000 C 04180000 END 04190000