CTITLEUSDIST -- MOVES DISTRICT CODE INTO PLOT LABEL 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR W. C. COLLINS , K. GRAY 00020000 CA DESIGNER K. GRAY 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN NOVEMBER 15,1985 00060000 C 00070000 C 00080000 C REVISED XX-XX-XX BY AAA. XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. 00090000 C REVISED 11-27-85 BY CMP. INITIALIZE 4 WORDS ONLY, 00100000 C MODIFY ABSTRACTS. 00110000 C REVISED 01-24-86 BY ESN. FOR CRAY COMPATABILITY. 00120000 C REVISED 04-08-86 BY CMP. ADD NEW DISTRICT CODES. 00121000 C REVISED 10-17-89 BY PJF. REVISED NAMES DISTRICT 81/82. 00121100 C REVISED 11-06-89 BY LWC. DELETE EXTERNAL S1ATP. 00121202 CA 00122000 CA CALL USDIST (ACDIST,LBDIST) 00123000 CA 00124000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00125000 CA 00126000 CA IN ACDIST I4 DISTRICT CODE 00127000 CA IN LBDIST C*16 TITLE IN 16 ALPHANUMERIC BYTES 00128000 CA 00129000 CA THIS ROUTINE CHECKS FOR THE CORRECT DISTRICT CODE AND ASSIGNS 00130000 CA THE PROPER DISTRICT NAME TO IT. 00140000 CA 00150000 CA 00160000 CAEND 00170000 C 00180000 SUBROUTINE USDIST (ACDIST,LBDIST) 00190000 C 00200000 IMPLICIT INTEGER (A-Z) 00210000 C 00220000 C 00230000 C 00250000 C 00260000 INTEGER ACDIST 00270000 CHARACTER*16 LBDIST 00280000 C 00290000 CHARACTER*4 BLANK 00300000 C 00310000 DATA BLANK /' '/ 00320000 C 00330000 C CLEAR OUT ARRAYS TO BE PASSED 00340000 C 00350000 CALL ARSET ( LBDIST, 4, BLANK ) 00360000 C 00370000 C MOVE PROPER DISTRICT NAME INTO LABEL 00380000 C 00390000 IF ( ACDIST .EQ. 1 ) LBDIST(1: 3) = 'EDP' 00400000 C 00410000 IF ( ACDIST .EQ. 2 ) LBDIST(1: 9) = 'LAND ACQ.' 00420000 C 00430000 IF ( ACDIST .EQ. 3 ) LBDIST(1:11) = 'MARINE ACQ.' 00440000 C 00450000 IF ( ACDIST .EQ. 4 ) LBDIST(1:14) = 'R&D PROCESSING' 00460000 C 00470000 IF ( ACDIST .EQ. 5 ) LBDIST(1:16) = 'NORTHEASTERN REG' 00480000 C 00490000 IF ( ACDIST .EQ. 6 ) LBDIST(1:13) = 'INTERNATIONAL' 00500000 C 00510000 IF ( ACDIST .EQ. 7 ) LBDIST(1:13) = 'OUTSIDE SALES' 00520000 C 00530000 IF ( ACDIST .EQ. 8 ) LBDIST(1:16) = 'EXPL. DATA MGMT.' 00540000 C 00550000 IF ( ACDIST .EQ. 9 ) LBDIST(1:10) = 'GEOSCIENCE' 00560000 C 00570000 IF ( ACDIST .EQ. 11 ) LBDIST(1:16) = 'ARCO ALASKA INC.' 00580000 C 00590000 IF ( ACDIST .EQ. 12 ) LBDIST(1:12) = 'ALASKA EXPL.' 00600000 C 00610000 IF ( ACDIST .EQ. 15 ) LBDIST(1:13) = 'PACIFIC EXPL.' 00620000 C 00630000 IF ( ACDIST .EQ. 16 ) LBDIST(1:16) = 'SOUTHEASTERN REG' 00640000 C 00650000 IF ( ACDIST .EQ. 17 ) LBDIST(1:14) = 'MID-CONT. REG.' 00660000 C 00670000 IF ( ACDIST .EQ. 18 ) LBDIST(1:16) = 'SOUTH TEXAS REG.' 00680000 C 00690000 IF ( ACDIST .EQ. 19 ) LBDIST(1:15) = 'OFFSHORE REGION' 00700000 C 00710000 IF ( ACDIST .EQ. 20 ) LBDIST(1:15) = 'AOGC EAST TEXAS' 00720000 C 00730000 IF ( ACDIST .EQ. 21 ) LBDIST(1:15) = 'ROCKY MTN. REG.' 00740000 C 00750000 IF ( ACDIST .EQ. 30 ) LBDIST(1:16) = 'AOGC BAKERSFIELD' 00760000 C 00770000 IF ( ACDIST .EQ. 31 ) LBDIST(1:12) = 'AOGC MIDLAND' 00780000 C 00790000 IF ( ACDIST .EQ. 32 ) LBDIST(1:10) = 'AOGC TULSA' 00800000 C 00810000 IF ( ACDIST .EQ. 33 ) LBDIST(1:15) = 'AOGC ROCKY MTN.' 00820000 C 00830000 IF ( ACDIST .EQ. 40 ) LBDIST(1:15) = 'S. TEX. ONSHORE' 00840000 C 00850000 IF ( ACDIST .EQ. 41 ) LBDIST(1:15) = 'S. TEX. ONSHORE' 00860000 C 00870000 IF ( ACDIST .EQ. 44 ) LBDIST(1:15) = 'S. TEX. ONSHORE' 00880000 C 00890000 IF ( ACDIST .EQ. 50 ) LBDIST(1: 9) = 'SOUTHERN' 00900000 C 00910000 IF ( ACDIST .EQ. 51 ) LBDIST(1:16) = 'EASTERN OFFSHORE' 00920000 C 00930000 IF ( ACDIST .EQ. 52 ) LBDIST(1:15) = 'EASTERN ONSHORE' 00940000 C 00950000 IF ( ACDIST .EQ. 54 ) LBDIST(1:16) = 'EASTERN OFFSHORE' 00960000 C 00970000 IF ( ACDIST .EQ. 60 ) LBDIST(1:12) = 'SOUTHEASTERN' 00980000 C 00990000 IF ( ACDIST .EQ. 61 ) LBDIST(1:11) = 'S. E. NORTH' 01000000 C 01010000 IF ( ACDIST .EQ. 62 ) LBDIST(1:11) = 'S. E. SOUTH' 01020000 C 01030000 IF ( ACDIST .EQ. 64 ) LBDIST(1:13) = 'S. E. ONSHORE' 01040000 C 01050000 IF ( ACDIST .EQ. 70 ) LBDIST(1:16) = 'WESTERN DIVISION' 01060000 C 01070000 IF ( ACDIST .EQ. 71 ) LBDIST(1:16) = 'WESTERN OFFSHORE' 01080000 C 01090000 IF ( ACDIST .EQ. 72 ) LBDIST(1:15) = 'WESTERN ONSHORE' 01100000 C 01110000 IF ( ACDIST .EQ. 74 ) LBDIST(1: 7) = 'PACIFIC' 01120000 C 01130000 IF ( ACDIST .EQ. 80 ) LBDIST(1: 7) = 'CENTRAL' 01140000 C 01150000 IF ( ACDIST .EQ. 81 ) LBDIST(1:13) = 'CENTRAL EAST' 01160000 C 01170000 IF ( ACDIST .EQ. 82 ) LBDIST(1:13) = 'CENTRAL WEST' 01180000 C 01190000 IF ( ACDIST .EQ. 84 ) LBDIST(1: 7) = 'CENTRAL' 01200000 C 01210000 IF ( ACDIST .EQ. 90 ) LBDIST(1:13) = 'ALASKA GEOPH.' 01220000 C 01230000 IF ( ACDIST .EQ. 91 ) LBDIST(1:13) = 'EXPL. PRUDHOE' 01240000 C 01250000 IF ( ACDIST .EQ. 92 ) LBDIST(1:13) = 'EXPL. KUPARUK' 01260000 C 01270000 IF ( ACDIST .EQ. 94 ) LBDIST(1:12) = 'ALASKA GEOL.' 01280000 C 01290000 IF ( ACDIST .EQ. 98 ) LBDIST(1: 8) = 'TRAINING' 01300000 C 01310000 IF ( ACDIST .EQ. 99 ) LBDIST(1:15) = 'R&D PROGRAMMING' 01320000 C 01330000 C 01340000 RETURN 01350000 C 01360000 END 01370000