CTITLECSACCT -- ACCOUNTING RECORD, BUILD AND WRITE (CALL FOACCT) 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR/DESIGNER FRANCIS COLLINS 00020000 CA LANGUAGE FORTRAN 00030000 CA SYSTEM IBM AND CRAY 00040000 CA WRITTEN 7-23-75 00050000 C REVISED 4-15-77 FAC. CHANGE LENGTH TO 164 BYTES. 00060000 C WORD 5 = ELAPSED TIME. 00070000 C WORD 6 = CPU TIME. 00080000 C BYTE 63 = SYSTEM CODE= 'S'. 00090000 C REVISED 1-20-78 FAC. HWRD 26 = MILES OF 3D LINES. 00100000 C WORD 26 = TRACES PROCESSED. 00110000 C WORD 27 = TRACES WRITTEN. 00120000 C WORD 28 = SAMPLES PROCESSED. 00130000 C WORD 29 = NO. OF CDP'S. 00140000 C REVISED 7-20-79 FAC. HWRD 31 = NO. OF VA'S. 00150000 C WORD 14 = NO. OF TRACES MIGRATED. 00160000 C WORD 30 = NO. OF DIRECT DECONVOLUTIONS. 00170000 C WORD 31 = NO. OF TRACES FOR COLOR PLOT. 00180000 C WORD 32 = NO. OF SEISMIC LOGS. 00190000 C WORD 33 = ENDING DATE FOR JOB. 00200000 C REVISED 7-21-79 FAC. CHANGE MCETIM TO MCEDAT IN CALL CORE. 00210000 C REVISED 2-22-80 PKC. CHANGED USE OF LCSI TO LCPI. 00220000 C REVISED 10-23-80 FAC. IF ACNMIP > 655.35, USE 655.35 AND ISSUE 00230000 C ERROR MESSAGE. 00240000 C REVISED 08-20-81 PKC. ADDED COMMENTS TO NOTE CHANGES FOR 4341. 00250000 C REVISED 04-12-82 PKC. ADDED RETRIEVE OF CPU ID TO WORD 34. 00260000 C REVISED 07-12-82 PKC. ADDED RETRIEVE OF CPU FACTOR TO WORD 35. 00270000 C REVISED 11-19-82 RFE. ADDED WORD 37 = NO. OF TRACES PLOTTED 00280000 C (VARIAN OR TIADD). 00290000 C ADDED HALF-WORD TYPLT = TYPE OF PLOT 00300000 C 1 = VARIAN; 2 = TIADD; 3 = BOTH. 00310000 C REVISED 11-29-83 CMP. ADDED LAST 3 WORDS OF LINE NAME. 00320000 C REVISED 01-25-84 RFE. MODIFIED WORD 37 TO REFLECT A CUMULATIVE 00330000 C TOTAL OF TRACES PLOTTED. 00340000 C REVISED 10-02-84 REP. CONVERT TO VS FORTRAN. 00350000 C REVISED 12-05-84 RDK. DUAL PATH IBM/CRAY. 00360000 C REVISED 09-06-85 ESN. RELEASE CRAY VERSION ON BOTH IBM/CRAY. 00370000 C REVISED 06-25-86 ESN. CHECK 'SYSTEM' WITH 'IBM' INSTEAD OF 00380000 C 'IBM '. 00390000 C REVISED 06-03-87 DJP. CHANGED PRINT UNIT FROM 6 TO 99 00400000 C REVISED 12-18-87 REP. REMOVE FAT TABLE REFERENCE AND USE KPDBGN.00410000 C REVISED 11-12-91 ESN. REMOVE ERROR MESSAGE FOR NUMBER OF MILES 00420000 C PROCESSED EXCEEDING 655.35. 00430000 C REVISED 01-24-92 ESN. CORRECT STORING LINE NAME IN ACCT RECORD. 00440001 C 00450000 CA 00460000 CA 00470000 CA CALL CSACCT 00480000 CA 00490000 CA THIS PROGRAM BUILDS THE ACCOUNTING RECORD AND THEN CALLS FOACCT 00500000 CA WHICH WRITES THE RECORD TO THE ACCOUNTING FILE. 00510000 CA 00520000 CA DESCRIPTION OF THE ACCOUNTING FILE. 00530000 CA DDNAME = SPARCACC 00540000 CA DSNAME = DBG.SPARC.ACCOUNT 00550000 CA DSORG = PS (PHYSICAL SEQUENTIAL) 00560000 CA LRECL = 164 BYTES 00570000 CA RECFM = F (FIXED) 00580000 CA 00590000 CA DESCRIPTION OF THE ACCOUNTING RECORD. 00600000 CA IN THIS PROGRAM THE RECORD IS BUILT IN AN ARRAY OF LENGTH 00610000 CA 164 BYTES. FOR CONVENIENCE OF REFERENCE BY FORTRAN SUBSCRIPTS, 00620000 CA THIS ARRAY IS DEFINED BY THREE EQUIVALENT VARIABLES, DOUBLE 00630000 CA WORDS, FULLWORDS, AND HALFWORDS, NAMED ACCTDW, ACCTFW, AND 00640000 CA ACCTHW. THE FOLLOWING TABLE GIVES THE FORTRAN INDICES FOR EACH 00650000 CA OF THESE VARIABLES, AS WELL AS THE BYTE POSITION. 00660000 CA 00670000 CA DESCRIPTION SOURCE --INDICES--- TY00680000 CA DW FW HW BY 00690000 CA JOB NAME NOTE 1 1 1 A800700000 CA READER START TIME, CS. NOTE 1 3 9 I400710000 CA READER START DATE, PACKED DECIMAL, 00YYDDD+ NOTE 1 4 13 P700720000 CA ELAPSED TIME FOR JOB, HUNDREDTHS OF MINUTES NOTE 4 5 17 I400730000 CA CPU TIME FOR JOB, HUNDREDTHS OF MINUTES NOTE 5 6 21 I400740000 CA CHARGE CODE, FIRST HALF OF FIRST POSITION NOTE 1 7 25 A400750000 CA GAP DISTRICT NUMBER AND PROJECT NUMBER NOTE 2 8 29 I400760000 CA LINE IDENTIFICATION (FIRST 8 BYTES) ACLNAM 5 9 33 A800770000 CA NUMBER OF SHOTPOINTS PROCESSED ACNSP 21 41 I200780000 CA NUMBER OF TRACES PER SHOTPOINT LCTPSP 22 43 I200790000 CA NUMBER OF SAMPLES PER TRACE LCRL/LCPI 12 45 I400800000 CA SAMPLING INTERVAL LCPI 25 49 I200810000 CA MILES OF 3-D LINES (HUNDREDTHS) 100*ACNMIP 26 51 I200820000 CA MIGRATION, NO. OF TRACES ACMIGR 14 53 I400830000 CA NUMBER OF TRACES PER COMMON DEPTH POINT LCMXFD 29 57 I200840000 CA SPARC EXIT STATUS (MESSAGE CODE) MCRTF 30 59 I200850000 CA NO. OF VELOCITY ANALYSES ACVELA 31 61 I200860000 CA COMPUTER SYSTEM CODE (S FOR SPARC) 'S' 32 63 A100870000 CA RESERVED BYTE (TO HELP FORTRAN) BLANK 64 A100880000 CA USER'S COMMENTS ACCOM 33 65 3200890000 CA TYPE OF RUN (ALWAYS 'SP' AS OF 8-28-78) ACTYPE 49 97 A200900000 CA NOT USED. 50 99 200910000 CA NO. OF TRACES READ (AND PASSED) ACNTRP 26 101 I400920000 CA NO. OF TRACES WRITTEN ACNTRW 27 105 I400930000 CA NO. OF SAMPLES PROCESSED (LCRL/LCPI)*ACNTRP 28 109 I400940000 CA NO. OF DEPTH-POINTS PROCESSED ACNCDP 29 113 I400950000 CA NO. OF DIRECT DECONVOLUTIONS (TRACES) ACDDEC 30 117 I400960000 CA NO. OF TRACES FOR COLOR PLOTS ACQUAD 31 121 I400970000 CA NO. OF SEISMIC LOGS ACSLOG 32 125 I400980000 CA JOB ENDING DATE, 10000*YR + 100*MO + DA NOTE 6 33 129 I400990000 CA SYSTEM CPU IDENTIFICATION NOTE 7 34 133 A401000000 CA SYSTEM CPU RELATIONSHIP PERCENTAGE NOTE 7 35 137 A501010000 CA TYPE OF PLOT (1=VARIAN;2=TIADD;BOTH=3) 72 143 I201020000 CA NO. OF TRACES FOR PLOTS (VARIAN OR TIADD) KPTRIO 37 145 I401030000 CA LINE IDENTIFICATION (LAST 10 BYTES) ACLNAM 154A1001040000 CA RESERVED 164 01050000 CA 01060000 CA NOTE 1. OBTAINED BY CALL ON SUBROUTINE JCTEXT. 01070000 CA NOTE 2. 100000*ACDIST + ACPROJ (= DP). 01080000 CA TO RECOVER DISTRICT AND PROJECT FROM COMPOUND DP, 01090000 CA ACDIST = DP/100000, 01100000 CA ACPROJ = DP - 100000*ACDIST. 01110000 CA NOTE 3. OBSOLETE. 01120000 CA NOTE 4. (MCETIM - MCBTIM)/60. 01130000 CA NOTE 5. CALL CLOCK (ACCTFW(6), MCCTOT). 01140000 CA NOTE 6. YRMODA = 10000*YEAR + 100*MONTH + DAY. 01150000 CA TO RECOVER YEAR, MONTH, AND DAY, (YR, MO, DA), 01160000 CA YRMO = YRMODA/100, 01170000 CA DA = YRMODA - 100*YRMO, 01180000 CA YR = YRMO/100, 01190000 CA MO = YRMO - 100*YR. 01200000 CA NOTE 7. OBTAINED FROM 'SYS1.IDLIB' BY USRDID. 01210000 C 01220000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 01230000 C 01240000 C ACCTHW ( 82) = ACCOUNTING RECORD IN HALF-WORDS. I2 01250000 C ACCTFW ( 41) = ACCOUNTING RECORD IN FULL WORDS. I4 01260000 C ACCTDW ( 21) = ACCOUNTING RECORD IN DOUBLE WORDS. R8 01270000 C 01280000 C 01290000 SUBROUTINE CSACCT 01300000 C 01310000 IMPLICIT INTEGER (A-Z) 01320000 C 01330000 PARAMETER (IPR=99) 01340000 C 01350000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 01360000 COMMON /P/ STARTP ( 2) , M00000( 10) 01370000 COMMON /P/ LCTPSP 01380000 COMMON /P/ LCRL 01390000 COMMON /P/ LCSI 01400000 COMMON /P/ LCPI , M00060 01410000 COMMON /P/ LCMXFD , M00068( 11) 01420000 COMMON /P/ ACDIST 01430000 COMMON /P/ ACPROJ 01440000 COMMON /P/ ACLNAM ( 5) 01450000 COMMON /P/ ACCOM ( 8) , M00144 01460000 COMMON /P/ ACTYPE 01470000 COMMON /P/ ACNSP , M00184( 5) 01480000 COMMON /P/ ACNMIP 01490000 REAL ACNMIP 01500000 COMMON /P/ ACNTRP 01510000 COMMON /P/ ACNTRW 01520000 COMMON /P/ ACNCDP 01530000 COMMON /P/ ACMIGR 01540000 COMMON /P/ ACQUAD 01550000 COMMON /P/ ACSLOG 01560000 COMMON /P/ ACVELA 01570000 COMMON /P/ ACDDEC , M00240( 43) 01580000 COMMON /P/ KPNA , M00416( 5) 01590000 COMMON /P/ KPDBGN , M00440( 26) 01600000 COMMON /P/ KPTRIO , M00548( 27) 01610000 COMMON /P/ MCCTOT , M00660 01620000 COMMON /P/ MCBTIM 01630000 COMMON /P/ MCETIM , M00672( 2) 01640000 COMMON /P/ MCETEM ( 2) , M00684( 2) 01650000 COMMON /P/ MCEDAT ( 2) , M00700( 6) 01660000 COMMON /P/ MCRTF , M00732( 3) 01670000 COMMON /P/ MCNKP , M00748( 134) 01680000 COMMON /P/ PTNCW , M01288( 37) 01690000 COMMON /P/ PROTAB ( 2) 01700000 COMMON /P/ ENDP 01710000 C 01720000 COMMON /SYSTEM/ SYSTEM 01730000 COMMON /SYSTEM/ SYBYPW 01740000 COMMON /SYSTEM/ SYLOCF 01750000 C 01760000 C INTEGER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 01770000 C 01780000 INTEGER ACCTFW ( 41) 01790000 INTEGER CARD ( 20) 01800000 INTEGER JCUSER ( 5) 01810000 INTEGER JC71AE ( 3) 01820000 C 01830000 C REAL ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 01840000 C 01850000 REAL ACCTDW ( 41) 01860000 C 01870000 EQUIVALENCE ( ACCTFW (1), ACCTDW (1) ) 01880000 C 01890000 C CHARACTER VARIABLES--LOCAL (INTERNAL TO SUBROUTINE). 01900000 C 01910000 CHARACTER*8 CMCDAT 01920000 CHARACTER*40 HEAD 01930000 C 01940000 C INTEGER VARIABLES AND CONSTANTS--INTERNAL (LOCAL TO SUBROUTINE) 01950000 C 01960000 INTEGER ACCT 01970000 INTEGER OUTF 01980000 INTEGER S 01990000 INTEGER TYPLT 02000000 INTEGER WRIT 02010000 C 02020000 C INITIALIZATION 02030000 C 02040000 DATA ACCT / 'ACCT' / 02050000 DATA ACCTDW / 41*0.0 / 02060000 DATA CPU / 0 / 02070000 DATA DA / 0 / 02080000 DATA HEAD / 'CSACCT ACCOUNTING PROGRAM ERROR MESSAGES' /02090000 DATA HWMAX / 65535 / 02100000 DATA JCUSER /5*' '/ 02110000 DATA JC71AE /3*' '/ 02120000 DATA MO / 0 / 02130000 DATA NMIP / 65536 / 02140000 DATA OUTF /'O ' / 02150000 DATA S / 'S ' / 02160000 DATA WRIT / 'WRIT' / 02170000 DATA YR / 0 / 02180000 C 02190000 C 02200000 C MOVE FULL-WORD VALUES TO ACCOUNTING RECORD. 02210000 C 02220000 CALL JCTEXT (ACCTFW(1), ACCTFW(3), ACCTFW(4), JCUSER, JC71AE) 02230000 C 02240000 C ACCTFW(1,2) = JOB NAME. 02250000 C ACCTFW ( 3) = READER START TIME, CS. 02260000 C ACCTFW ( 4) = READER START DATE, PACKED DECIMAL, 00YYDDD+. 02270000 C ACCTFW ( 5) = ELAPSED TIME FOR JOB. CALL DATIME LATER. 02280000 C ACCTFW ( 6) = CPU TIME FOR JOB. CALL CLOCK LATER. 02290000 C =================================================================== 02300000 C NOTE: CRAY ELEMENTS MIXED JUSTIFIED IN 8-BYTE ACCTFW ARRAY. 02310000 C NOTE: CRAY COMMON /P/ ALPHA TEXT ASSUMED LEFT JUSTIFIED. 02320000 C =================================================================== 02330000 CRAYL 02340000 ACCTFW ( 7) = JC71AE (1) 02350000 ACCTFW ( 8) = 100000*ACDIST + ACPROJ 02360000 C 02370000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) 02380000 *CALL S1MVCH (ACLNAM,1,ACCTFW, 33,08) 02390000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) 02400000 *CALL S1MVCH (ACLNAM,9,ACCTFW,154,10) 02410000 IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .NE. 0) GO TO 50 02420000 CRAYL 02430000 CALL S1MVCH (ACLNAM, 1,ACCTFW, 65,04) 02440000 CALL S1MVCH (ACLNAM, 5,ACCTFW, 73,04) 02450000 CALL S1MVCH (ACLNAM, 9,ACCTFW,306,03) 02460002 CALL S1MVCH (ACLNAM,12,ACCTFW,313,04) 02470003 CALL S1MVCH (ACLNAM,16,ACCTFW,321,03) 02480003 C 02490000 50 IF (LCPI .NE. 0) 02500000 *ACCTFW (12) = LCRL/LCPI 02510000 ACCTFW (14) = ACMIGR 02520000 ACCTFW (26) = ACNTRP 02530000 ACCTFW (27) = ACNTRW 02540000 ACCTFW (28) = ACCTFW (12) * ACNTRP 02550000 ACCTFW (29) = ACNCDP 02560000 ACCTFW (30) = ACDDEC 02570000 ACCTFW (31) = ACQUAD 02580000 ACCTFW (32) = ACSLOG 02590000 C 02600000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) GO TO 110 02610000 C 02620000 C MOVE HALF-WORD VALUES TO ACCOUNTING RECORD (CRAY) 02630000 C ALL NUMERICS RIGHT JUSTIFIED IN CRAY ACCTFW ARRAY 02640000 C OTHERS AS INDICATED BELOW (R OR L) 02650000 C ACCTHW (21) = ACNSP 02660000 C ACCTHW (22) = LCTPSP 02670000 C ACCTHW (25) = LCPI 02680000 C ACCTHW (26) = NMIP 02690000 CALL S1MVCH (ACNSP , 7, ACCTFW, 85, 2) 02700000 CALL S1MVCH (LCTPSP, 7, ACCTFW, 87, 2) 02710000 CALL S1MVCH (LCPI , 7, ACCTFW,101, 2) 02720000 C 02730000 NMIP = 100.0*(ACNMIP + 0.005) 02740000 CALL S1MVCH (NMIP , 7, ACCTFW,103, 2) 02750000 IF (NMIP .LE. 65535) GO TO 100 02760000 NMIP = 65535 02770000 CRAY CALL S1MVCH (HWMAX, 1, ACCTHW(26), 1, 2) 02780000 CALL S1MVCH (HWMAX, 7, ACCTFW, 103, 2) 02790000 CRAY CALL USPHD (2, LCLNO, ACCT, 0, HEAD, 40, 88) 02800000 CALL USPHD (2,ACLNAM, ACCT, 0, HEAD, 40, IPR) 02810000 CRAY WRITE (88,900) ACNMIP, NMIP 02820000 C WRITE (IPR, 900) ACNMIP, NMIP 02830000 100 CONTINUE 02840000 CRAY ACCTHW (29) = LCMXFD 02850000 CALL S1MVCH (LCMXFD, 7, ACCTFW, 117, 2) 02860000 CRAY ACCTHW (30) = MCRTF 02870000 CALL S1MVCH ( MCRTF, 7, ACCTFW, 119, 2) 02880000 CRAY ACCTHW (31) = ACVELA 02890000 CALL S1MVCH (ACVELA, 7, ACCTFW, 125, 2) 02900000 CRAYR CALL S1MVCH (S, 1, ACCTHW(32), 1, 2) 02910000 CALL S1MVCH (S, 1, ACCTFW , 127, 2) 02920000 CRAYL CALL S1MVCH (ACCOM, 1, ACCTHW(33), 1, 32) 02930000 CALL S1MVCH (ACCOM, 1, ACCTFW , 129, 4) 02940000 CALL S1MVCH (ACCOM, 5, ACCTFW , 137, 4) 02950000 CALL S1MVCH (ACCOM, 9, ACCTFW , 145, 4) 02960000 CALL S1MVCH (ACCOM, 13, ACCTFW , 153, 4) 02970000 CALL S1MVCH (ACCOM, 17, ACCTFW , 161, 4) 02980000 CALL S1MVCH (ACCOM, 21, ACCTFW , 169, 4) 02990000 CALL S1MVCH (ACCOM, 25, ACCTFW , 177, 4) 03000000 CALL S1MVCH (ACCOM, 29, ACCTFW , 185, 4) 03010000 CRAYR CALL S1MVCH (ACTYPE, 1, ACCTHW(49), 1, 2) 03020000 CALL S1MVCH (ACTYPE, 1, ACCTFW , 197, 2) 03030000 C 03040000 GO TO 150 03050000 C 03060000 110 CONTINUE 03070000 C 03080000 C MOVE HALF-WORD VALUES TO ACCOUNTING RECORD (IBM) 03090000 C ACCTHW (21) = ACNSP 03100000 C ACCTHW (22) = LCTPSP 03110000 C ACCTHW (25) = LCPI 03120000 C ACCTHW (26) = NMIP 03130000 CALL S1MVCH ( ACNSP, 3, ACCTFW, 41, 2) 03140000 CALL S1MVCH (LCTPSP, 3, ACCTFW, 43, 2) 03150000 CALL S1MVCH ( LCPI, 3, ACCTFW, 49, 2) 03160000 C 03170000 NMIP = 100.0*(ACNMIP + 0.005) 03180000 CALL S1MVCH (NMIP, 3, ACCTFW, 51, 2) 03190000 IF (NMIP .LE. 65535) GO TO 125 03200000 NMIP = 65535 03210000 CALL S1MVCH (HWMAX, 3, ACCTFW ,51, 2) 03220000 CALL USPHD (2,ACLNAM, ACCT, 0, HEAD, 40, IPR) 03230000 C WRITE (IPR, 900) ACNMIP, NMIP 03240000 125 CONTINUE 03250000 C 03260000 C ACCTHW (29) = LCMXFD 03270000 CALL S1MVCH (LCMXFD, 3, ACCTFW, 57, 2) 03280000 C ACCTHW (30) = MCRTF 03290000 CALL S1MVCH (MCRTF , 3, ACCTFW, 59, 2) 03300000 C ACCTHW (31) = ACVELA 03310000 CALL S1MVCH (ACVELA, 3, ACCTFW, 61, 2) 03320000 CALL S1MVCH (S, 1, ACCTFW ,63, 2) 03330000 CALL S1MVCH (ACCOM, 1, ACCTFW ,65, 32) 03340000 CALL S1MVCH (ACTYPE, 1, ACCTFW ,97, 2) 03350000 C 03360000 C 03370000 150 CALL DATIME (MCEDAT, MCETEM, MCETIM) 03380000 ACCTFW ( 5) = (MCETIM - MCBTIM)/60 03390000 CRAY IF (ACCTFW(5) .LE. 0) ACCTFW(5) = 1 03400000 CALL USCLOK (CPU, MCCTOT) 03410000 MCCTOT = CPU 03420000 ACCTFW(6) = CPU/60 03430000 C 03440000 CALL S1MVCH ( MCEDAT(1),1, CMCDAT,1, 8 ) 03450000 READ ( CMCDAT ,910) MO, DA, YR 03460000 ACCTFW (33) = 10000*YR + 100*MO + DA 03470000 C 03480000 C RETRIEVE SYSTEM CPU ID 03490000 CRAYL 03500000 CALL USRDID (ACCTFW(34)) 03510000 C 03520000 C DEVELOP PLOT TYPE 03530000 C 03540000 INDBGN = (LOC(KPDBGN) - LOC(KPNA)) / SYLOCF 03550000 INTRIO = (LOC(KPTRIO) - LOC(KPNA)) / SYLOCF 03560000 LOCPTB = LOC(PROTAB) 03570000 LAST = PTNCW * MCNKP 03580000 C 03590000 K = 1 03600000 FESP = 0 03610000 FTAD = 0 03620000 TYPLT = 0 03630000 C 03640000 200 IF (PROTAB(K+INDBGN) .NE. 2) GO TO 500 03650000 C 03660000 IF (PROTAB(K+INTRIO) .EQ. 0 ) GO TO 500 03670000 C 03680000 C 03690000 DA = 1 03700000 CALL FORC ( PROTAB(K), PROTAB(K+1), DA, CARD, *500) 03710000 C 03720000 IF ( PROTAB(K) .NE. WRIT ) GO TO 500 03730000 C 03740000 IF (S1CPCH(CARD, 76, 'OFESP', 1, 5) .EQ. 0)GO TO 300 03750000 IF (S1CPCH(CARD, 76, 'OFTAD', 1, 5) .EQ. 0)GO TO 400 03760000 GO TO 500 03770000 C 03780000 300 TYPLT = 1 03790000 FESP = 1 03800000 GO TO 500 03810000 C 03820000 400 TYPLT = 2 03830000 FTAD = 1 03840000 C 03850000 C 03860000 500 ACCTFW (37) = ACCTFW(37) + PROTAB(K + INTRIO) 03870000 K = K + PTNCW 03880000 IF (K .LE. LAST) GO TO 200 03890000 C 03900000 IF (FESP .EQ. 1 .AND. FTAD .EQ. 1) TYPLT = 3 03910000 C 03920000 CRAY ACCTHW (72) = TYPLT 03930000 IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) 03940000 *CALL S1MVCH (TYPLT, 7, ACCTFW, 287, 2) 03950000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) 03960000 *CALL S1MVCH (TYPLT, 3, ACCTFW, 143, 2) 03970000 C 03980000 C 03990000 CALL FOACCT (ACCTDW) 04000000 C 04010000 RETURN 04020000 C 04030000 C 900 FORMAT(//6X, 'NUMBER OF MILES PROCESSED (ACNMIP) = ', F8.2, '.' 04040000 C * //6X, 'HALFWORD IN ACCOUNTING RECORD HAS BEEN SET TO ', 04050000 C * I5, ' HUNDREDTHS OF MILES (655.35 MILES).' 04060000 C * //6X, 'PLEASE INFORM PROGRAMMING STAFF.') 04070000 C 04080000 910 FORMAT(I2, 1X, I2, 1X, I2) 04090000 C 04100000 END 04110000