CTITLECPPREP -- CONTROL PROGRAM FOR FOREGROUND PREPARATION STEP 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH MCMILLAN 00020001 CA DESIGNER RALPH MCMILLAN 00030001 CA LANGUAGE VS FORTRAN 00040001 CA SYSTEM IBM AND CRAY 00050001 CA WRITTEN 06-18-86 00060001 C REVISED 6-18-86 REM. ADAPTED FROM CPEXEC. 00070001 C REVISED 8-07-86 REM. INCREASE BLANK COMMON TO 150,000 WORDS 00080001 C REVISED 9-10-86 REM. FIX FORMAT FOR TOO MANY TRACES ERROR MSG. 00090001 C REVISED 10-07-86 REM. ADD CHECK FOR DLM CARD WHEN RE-READING DATA00100001 C CARDS. 00110001 C REVISED 11-19-86 REM. ADD KPWARN TO COMMON P. 00120001 C REVISED 01-07-87 RDK. AUGMENT THE LFTAUX TABLE ENTRIES TO 00130001 C CORRECT LENGTHS FOR COMPLEX FFT'S. 00140001 C REVISED 01-28-87 REM. FREE GETMAINED COMMON AREA. 00150001 C REVISED 05-04-87 REM. CONVERT TO USE FORTRAN PTABMSTR. 00160001 C REVISED 05-15-87 DJP. ADDED PREP MODULE FLAG TO PROCLI ARRAY AND 00170001 C SKIP CALL TO FSCALL IF IT IS ZERO. 00180001 C REVISED 06-05-87 DJP. CHANGED THE PRINT UNIT FOR SPARC OUTPUT 00190001 C FROM 6 TO 98. 00200001 C REVISED 06-19-87 DJP. REMOVED SEISPARM, GM3DPARM AND FT05F001 00210001 C FILE ALLOCATION, REPLACED FSCALL WITH 00220001 C CPSPCL, ALLOWED FOR BACKGROUND EXECUTION, 00230001 C ADDED WARNING PRINT WHEN A PROCESS IS NOT 00240001 C FOUND, AND ALLOW FOR EXECUTION ON THE CRAY.00250001 C REVISED 06-30-87 DPH. CHANGES FOR CRAY COMPATIBILITY: 00260001 C 1. SEPARATE DATA & DECLARATION STATEMENTS. 00270001 C 2. USE S1MVCH INSTEAD OF EQUIVALENCE 00280001 C BETWEEN CHARACTER AND INTEGER TYPES. 00290001 C 3. INCREASE WORK FILE REC LEN TO 88 BYTES. 00300001 C 4. CHANGE DUMFAT DECLARATION TO CHAR*8. 00310001 C 5. CHANGE 1ST ARGUMENT OF FORC/FOWP TO INT.00320001 C 6. MAKE ACLNAM AND ACCOM CONTIGUOUS. 00330001 C 7. BLANK FILL KPNA. 00340001 C REVISED 07-01-87 DPH. WRITE PARM, ULIB, JOBC, INFO CARDS TO FT05.00350001 C REVISED 07-15-87 DJP. PLACE WRITE OF ACCT, LINE, PARM, ULIB, 00360001 C JOBC, INFO, AND COMM CARDS TO UNIT 5 PRIOR 00370001 C TO SORT OF THE OTHER DATA CARDS TO ELIMIN- 00380001 C ATE SAVING ANY OF THESE CARDS. 00390001 C REVISED 08-17-87 REM. INCREASE DIMENSIONS OF PROCLC AND PROCLI; 00400001 C CALL FSTIME TO PRINT PROCESS TIMES. 00410001 C REVISED 09-01-87 REM. CHANGE VARIABLE NAMES:NPROCS TO MXPROC;. 00420001 C TOTENT TO NPROC;PROCLT TO PROCLI. 00430001 C REVISED 09-11-87 REM. ADD HEAD CARDS TO LIST OF CARDS 00440001 C AUTOMATICALLY COPIED TO FT05. 00450001 C REVISED 09-14-87 REM. USE JOBID TO TEST FOR FOREGROUND EXECUTION.00460001 C REVISED 09-16-87 REM. LIMIT BLANK COMMON TO 1MBYTE IN FOREGROUND.00470001 C REVISED 09-30-87 REM. REMOVE JUSTITY/SORT CODE TO SUBROUTINE 00480001 C FJFT05. 00490001 C REVISED 10-12-87 REM. ADD DUMMF TO PARAMETER LIST OF FJPROC. 00500001 C REVISED 11-04-87 REP. CHANGE PROCLC & PROCLI ARRAY UTILIZATION. 00510001 C REVISED 12-01-87 REM. CHANGE SO FIRST OCCURRENCE = 1 NOT 0. 00520001 C REVISED 12-18-87 REP. REMOVE DUMFAT LOGIC; KPDBGA UNINITIALIZED. 00530001 C REVISED 02-04-88 CMP. REMOVE REFERENCE TO LFTAUX AND ALLOCATION 00540001 C FOR SIN/COS TABLES. (BY REP) 00550001 C REVISED 04-14-88 REM. FREE BLANK COMMON (AND ALL SUBPOOL 1) WITH 00560001 C FRESP1 INSTEAD OF FREMN2. 00570001 C REVISED 04-15-88 LWC. ADD CHECK FOR PROCESSES BEFORE AN INPUT 00580001 C PROCESS THAT ARE NOT A PREP ONLY OR AN 00590001 C OUTPUT PROCESS. 00600001 C REVISED 04-28-88 TJT. MADE LCGRPI FLOATING POINT. 00610001 C REVISED 06-13-88 ESN. MODIFY LINE CARD DOCUMENTATION TO INDICATE 00620001 C FLOATING POINT OK FOR LCGRPI. 00630001 C REVISED 01-09-89 REM. CHECK FOR ERROR AFTER FSPMAP. 00640001 C REVISED 12-06-89 ESN. REMOVE MEMORY ALLOCATION AFTER S2SCG2. 00650001 C REVISED 09-30-91 ESN. CHECK FIRST 3 CHAR OF JOBID WITH 'TSU'. 00660001 C REVISED 01-13-92 ESN. CHANGE ACCT CARD FOR 'D' AND 'O' OPTIONS. 00670001 C REVISED 01-27-92 ESN. IF ACCOUNT CODE NOT SPECIFIED ON 'ACCT' 00680001 C CARD, END WITH ERROR MESSAGE INSTEAD 00690001 C OF DEFAULTING IT TO '21598'. 00700001 CA 00710001 CA 00720001 CA THIS PROGRAM CALLS EACH PREPARATION PROGRAM ONE TIME. 00730001 CA 00740001 CA THE PREPARATION PROGRAMS TO BE EXECUTED ARE SELECTED FROM THE 00750001 CA "PROC" CARD. 00760001 CA 00770001 CA A KP-AREA ENTRY IS GENERATED FOR EACH PREPARATION PROGRAM 00780001 CA PRIOR TO CALLING THE PREP ROUTINE. THE KP-AREA IS THE SAME FOR 00790001 CA EACH PROCESS. 00800001 CA 00810001 CA MOST SUMMARY PROGRAMS ARE NOT CALLED BECAUSE PROTAB IS NOT 00820001 CA PRESENT. 00830001 CA 00840001 CA FILE ASSIGNMENTS: 00850001 CA 00860001 CA DDNAME ALLOCATION DATA SET 00870001 CA ------ ---------- -------- 00880001 CA FT01F001 CLIST USER'S INPUT DATA SET 00890001 CA FT02F001 DYNAMIC TSO SCREEN FOR STATUS MESSAGES 00900001 CA FT98F001 DYNAMIC SPARC PRINTER OUTPUT, EITHER 00910001 CA 1. PRINTER 00920001 CA 2. HOLD QUEUE 00930001 CA 3. TERMINAL 00940001 CA 4. DUMMY 00950001 CA -------- DYNAMIC TEMPORARY DIRECT ACCESS FILE FOR SORTING00960001 CA DATA CARDS 00970001 CA 00980001 CA 00990001 CA ERROR MESSAGES. 01000001 CA -1. MESSAGE HAS BEEN PRINTED BY PROCESSING PROGRAM. 01010001 CA -2. ACCOUNT CARD NOT FOUND IN PARAMETER/CARD FILE. 01020001 CA -3. LINE CARD NOT FOUND IN PARAMETER/CARD FILE. 01030001 CA THE RETURN FLAG MCRTF IS SET EQUAL TO THE MESSAGE NUMBER. 01040001 C EJECT 01050001 CUPAGE CONTROL 01060001 CUINDX 01070001 CUINDX CONTROL CARDS 01080001 CU PROCESS ACCT -- REQUIRED FOR ACCOUNTING 01090001 CU DATA CARD (1) -- ACCOUNTING INFORMATION 01100001 CU 01110001 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 01120001 CU PRECEDES LINE CARD 01130001 CU REQ OR OPT 01140001 CU DF COLS DEFINITION OR DEFAULT 01150001 CU -- ----- ---------- -----------01160001 CU 1 1- 4 'ACCT' | REQ |01170001 CU 2 5- 6 NOT USED | |01180001 CU 3 7-11 ACCOUNTING ORGANIZATION CODE. | REQ |01190001 CU 4 12 COMPUTER SELECTION FLAG | |01200001 CU 'C' FOR EXECUTION ON THE CRAY | |01210001 CU 'D' DISCOUNT JOB ON THE CRAY | |01220001 CU 'I' FOR EXECUTION ON THE IBM | |01230001 CU BLANK FOR AUTOMATIC SELECTION | |01250001 CU 5 13 NOT USED | |01260001 CU 6 14-15 REGION NUMBER (OR USER CODE) | REQ |01270001 CU 7 16-20 PROJECT NUMBER | REQ |01280001 CU 8 21-38 LINE NAME OR NUMBER, ALPHA-NUMERIC CHARACTERS | REQ |01290001 CU ONE TO EIGHTEEN CHARACTERS IF FIRST IS | |01300001 CU ALPHABETIC. | |01310001 CU ONE TO SEVENTEEN CHARACTERS IF FIRST IS NUMERIC.| |01320001 CU HYPHEN MAY BE USED--NOT AS FIRST CHARACTER. | |01330001 CU EMBEDDED BLANKS MAY NOT BE USED. THE FIRST EIGHT| |01340001 CU CHARACTERS OF THIS NAME WILL BE USED AS THE | |01350001 CU FOURTH PART OF THE DATA SET NAME USED BY THE | |01360001 CU S/370 TO CATALOG AND LOCATE THE DATA. | |01370001 CU 9 39-70 AREA NAME | REQ |01380001 CU 10 71 NOT USED | |01390001 CU 11 72-74 CPU TIME IN MINUTES | REQ |01400001 CU 12 75-76 'CR', 'DM', 'SL', 'VA', 'LP', 'MP', 'VP', | REQ |01410001 CU OR 'SA' | |01420001 CU 13 77-80 NUMBER OF BILLABLE SHOTPOINTS | REQ |01430001 CU -----------01440001 CU 01450001 CU DF NOTES (BY COLUMN NUMBERS) 01460001 CU -- ----- 01470001 CU 01480001 CU 3 7-11 ORGANIZATION CHARGE CODE. (45365, 45373, & 45381 FOR GAP). 01490001 CU R & D AND DISTRICTS SHOULD USE THEIR ACCOUNTING CODES. 01500001 CU 01510001 CU 4 12 PLEASE CONSULT THE SPARC USER'S GUIDE TABLE OF CONTENTS FOR 01520001 CU INFORMATION ABOUT THE AVAILABILITY OF PROCESSES ON THE CRAY 01530001 CU COMPUTER. 01540001 CU 01550001 CU CONTINUED 01560001 CU EJECT 01570001 CU 01580001 CU 6 14-15 REGION NUMBER IS USED FOR ACCOUNTING AND FILE NAMES. 01590001 CU 01 - GAP 61 - SOUTHEAST OFFSHORE 01600001 CU 02 - LAND ACQUISITION 62 - SOUTHEAST ONSHORE 01610001 CU 03 - MARINE ACQUISITION 71 - WESTERN OFFSHORE 01620001 CU 04 - GEO. ANAL. - TECHNIQUES 72 - CALIFORNIA EXPLOITATION 01630001 CU 06 - ARCO INTERNATIONAL 81 - MID-CONTINENT 01640001 CU 07 - OUTSIDE DATA SALES 82 - PERMIAN EXPLOITATION 01650001 CU 08 - EXPLORATION DATA MGNT 90 - SOUTH ALASKA 01660001 CU 09 - GEO. ANAL. - PROJECTS 91 - NORTH ALASKA 01670001 CU 13 - EXPLORATION STAFF 92 - ALASKA EXPLOR. KUPARAK 01680001 CU 14 - GEO. ANAL. - MODELLING 94 - ALASKA EXPLOR. PRUDHOE 01690001 CU 51 - SOUTHERN OFFSHORE 99 - R & D PROGRAMMING 01700001 CU 52 - SOUTHERN ONSHORE 01710001 CU 01720001 CU 01730001 CU 12 75-76 USE THE CODE THAT SIGNIFIES THE PRIMARY REASON FOR THIS 01740001 CU RUN. USE 'LP' OR 'MP' IF NONE OF THE OTHERS FITS. 01750001 CU 'CR' - COLOR RUNS (QUAD) 'LP' - LAND PROCESSING 01760001 CU 'DM' - MIGRATION (DMIG, MIGR) 'MP' - MARINE PROCESSING 01770001 CU 'VA' - VELOCITY ANALYSIS (VELA) 'SL' - SEISMIC LOGS(SLOG) 01780001 CU 'SA' - SPECIAL ANALYSIS & TEST 'VP' - VERTICAL PROFILING 01790001 CU 01800001 CU 13 77-80 THIS FIELD IS USED TO CONTAIN THE NUMBER OF SHOTPOINTS TO 01810001 CU BE BILLED. 01820001 CU (BILLABLE SHOTPOINTS) * (UNIT COST) = ESTIMATED CHARGES 01830001 CUEND 01840001 C 01850001 CU LINE -- REQUIRED FOR JOB SETUP 01860001 CU DATA CARD (1) -- LINE INFORMATION 01870001 CU 01880001 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 01890001 CU FOLLOWS ACCT CARD 01900001 CU REQ OR OPT 01910001 CU DF COLS DEFINITION OR DEFAULT 01920001 CU -- ----- ---------- -----------01930001 CU 1 1- 4 'LINE' | REQ |01940001 CU 2 5 NOT USED | |01950001 CU 3 6 TYPE OF INTERPOLATION | L |01960001 CU 'L' = LINEAR | |01970001 CU 'N' = NO INTERPOLATION | |01980001 CU 4 7 PROCESSING MODE | S |01990001 CU 'S' = SHOTPOINT NUMBER | |02000001 CU 'D' = DEPTH POINT NUMBER | |02010001 CU 5 8-10 FOR PROGRAMMING USE | |02020001 C FOR PROGRAMMER'S USE (DEBUG PRINT LEVEL), | |02030001 C # = LEVEL 3. LEVELS 1 AND 2 NOT USED. | |02040001 CU 6 11-15 BEGINNING SHOTPOINT OR DEPTH POINT | REQ |02050001 CU 7 16-20 ENDING SHOTPOINT OR DEPTH POINT | REQ |02060001 CU 8-9 21-30 NOT USED | |02070001 CU 10 31-35 NUMBER OF SHOTPOINTS ON LINE | REQ |02080001 CU 11 36-40 NUMBER OF TRACES PER SHOTPOINT | REQ |02090001 CU 12 41-45 INPUT RECORD LENGTH (MS)--8000 SAMPLES MAX. | REQ |02100001 CU 13 46-50 INPUT SAMPLE INTERVAL (MS) | REQ |02110001 CU 14 51-55 PROCESSING SAMPLE INTERVAL (MS) | DF13 |02120001 CU 15 56-60 GEOPHONE GROUP INTERVAL | REQ |02130001 CU 16 61-65 MAXIMUM NUMBER OF TRACES PER COMMON DEPTH POINT | DF11 |02140001 CU 17 66-70 NUMBER OF EQUIVALENT SHOTPOINTS | DF10 |02150001 CU 18 71-75 MAXIMUM NUMBER OF 3-D LINES | OPT |02160001 CU 19 76-80 RUN CODE. 'PREP' = PREPARATION STEP ONLY | REQ |02170001 CU 'PROC' = PREPARATION AND PROCESSING | |02180001 CU -----------02190001 CU DF NOTES 02200001 CU -- ----- 02210001 CU 10 THE NUMBER OF EQUIVALENT SHOTPOINTS TO BE PROCESSED IS PLACED IN 02220001 CU DF17. DF10 OF THE LINE CARD IS THE TOTAL NUMBER OF SHOTPOINTS 02230001 CU ON THE LINE. 02240001 CU 02250001 CU 12 MAXIMUM 8000 SAMPLES INPUT ON IBM. 02260001 CU MAXIMUM 16000 SAMPLES INPUT ON CRAY. 02270001 CU MAXIMUM 8000 SAMPLES OUTPUT ALLOWED ON BOTH MACHINES. 02280001 CU 02290001 CU 14 WHEN THE PROCESSING SAMPLE INTERVAL DOES NOT EQUAL THE INPUT 02300001 CU SAMPLE INTERVAL, THE READ PROCESS WILL RESAMPLE THE INPUT DATA 02310001 CU TO THE PROCESSING SAMPLE INTERVAL. 02320001 CU 02330001 CU 15 DECIMAL POINT IS OK. 02340001 CU 02350001 CU 16 USE ONE IF INPUT DATA IS STACKED. 02360001 CU 02370001 CU CONTINUED 02380001 CU EJECT 02390001 CU 17 THIS FIELD IS USED TO AID IN ALLOCATING SPACE FOR OUTPUT DATA 02400001 CU SETS. IT WILL DEFAULT TO THE NUMBER OF SHOTPOINTS ON THE LINE. 02410001 CU THIS FIELD MAY BE USED TO CORRECT THE NORMAL SPACE ALLOCATION 02420001 CU ROUTINES BECAUSE THE OUTPUT IS LESS (FOR WHATEVER REASON) THAN 02430001 CU NORMALLY EXPECTED OR WHEN THE OUTPUT IS GREATER (POSSIBLY BECAUSE02440001 CU OF A LARGE NUMBER OF HISTORY RECORDS) THAN NORMALLY EXPECTED. IF02450001 CU IT IS NECESSARY TO ENTER A VALUE, IT MAY BE CALCULATED BY: 02460001 CU 02470001 CU NUMBER OF EQUIVALENT SHOTPOINTS 02480001 CU 02490001 CU MAX NUMBER OF TRACES IN ANY OUTPUT 02500001 CU = ------------------------------------ . 02510001 CU NUMBER OF TRACES PER SHOTPOINT 02520001 CUEND 02530001 C 02540001 CU COMM -- USER COMMENT 02550001 CU DATA CARD (1) -- COMMENT CARD 02560001 CU 02570001 CU NO. OF CARDS: REQUIRED = 0 ALLOWED = 1 02580001 CU FOLLOWS LINE CARD 02590001 CU REQ OR OPT 02600001 CU DF COLS DEFINITION OR DEFAULT 02610001 CU -- ----- ---------- -----------02620001 CU 1 1- 4 'COMM' | REQ |02630001 CU 2 5 NOT USED | |02640001 CU 3 6 NOT USED | |02650001 CU 4 7 NOT USED | |02660001 CU 5 8-10 NOT USED | |02670001 CU 6 11-80 USER COMMENT |NOTE DF6 |02680001 CU -----------02690001 CU 02700001 CU DF NOTES 02710001 CU -- ----- 02720001 CU 6 SUBMIT A SINGLE COMMENT WITH A MAXIMUM OF 70 CHARACTERS. THIS 02730001 CU COMMENT WILL AUTOMATICALLY BE PRINTED IN THE HEADING OF EACH 02740001 CU SPARC PROCESS OF THE JOB. THE USER MUST CENTER THIS COMMENT IN 02750001 CU DF6 IF PAGE CENTERING IS DESIRED. 02760001 CU 02770001 CUEND 02780001 C 02790001 CU PARM -- GENERAL PARAMETER CARD 02800001 CU DATA CARD (1) -- PARAMETER CARD 02810001 CU 02820001 CU NO. OF CARDS: REQUIRED = 0 ALLOWED = 1 02830001 CU 02840001 CU REQ OR OPT 02850001 CU DF COLS DEFINITION OR DEFAULT 02860001 CU -- ----- ---------- -----------02870001 CU 1 1- 4 'PARM' | REQ |02880001 CU 2 5 NOT USED | |02890001 CU 3 6 NOT USED | |02900001 CU 4 7 NOT USED | |02910001 CU 5 8-10 NOT USED | |02920001 CU 6 11-15 JOB REGION SIZE, K-BYTES. (NO LONGER USED!) |NOTE DF6 |02930001 CU 7 16-20 BLANK COMMON SIZE FOR JOB, K-BYTES |NOTE DF7 |02940001 CU 21-80 NOT USED | |02950001 CU -----------02960001 CU 02970001 CU DF NOTES 02980001 CU -- ----- 02990001 CU 6 THE JOB REGION SIZE IS NO LONGER APPLICABLE TO SPARC JOBS. THE 03000001 CU JOB REGION SIZE WILL BE SUPPLIED BY JOBGEN TO AGREE WITH THE TYPE03010001 CU OF MEMORY ADDRESSING SCHEME TO BE USED IN EXECUTION. THE NORMAL 03020001 CU SCHEME IS "EXTENDED" BUT MAY BE OVERRIDDEN ON THE SPARC EXEC 03030001 CU CARD. 03040001 CU 03050001 CU 7 THE BLANK COMMON SIZE NORMALLY WILL BE COMPUTED BY JOBGEN. THIS 03060001 CU FIELD WILL BE USED AS AN EMERGENCY OVERRIDE. 03070001 C 03080001 C JOBC -- JOB INFORMATION CARD 03090001 C DATA CARD (1) -- IBM JOB INFORMATION CARD (FOR CRAY JOBS ONLY) 03100001 C 03110001 C NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 03120001 C 03130001 C REQ OR OPT 03140001 C DF COLS DEFINITION OR DEFAULT 03150001 C -- ----- ---------- -----------03160001 C 1 1- 4 'JOBC' | REQ |03170001 C 2 5 NOT USED | |03180001 C 3 6 NOT USED | |03190001 C 4 7 NOT USED | |03200001 C 5 8-10 NOT USED | |03210001 C 11-60 NOT USED | |03220001 C 61-68 IBM JOB NAME | REQ |03230001 C 69-76 IBM JOB NUMBER | REQ |03240001 C 77-80 NOT USED | |03250001 C -----------03260001 C 03270001 C DF NOTES 03280001 C -- ----- 03290001 C THIS CARD IS ADDED TO THE DATA CARDS OF A SPARC JOB TO BE 03300001 C EXECUTED ON THE CRAY. IT IS SUPPLIED BY PROGRAM CSSJOBID. THE 03310001 C JOB NAME AND NUMBER ARE FOR THE IBM SHADOW JOB BEING EXECUTED ON 03320001 C THE IBM. WHEN THE CRAY JOB FINISHES, THIS INFORMATION IS USED 03330001 C IN THE UPDATE JOB SUBMITTED BACK FROM THE CRAY TO THE IBM SO 03340001 C THE IBM SHADOW JOB CAN BE CANCELLED. 03350001 C 03360001 C THIS IS NOT A CARD TO BE SUPPLIED BY THE USER!!. 03370001 CUEND 03380001 C 03390001 C 03400001 C LOCAL OR INTERNAL ARRAYS. 03410001 C 03420001 C CARD ( 20) = TEMPORARY STORAGE FOR ACCT CARD AND LINE CARD. 03430001 C 03440001 C 03450001 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 03460001 C 03470001 C ACCT = 'ACCT' = CODE USED TO IDENTIFY ACCOUNT CARD. 03480001 C BLANKS = ' ' = CODE FOR TESTING FOR BLANKS. 03490001 C DA = INPUT/OUTPUT INDEX TO PARAMETER AND CARD FILE. 03500001 C KPRTFM = SMALLEST RETURN FLAG (KPRTF) FROM ANY PRE-PROCESSOR. 03510001 C LCINTL = 'L ' = DEFAULT FOR LCINT (INTERPOLATION TYPE). 03520001 C LCOM = NUMBER OF WORDS OBTAINED FOR BLANK COMMON BY GETMN2. 03530001 C LCTYPS = 'S ' = DEFAULT FOR LCTYP (PROCESSING MODE). 03540001 C LINE = 'LINE' = CODE USED TO IDENTIFY LINE CARD. 03550001 C 03560001 C EJECT 03570001 PROGRAM CPPREP 03580001 C 03590001 IMPLICIT INTEGER (A-Z) 03600001 C 03610001 PARAMETER (INP=1, IPR=98, ITR=2, MXPROC=90) 03620001 C 03630001 PARAMETER (IXNA=1, IXRNO=1, IXOCUR=2, IXBUGF=3, IXPTAB=4, 03640001 * IXRTF=8, IXWARN=9, IXTIME=10, IXWKIO=11 ) 03650001 C 03660001 C COMMON AREA DECLARATIONS 03670001 C 03680001 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 03690001 COMMON /MPTABC/ PTABC(5, 250) 03700001 CHARACTER*4 PTABC 03710001 INTEGER PTABI 03720001 C 03730001 COMMON COM (1) 03740001 C 03750001 C 03760001 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 9/08/87 03770001 COMMON /P/ STARTP ( 2) 03780001 COMMON /P/ LCNAME , M00008 03790001 COMMON /P/ LCINT 03800001 COMMON /P/ LCTYP , M00020( 5) 03810001 COMMON /P/ LCNSP 03820001 COMMON /P/ LCTPSP 03830001 COMMON /P/ LCRL 03840001 COMMON /P/ LCSI 03850001 COMMON /P/ LCPI , M00060 03860001 COMMON /P/ LCMXFD , M00068 03870001 COMMON /P/ LCMXLN , M00076( 4) 03880001 COMMON /P/ ACNAME , M00096 03890001 COMMON /P/ AC64BC , M00104( 19) 03900001 COMMON /P/ ACNSP 03910001 COMMON /P/ ACUSER ( 5) , M00188( 52) 03920001 COMMON /P/ KPNA 03930001 COMMON /P/ KPRNO 03940001 COMMON /P/ KPOCUR 03950001 COMMON /P/ KPA , M00428 03960001 COMMON /P/ KPDBGA , M00436( 10) 03970001 COMMON /P/ KPIUSM 03980001 COMMON /P/ KPNUSM 03990001 COMMON /P/ KPTIME 04000001 COMMON /P/ KPRTF , M00492( 8) 04010001 COMMON /P/ KPPRNT , M00528( 2) 04020001 COMMON /P/ KPBUGF 04030001 COMMON /P/ KPWARN , M00544 04040001 COMMON /P/ KPWKIO , M00552( 21) 04050001 COMMON /P/ MCJOB ( 2) 04060001 COMMON /P/ MCSTEP ( 2) , M00648 04070001 COMMON /P/ MCCTOT 04080001 COMMON /P/ MCDELT 04090001 COMMON /P/ MCBTIM , M00668 04100001 COMMON /P/ MCBTEM ( 2) , M00676( 2) 04110001 COMMON /P/ MCBDAT ( 2) , M00692( 8) 04120001 COMMON /P/ MCRTF , M00732( 4) 04130001 COMMON /P/ MCIUSM 04140001 COMMON /P/ MCNUSM , M00756( 116) 04150001 COMMON /P/ APUNN1 , M01224( 6) 04160001 COMMON /P/ APREG1 , M01252( 9) 04170001 COMMON /P/ PTTBLK , M01292 04180001 COMMON /P/ PTFATL , M01300( 2) 04190001 COMMON /P/ PTTHL 04200001 COMMON /P/ PTTHLB , M01316( 30) 04210001 COMMON /P/ PROTAB ( 2) 04220001 COMMON /P/ ENDP 04230001 C 04240001 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 04250001 C 04260001 C CHARACTER VARIABLES 04270001 C 04280001 CHARACTER*80 CARD 04290001 CHARACTER*12 CPUID 04300001 CHARACTER*1 JCLASS 04310001 CHARACTER*8 JOBID 04320001 CHARACTER*8 JOBNAM 04330001 CHARACTER*3 TSO 04340001 C 04350001 C LOGICAL VARIABLE 04360001 C 04370001 LOGICAL BATCH 04380001 C 04390001 C CHARACTER ARRAYS 04400001 C 04410001 CHARACTER*80 PROCCD (10) 04420001 CHARACTER*4 PROCLC (6, MXPROC) 04430001 C 04440001 C INTEGER ARRAYS 04450001 C 04460001 INTEGER ACCARD (23) 04470001 INTEGER DENTRY (104) 04480001 INTEGER DUMMY (10) 04490001 INTEGER JAPNMS (4) 04500001 INTEGER LCCARD (19) 04510001 INTEGER PROCLI (15, MXPROC) 04520001 INTEGER PRCNDX (MXPROC) 04530001 C 04540001 C REAL VARIABLE 04550001 C 04560001 REAL LCGRPI 04570001 C 04580001 EQUIVALENCE (ACCARD( 1), ACNAME) 04590001 EQUIVALENCE (LCCARD( 1), LCNAME) 04600001 EQUIVALENCE (LCCARD(15), LCGRPI) 04610001 C 04620001 C DATA INITIALIZATION 04630001 C 04640001 DATA ACCT /'ACCT'/ 04650001 DATA BLANKS / ' '/ 04660001 DATA CRAY / 'CRAY'/ 04670001 DATA IBM / 'IBM '/ 04680001 DATA KPRTFM / 0 / 04690001 DATA LINE /'LINE'/ 04700001 DATA LCINTL / 'L '/ 04710001 DATA LCTYPS / 'S '/ 04720001 DATA PARM /'PARM'/ 04730001 DATA TSO /'TSU'/ 04740001 C 04750001 IF (1 .EQ. 2) THEN 04760001 CALL FOGM3D 04770001 CALL FOVF3D 04780001 CALL FOPARM 04790001 CALL FOTRCE 04800001 CALL FOSCDK 04810001 CALL S1ATP 04820001 CALL USSTHV 04830001 END IF 04840001 C 04850001 C SET DUMMY FLAG TO ALLOW USE OF DUMM PROC 04860001 C 04870001 DUMMF = 1 04880001 C 04890001 C PRELIMINARY OPERATIONS. 04900001 C 04910001 SYSTEM = IBM 04920001 SYBYPW = 4 04930001 SYLOCF = 4 04940001 CALL USRDID (CPUID) 04950001 C 04960001 IF (S1CPCH (CPUID, 1, 'CRA', 1, 3) .EQ. 0) THEN 04970001 SYSTEM = CRAY 04980001 SYBYPW = 8 04990001 SYLOCF = 1 05000001 END IF 05010001 C 05020001 CALL USCLOK (MCDELT, MCCTOT) 05030001 CALL DATIME (MCBDAT, MCBTEM, MCBTIM) 05040001 C 05050001 C OBTAIN THE JOB NAME AND STEP NAME 05060001 C 05070001 CALL JPSNAM (MCJOB) 05080001 CALL S1MVCH (MCJOB, 1, JAPNMS, 1, 16) 05090001 CALL S1MVCH ('PREP', 1, MCSTEP(1), 1, 4) 05100001 MCSTEP(2) = BLANKS 05110001 BATCH = .TRUE. 05120001 CALL JOBINF (JOBNAM, JOBID, JCLASS) 05130001 IF (JOBID(1:3) .EQ. TSO) BATCH = .FALSE. 05140001 C 05150001 CALL ERRSET (209, 1) 05160001 C 209 = DIVIDE FAULT. 1 = NO. OF ERRORS ALLOWED. 05170001 C 05180001 C SET UP THE MASTER PROCESS TABLE 05190001 C 05200001 CALL FJPTAB (IER) 05210001 IF (IER .NE. 0) GO TO 8000 05220001 C 05230001 C READ DATA CARDS TO FIND PROC CARDS AND BUILD PROC TABLE 05240001 C 05250001 CALL FJPROC (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, NCARDS, 05260001 * PROCCD, NPROCC, DUMMF, IPR, IER) 05270001 IF (IER .GE. 2) GO TO 8000 05280001 C 05290001 C***********************************************************************05300001 C NOW RE-READ THE DATA CARDS, JUSTIFY & SORT THE NECESSARY CARDS AND05310001 C CREATE FT05F001 FOR USE BY FOIP. 05320001 C ALL CARDS FOR PROCESSES NOT ON PROC CARD, ARE DISCARDED. 05330001 C***********************************************************************05340001 C 05350001 ITR1 = 0 05360001 IF (.NOT. BATCH) ITR1 = ITR 05370001 CALL FJFT05 (PROCLC, PROCLI, MXPROC, NPROC, NCARDS, PROCCD, 05380001 * NPROCC, INP, ITR1, IPR, ERR) 05390001 C 05400001 IF (ERR .NE. 0) THEN 05410001 IF (BATCH) THEN 05420001 WRITE (IPR, 9010) ERR, ERRIN 05430001 ELSE 05440001 WRITE (ITR, 9010) ERR, ERRIN 05450001 END IF 05460001 GO TO 8000 05470001 END IF 05480001 C 05490001 C 05500001 C***********************************************************************05510001 C OPEN THE SEISPARM FILE. 05520001 C***********************************************************************05530001 C 05540001 CALL FOIP 05550001 C 05560001 C CLOSE FT05F001 BEFORE CONTINUING 05570001 C 05580001 CLOSE (5) 05590001 C 05600001 C READ THE ACCOUNT CARD, TRANSLATE, AND MOVE TO COMMON /P/. 05610001 C 05620001 DA = 1 05630001 CALL FORC (ACCT, 0, DA, CARD, *800) 05640001 READ (CARD, 990) ACCARD 05650001 AC64BC = S1CVBN(CARD,7,5) 05660001 C 05670001 C MAKE SURE THE LAST TWO BYTES OF THE LINE NAME ARE BLANK (IBM) 05680001 CALL S1MVCH (' ',1,ACCARD,47,2) 05690001 C 05700001 C FORM CONTIGUOUS CHARACTER STRING FOR ACLNAM AND ACCOM (CRAY) 05710001 IF (SYSTEM .EQ. CRAY) THEN 05720001 CALL S1MVCH(ACCARD( 9), 1, ACCARD( 8), 5, 4) 05730001 CALL S1MVCH(ACCARD(10), 1, ACCARD( 9), 1, 4) 05740001 CALL S1MVCH(ACCARD(11), 1, ACCARD( 9), 5, 4) 05750001 CALL S1MVCH(ACCARD(12), 1, ACCARD(10), 1, 2) 05760001 CALL S1MVCH(' ' , 1, ACCARD(10), 3, 6) 05770001 ACCARD(11) = BLANKS 05780001 ACCARD(12) = BLANKS 05790001 C 05800001 CALL S1MVCH(ACCARD(14), 1, ACCARD(13), 5, 4) 05810001 CALL S1MVCH(ACCARD(15), 1, ACCARD(14), 1, 4) 05820001 CALL S1MVCH(ACCARD(16), 1, ACCARD(14), 5, 4) 05830001 CALL S1MVCH(ACCARD(17), 1, ACCARD(15), 1, 4) 05840001 CALL S1MVCH(ACCARD(18), 1, ACCARD(15), 5, 4) 05850001 CALL S1MVCH(ACCARD(19), 1, ACCARD(16), 1, 4) 05860001 CALL S1MVCH(ACCARD(20), 1, ACCARD(16), 5, 4) 05870001 ACCARD(17) = BLANKS 05880001 ACCARD(18) = BLANKS 05890001 ACCARD(19) = BLANKS 05900001 ENDIF 05910001 C 05920001 C READ THE LINE CARD, TRANSLATE, AND MOVE TO COMMON /P/. 05930001 DA = 1 05940001 CALL FORC (LINE, 0, DA, CARD, *810 )05950001 READ (CARD, 991)(LCCARD(I),I=1,14),LCGRPI,(LCCARD(I),I=16,19) 05960001 IF (ACNSP .EQ. 0 ) ACNSP = LCTPSP 05970001 IF (AC64BC .EQ. 0 ) GO TO 840 05980001 IF (LCINT .EQ. BLANKS) LCINT = LCINTL 05990001 IF (LCMXFD .EQ. 0 ) LCMXFD = LCTPSP 06000001 IF (LCMXLN .EQ. 0 ) LCMXLN = 1 06010001 IF (LCTYP .EQ. BLANKS) LCTYP = LCTYPS 06020001 C 06030001 C SET OTHER COMMON P VARIABLES BEFORE BEGINNING PREP EXECUTION 06040001 C 06050001 APUNN1 = 91 06060001 APREG1 = 400 06070001 PTTHLB = 760 06080001 PTTHL = PTTHLB / SYBYPW 06090001 PTTBLK = (LCRL / LCPI) * SYBYPW + PTTHLB 06100001 PTFATL = 30 06110001 C 06120001 C GET BLANK COMMON 06130001 C 06140001 CALL CPBCOM (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, IPR, BCOM, 06150001 * IER) 06160001 IF (IER .NE. 0) GO TO 8000 06170001 C 06180001 C LIMIT FOREGROUND PREPS TO MAXIMUM OF 1 MEGABYTE BLANK COMMON 06190001 C 06200001 BCOMX = BCOM 06210001 IF (JOBID(1:3) .EQ. TSO .AND. BCOM .GT. 1000) THEN 06220001 BCOMX = 1000 06230001 WRITE (IPR, 9210) 06240001 END IF 06250001 C 06260001 BCOMWD = 256 * BCOMX 06270001 MCNUSM = BCOMWD 06280001 MCIUSM = 1 06290001 CALL GETMN2 (COM, BCOMWD, MCIUSM, LCOM) 06300001 IF (BCOMWD .NE. LCOM) GO TO 820 06310001 MCIUSM = MCIUSM + 1 06320001 C 06330001 C WRITE A 'PARM' PARAMETER RECORD 06340001 C 06350001 CALL S1MVCH (PARM, 1, DENTRY(1), 1, 4) 06360001 DENTRY(6) = 1 06370001 DENTRY(9) = BCOM 06380001 DAP = 1 06390001 CALL FOWP (PARM, 0, DAP, 104, DENTRY, * 830 )06400001 C 06410001 C GET THE SUBMITTER NAME FROM THE JOB CARD (FOR BACKGROUND JOBS) 06420001 C 06430001 IF (BATCH) 06440001 * CALL JCTEXT (DUMMY(1), DUMMY(3), DUMMY(4), ACUSER(1), DUMMY(5)) 06450001 C 06460001 C DETERMINE SIN/COS TABLE SIZE 06470001 C 06480001 LFOUR = LCRL / LCPI 06490001 IF (LCRL/LCSI .GT. LFOUR) LFOUR = LCRL / LCSI 06500001 CALL S1FMAG (LFOUR, MAXMAG, LPREV) 06510001 C 06520001 CALL USS2DX (LFOURX, 6) 06530001 IF (LFOUR .GT. LFOURX) LFOURX = LFOUR 06540001 IF (LFOURX .GT. 16383) LFOURX = 16383 06550001 CALL S1FMAG (LFOURX, MAXMAG, LFOUR) 06560001 C 06570001 C ************************************************** 06580001 C *** *** 06590001 C *** GENERATE SIN/COS TABLE FOR FFT *** 06600001 C *** *** 06610001 C ************************************************** 06620001 C 06630001 CALL S2SCG2 (MAXMAG, COM(MCIUSM)) 06640001 C 06650001 C END OF PRELIMINARY OPERATIONS. 06660001 C 06670001 C***********************************************************************06680001 C MAIN LOOP 06690001 C 06700001 C LOOP THROUGH THE PROCLC TABLE AND CALL EACH PROCESS. 06710001 C 06720001 C***********************************************************************06730001 C 06740001 KPIUSM = MCIUSM 06750001 KPNUSM = MCNUSM 06760001 KPPRNT = IPR 06770001 C 06780001 DO 200 I = 1, NPROC 06790001 KPOCUR = PROCLI(IXOCUR,I) 06800001 KPBUGF = PROCLI(IXBUGF,I) 06810001 PROCLI(IXRTF,I) = 0 06820001 PROCLI(IXWARN,I) = 0 06830001 IF (KPOCUR .GT. 1) GO TO 200 06840001 IF (PROCLC(IXNA,I) .EQ. 'NODE') GO TO 200 06850001 IF (PROCLC(IXNA,I) .EQ. 'BRAN') GO TO 200 06860001 IF (PROCLC(IXNA,I) .EQ. 'PEND') GO TO 200 06870001 IF (PTABI(1,PROCLI(IXPTAB,I)) .EQ. 0) GO TO 200 06880001 CALL S1MVCH (PROCLC(IXNA,I), 1, KPNA, 1, 4) 06890001 IF (SYSTEM .EQ. CRAY) CALL S1MVCH (BLANKS, 1, KPNA, 5, 4) 06900001 KPRNO = PROCLI(IXRNO,I) 06910001 KPRTF = 0 06920001 KPWARN = 0 06930001 KPTIME = 0 06940001 KPWKIO = 0 06950001 C 06960001 C CALL THE PROCESS 06970001 C 06980001 CALL USCLOK (MCDELT,MCCPRO) 06990001 CALL CPSPCL (PROCLC(IXNA, I), * 190 )07000001 C 07010001 IF (.NOT. BATCH) THEN 07020001 WRITE (ITR, 9140) KPNA, KPRNO 07030001 C 07040001 IF (KPRTF .GE. 0 .AND. KPWARN .GE. 0) THEN 07050001 WRITE (ITR, 9150) 07060001 ELSE IF (KPRTF .LT. 0) THEN 07070001 WRITE (ITR, 9160) 07080001 ELSE 07090001 WRITE (ITR, 9170) 07100001 END IF 07110001 C 07120001 END IF 07130001 C 07140001 CALL USCUMT (KPTIME, MCDELT, MCCPRO) 07150001 C 07160001 IF (KPRTF .LT. KPRTFM) KPRTFM = KPRTF 07170001 PROCLI(IXRTF,I) = KPRTF 07180001 PROCLI(IXWARN,I) = KPWARN 07190001 PROCLI(IXTIME,I) = KPTIME 07200001 PROCLI(IXWKIO,I) = KPWKIO 07210001 GO TO 200 07220001 C 07230001 C PRINT A WARNING MESSAGE WHEN A PROCESS WAS NOT CALLED 07240001 C 07250001 190 IF (.NOT. BATCH) WRITE (ITR, 9180) PROCLC(IXNA, I) 07260001 WRITE (IPR, 9180) PROCLC(IXNA, I) 07270001 C 07280001 200 CONTINUE 07290001 C 07300001 KPRTF = 0 07310001 IF (.NOT. BATCH) 07320001 * CALL FSPMAP (PROCLC, PROCLI, MXPROC, NPROC-1, ITR, IER) 07330001 CALL FSPMAP (PROCLC, PROCLI, MXPROC, NPROC-1, IPR, IER) 07340001 IF (KPRTF .LT. KPRTFM) KPRTFM = KPRTF 07350001 C 07360001 C IF THERE IS AN INPUT PROCESS 07370001 C CHECK TO SEE IF THERE ARE PROCESSES BEFORE AN INPUT PROCESS 07380001 C OR DGEN THAT ARE NOT A PREP ONLY OR AN OUTPUT PROCESS 07390001 C 07400001 INPFG = 0 07410001 DO 250 07420001 * I = 1, NPROC 07430001 NX = PROCLI(IXPTAB,I) 07440001 IF (PTABI(5,NX) .EQ. 1 .OR. PROCLC(IXNA,I).EQ.'DGEN') INPFG = 1 07450001 250 CONTINUE 07460001 IF (INPFG .EQ. 0) GO TO 280 07470001 C 07480001 DO 270 07490001 * I = 1, NPROC 07500001 NX = PROCLI(IXPTAB,I) 07510001 IF (PTABI(5,NX).EQ.1 .OR. PROCLC(IXNA,I).EQ.'DGEN') GO TO 280 07520001 C 07530001 IF (PTABI(2,NX) .EQ. 0 .OR. PTABI(5,NX) .EQ. 2) GO TO 270 07540001 CALL S1MVCH (PROCLC(IXNA,I), 1, KPNA, 1, 4) 07550001 IF (SYSTEM .EQ. CRAY) CALL S1MVCH (BLANKS, 1, KPNA, 5, 4) 07560001 WRITE(IPR, 9230) 07570001 WRITE(IPR, 9220) KPNA 07580001 WRITE(IPR, 9240) 07590001 IF (.NOT. BATCH) THEN 07600001 WRITE(ITR, 9230) 07610001 WRITE(ITR, 9220) KPNA 07620001 WRITE(ITR, 9240) 07630001 ENDIF 07640001 KPRTFM = -7 07650001 270 CONTINUE 07660001 280 CONTINUE 07670001 C 07680001 CALL FSTIME (PROCLC, PROCLI, MXPROC, NPROC, IPR) 07690001 C 07700001 CALL FOCP 07710001 C 07720001 C CLOSE THE GM3DPARM FILE IF IT WAS USED 07730001 C 07740001 DO 410 I = 1, NPROC 07750001 C 07760001 IF (PROCLC(IXNA, I) .EQ. 'GM3D') THEN 07770001 CALL FOGMCD 07780001 GO TO 8000 07790001 END IF 07800001 C 07810001 410 CONTINUE 07820001 C 07830001 C FREE SUBPOOL 1 07840001 C 07850001 8000 CALL FRESP1 07860001 MCRTF = KPRTFM 07870001 C 07880001 IF (MCRTF .LT. 0) THEN 07890001 C 07900001 IF (S1CPCH (SYSTEM, 1, 'IBM', 1, 3) .EQ. 0) THEN 07910001 STOP 16 07920001 ELSE 07930001 CALL XDUMPX 07940001 END IF 07950001 C 07960001 END IF 07970001 C 07980001 STOP 07990001 C 08000001 C ERROR RETURNS FROM CARD FETCH PROGRAM FORC. 08010001 C 08020001 800 CONTINUE 08030001 KPRTFM = -2 08040001 GO TO 8000 08050001 C 08060001 810 KPRTFM = -3 08070001 GO TO 8000 08080001 C 08090001 820 KPRTFM = -5 08100001 IF (BATCH) THEN 08110001 WRITE (IPR, 995) MCNUSM, LCOM 08120001 ELSE 08130001 WRITE (ITR, 995) MCNUSM, LCOM 08140001 END IF 08150001 GO TO 8000 08160001 C 08170001 830 KPRTFM = -9 08180001 WRITE (IPR, 9190) 08190001 GO TO 8000 08200001 C 08210001 840 KPRTFM = -7 08220001 WRITE (IPR, 9250) 08230001 GO TO 8000 08240001 C 08250001 C FORMAT STATEMENT FOR THE ACCT CARD. 08260001 C 08270001 C ACCOUNT CODE (SECOND "A4" & 1X BELOW) WILL BE REDONE AS AN 08280001 C INTEGER USING S1CVBN. 08290001 990 FORMAT (A4,A2,A4,1X,A1,A1,I2,I5,4A4,A2,8A4,1X,I3,A2,I4) 08300001 C 08310001 C FORMAT STATEMENT FOR THE LINE CARD. 08320001 C 08330001 CC991 FORMAT (A4,3A1,2X,A1,2I5,2X,2A4,9I5,1X,A4) 08340001 991 FORMAT (A4,3A1,2X,A1,2I5,2X,2A4,5I5,F5.0,3I5,1X,A4) 08350001 C 08360001 995 FORMAT (/5X,'CALL TO GETMN2 FAILED. MCNUSM = ',I12,' LCOM = ',I12)08370001 C 08380001 9010 FORMAT ('0ERROR JUSTIFYING/SORTING DATA CARDS.') 08390001 C 08400001 9140 FORMAT (' ',30('#')/' ### ',A4,I1) 08410001 C 08420001 9150 FORMAT (' ### NO ERRORS'/1X,30('#')) 08430001 C 08440001 9160 FORMAT (' ### ERROR MESSAGES ISSUED'/1X,30('#')) 08450001 C 08460001 9170 FORMAT (' ### WARNING MESSAGES ISSUED'/1X,30('#')) 08470001 C 08480001 9180 FORMAT (1X,30('#')/' ### ',A4,' IS NOT SUPPORTED',/, 08490001 * ' ### PROCESS WAS SKIPPED AND NO CHECKING WAS PERFORMED', 08500001 * /,1X,30('#')) 08510001 C 08520001 9190 FORMAT (/5X,'*** ERROR OCCURRED IN FOWP ***') 08530001 C 08540001 9210 FORMAT (/5X,' FOREGROUND PREP LIMITED TO MAXIMUM OF 1 ', 08550001 * 'MEGABYTE') 08560001 C 08570001 9220 FORMAT(' *** ERROR, PROCESS ',A4,' NOT ALLOWED BEFORE INPUT', 08580001 * ' PROCESS ***') 08590001 9230 FORMAT(//' ***************************************************', 08600001 * '*********') 08610001 9240 FORMAT(' ***************************************************', 08620001 * '*********') 08630001 C 08640001 9250 FORMAT (/5X,'*** NO ORGANIZATION CHARGE CODE SPECIFIED ON THE', 08650001 * ' ACCT CARD ***') 08660001 C 08670001 END 08680001