CTITLECSEXEC -- CONTROL PROGRAM FOR PROCESSING STEP 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR/DESIGNER FRANCIS COLLINS 00020002 CA LANGUAGE FORTRAN 77 00030002 CA SYSTEM IBM AND CRAY 00040002 CA WRITTEN 1-28-75 00050002 CA 00060002 CA 00070002 C REVISED 1-21-76 BY AUTHOR. ADD EXTERNAL USSTHV. 00080002 C REVISED 2-23-76 R. MCMILLAN. ADD GETMN2 CALL TO GET BLANK 00090002 C COMMON. 00100002 C REVISED 4-06-76 R. MCMILLAN. ADD S2SCG2 CALL FOR S2FFT2 AND A 00110002 C CHECK FOR ONLY ONE PROCESS (PEND). 00120002 C REVISED 10-15-76 MENDEKE - ADDED CALL TO ERRSET 00130002 C REVISED 03-03-77 MENDEKE - SET MCEOFF = 0 IF NO INPUT PROCESS 00140002 C PRESENT. ALSO INITIALIZED KPRTF=KPDRTF. 00150002 C REVISED 03-09-77 REM - ADD CALL TO CSDSN. 00160002 C REVISED 08-10-77 PKC - SET MCMITF=1 AT 10+2, 00170002 C SET MCBRNF=-86 AT 400+1. 00180002 C REVISED 09-11-77 GCW - DOUBLED SIZE OF FFT COS TABLE. 00190002 C REVISED 03-31-78 JGM - VPSS CODE ADDED. 00200002 C REVISED 04-27-78 JGM - VPSS CODE REMOVED 00210002 C REVISED 10-02-78 REM - REMOVE COMMENT FROM CALL TO CSACCT. 00220002 C REVISED 11-15-79 JGM - ADDED LCMXLN TO COMMON P 00230002 C REVISED 09-02-80 REM - MAKE FFT SIN/COS TABLE BE MAX SAMPLES 00240002 C BASED ON LCSI OR LCPI. 00250002 C REVISED 11-14-80 HHL - ADDED CHANGES SO THAT IF A PROCESS 00260002 C ABANDONS IN A BRAN, ALL PREVIOUS 00270002 C PROCESSES BACK UP TO THE BRAN OR THE 00280002 C NEXT WRIT SHOULD NOT CONTINUE TO 00290002 C EXECUTE. IF NO WRIT OR OUTPUT PROCESS 00300002 C EXISTS THEN THE JOB SHOULD TERMINATE. 00310002 C REVISED 01-20-81 HHL - CORRECTED ERROR OF MISSPELLED 00320002 C MCIKPE VARIABLE. 00330002 C REVISED 04-07-81 HHL - CORRECTED ERROR OF SETTING BRAN TO 00340002 C INACTIVE WHEN A PROCESS ABANDONS IN 00350002 C THAT BRAN. 00360002 C REVISED 04-08-81 REM - ADDED EXTRNAL FOR PLOTS. 00370002 C REVISED 12-15-82 JBC - ADDED CHANGES SO THAT IF A PROCESS 00380002 C ABANDONS AND ALL PREVIOUS PROCESSES 00390002 C BACK UP TO AN INPUT PROCESS HAS BEEN 00400002 C ABANDONED THEN THE INPUT PROCESS WILL 00410002 C BE ABANDONED AND THE JOB TERMINATED. 00420002 C REVISED 03-14-83 REM. MOVE BLANK COMMON OVERRIDE TO PARM CARD 00430002 C AND PUT ALLOCATION # OF SP ON LINE CARD. 00440002 C REVISED 11-28-83 CMP. MOVE LINE NAME FIELD TO ACCT CARD AND 00450002 C RETRIEVE ACUSER FROM JOB CARD. 00460002 C REVISED 2-14-84 REM. GATHER ELAPSED TIME STATISTICS FOR EACH 00470002 C PROCESS. 00480002 C REVISED 10-03-84 REP. CONVERT TO VS FORTRAN. 00490002 C REVISED 12-05-84 RDK. DUAL IBM/CRAY VERSION. 00500002 C REVISED 01-10-85 RDK. REMOVE CHECK FOR IBM CPUID. 00510002 C REVISED 02-05-85 RDK. REMOVE CHECK FOR CRAY CPUID SUFFIX. 00520002 C REVISED 02-15-85 LBL. DUMMY CALLS TO UPAPER, USGETZ, UPHOST, 00530002 C USSTHV, PLOTS. 00540002 C COMMENTED OUT THESE EXTERNALS. 00550002 C REVISED 04-24-85 REM. ADD CHECK OF TICD FOR R&D'S PASS,PASC,ETC.00560002 C REVISED 06-11-85 RDK. ADD EXCESS OF FFT COMMON OVER JOBGEN 00570002 C PREDETERMINATION TO COMMON ON PARM CARD; 00580002 C ADD CALL TO USS2DX. 00590002 C REVISED 11-19-85 JBC. TOTAL REWORK OF LOGIC TO ABANDON PROCESSES00600002 C UPSTREAM TO A OUTPUT PROCESS OR A BRAN. 00610002 C THIS FIXES THE PROBLEM OF TRACE LOSS TO 00620002 C NEXT BRAN. 00630002 C REVISED 11-26-85 RKG. INCORPORATED CHANGES FROM DJP TO ALLOW 00640002 C INTERACTIVE SPARC PROCESSING. 00650002 C REVISED 05-12-86 REM. CHANGE ACCOUNT CODE FROM ACCT CARD TO 00660002 C INTEGER BECAUSE OF NEW ACCOUNTING CODES. 00670002 C REVISED 06-23-86 ESN. MODIFY S2SCG2 MEMORY ALLOCATION FOR IBM VF00680002 C REVISED 07-24-86 ESN. ALLOW UNLIMITED NUMBER OF VECTOR 00690002 C UNDERFLOWS WITH AUTOMATIC HARDWARE FIXUP. 00700002 C REVISED 07-28-86 ESN. CALL USSTAT AND ALLOCATE MEMORY FOR 00710002 C STATIC SHIFT COEFFICIENTS. 00720002 C REVISED 08-21-86 JMP. MOVE FOCP AFTER CSSMRY SO EXECUTION 00730002 C ANALYZER WILL WORK PROPERLY. 00740002 C REVISED 09-08-86 REM. SET KPRTR=-100 WHEN A PROCESS IS ABANDONED00750002 C BECAUSE OF A FOLLOWING ABANDONED PROCESS. 00760002 C ALSO CORRECT FAT ADDRESSING WHEN 00770002 C ABANDONING PROCESSES. 00780002 C REVISED 09-09-86 ESN. UPDATE THE FFT LENGTH TABLE FOR CORRECT 00790002 C LENGTHS FOR COMPLEX FFT'S. 00800002 C REVISED 01-07-87 RDK. AUGMENT THE LFTAUX TABLE TO CORRECT 00810002 C LENGTH FOR COMPLEX FFT'S. 00820002 C REVISED 03-17-87 DJP. CLOSE AND UNALLOCATE THE HISTORY RECORDS 00830002 C WORKFILE AND FREE THE MEMORY USED AS BLANK00840002 C COMMON 00850002 C REVISED 03-27-87 ESN. CLOSE THE DIRECT HISTORY RECORDS DCB WITH 00860002 C FOCDD INSTEAD OF FOCSD. 00870002 C REVISED 06-03-87 DJP. CHANGED THE PRINT UNIT FROM 6 TO 99 00880002 C REVISED 06-09-87 DPH. REPLACE READING OF BLANK COMMON SIZE FROM 00890002 C PARM CARD WITH READ FROM PARM RECORD. 00900002 C REVISED 09-14-87 REM. USE JOBID TO TEST FOR FOREGROUND EXECUTION00910002 C REVISED 11-06-87 REP. CALL CSCOMP TO BUILD COMMON P & REMOVE 00920002 C CSDSN CALL. 00930002 C REVISED 12-18-87 REP. CHANGE TO USE KPDBGN INSTEAD OF KPDBGA TO 00940002 C DETERMINE I/O FLAG. 00950002 C REVISED 02-03-88 CMP. COMPUTE BLANK COMMON FOR SIN/COS TABLES ON00960002 C CRAY ONLY. 00970002 C REVISED 04-14-88 REM. FREE BLANK COMMON (AND ALL SUBPOOL1) WITH 00980002 C FRESP1 INSTEAD OF FREMN2. 00990002 C REVISED 04-28-88 TJT. MADE LCGRPI FLOATING POINT. 01000002 C REVISED 11-09-88 RDK. ADD OPAP COMMON BLOCK AND UNALLOCATE ANY 01010002 C HISTORY WORKFILES TO PREVENT ABEND C03. 01020002 C REVISED 11-18-88 RDK. ADD A CALL TO FOCDD FOR OPAP ON THE CRAY. 01030002 C REVISED 12-06-89 ESN. REMOVE MEMORY ALLOCATION FOR CRAY FFT'S 01040002 C (CRAY S2SCG2 USE GETMN2 SINCE 7/7/88). 01050002 C REVISED 09-30-91 ESN. COMPARE 3 CHARS OF JOBID WITH 'TSU'. 01060002 C REVISED 01-27-92 ESN. IF ACCOUNT CODE NOT SPECIFIED ON 'ACCT' 01070002 C CARD, END WITH ERROR MESSAGE INSTEAD 01080002 C OF DEFAULTING IT TO '21598'. 01090002 CA 01100002 CA 01110002 CA NORMAL SEQUENCE -- THIS PROGRAM INDEXES THROUGH THE LIST OF 01120002 CA PROCESSING PROGRAMS IN THE PROTAB ARRAY IN COMMON /P/ AND CALLS 01130002 CA EACH PROGRAM IN TURN. AT THE END OF THE LIST THE PROGRAM GOES 01140002 CA BACK TO THE START OF THE LIST AND INDEXES THROUGH AGAIN. 01150002 CA 01160002 CA NORMAL TERMINATION -- WHEN END OF DATA SET IN ENCOUNTERED BY 01170002 CA THE READ PROGRAM, WHICH IS ALWAYS THE FIRST PROGRAM ON THE LIST. 01180002 CA 01190002 CA I. EXCEPTIONS TO NORMAL SEQUENCE. 01200002 CA 01210002 CA A. FOLLOWING THE CALL OF A PROCESSING PROGRAM. 01220002 CA 01230002 CA 1. IF THE PROCESS WAS ABANDONED (KPRTF = -1) SKIP FORWARD 01240002 CA TO THE NEXT BRANCH WHICH HAS A TRACE AVAILABLE FOR 01250002 CA PROCESSING. ALL PREVIOUS PROCESSES IN THE BRANCH BACK 01260002 CA UP TO AN OUTPUT PROCESS WILL BE MADE INACTIVE 01270002 CA (KPRTF WILL BE SET TO -1). 01280002 CA 01290002 CA 2. IF THE PROCESS RETURNED AN ERROR CODE (KPRTF < -1), 01300002 CA STOP THE JOB. 01310002 CA 01320002 CA 3. IF THE PROCESS RETURNED NO OUTPUT TRACE (KPRTF = 0), 01330002 CA SKIP TO NEXT BRANCH WITH TRACE AVAILABLE TO PROCESS. 01340002 CA 01350002 CA B. AT THE END OF THE LIST. 01360002 CA IF THERE ARE ANY MULTIPLE-OUTPUT PROCESSES (WHICH MUST BE 01370002 CA CALLED AGAIN FOR MORE OUTPUT BEFORE ACCEPTING ANY MORE 01380002 CA INPUT), ENTER THE LIST AT THE LAST SUCH PROCESS. 01390002 CA 01400002 CA C. BEFORE CALLING THE PROCESS. 01410002 CA 01420002 CA 1. IF THE PROCESS WAS PREVIOUSLY MADE INACTIVE, SKIP TO 01430002 CA THE NEXT BRANCH WHICH HAS A TRACE TO PROCESS. 01440002 CA 01450002 CA 2. IF THE LIST WAS ENTERED AT A MULTIPLE-OUTPUT PROCESS 01460002 CA (CASE B ABOVE), AND IF THE BRANCH CONTAINING THIS PRO- 01470002 CA CESS HAS BEEN FINISHED, SKIP TO THE END OF THE LIST 01480002 CA (THE END PROCESS IS ALWAYS SDPEND). 01490002 CA 01500002 CA 3. SAME FOR A MULTIPLE-TRACE PROCESS (CASE II BELOW). 01510002 CA 01520002 CA II. EXCEPTION TO NORMAL TERMINATION. 01530002 CA IF THERE ARE MULTIPLE-TRACE PROCESSES (WHICH HAVE MORE OUT- 01540002 CA PUT EVEN THOUGH THERE IS NO MORE INPUT), ENTER THE LIST AT 01550002 CA THE FIRST SUCH PROCESS. 01560002 CA 01570002 CA 01580002 CA ERROR MESSAGES. 01590002 CA -1. MESSAGE HAS BEEN PRINTED BY PROCESSING PROGRAM. 01600002 CA -2. ACCOUNT CARD NOT FOUND IN PARAMETER/CARD FILE. 01610002 CA -3. LINE CARD NOT FOUND IN PARAMETER/CARD FILE. 01620002 CA -4. TOO MANY MULTIPLE-OUTPUT PROCESSES. 01630002 C THAT IS, MCNMOP IS GREATER THAN MCMMOP, AND THE ARRAY 01640002 C MCMOTF IS FULL. TWO PROGRAM CHANGES ARE NECESSARY FOR 01650002 C THIS JOB TO RUN. 01660002 C (1) IN THE PTABMSTR CONTROL TABLE, INCREASE MCMMOP. 01670002 C (2) IN THE PTABDEF LIST FOR COMMON /P/, SET THE DIMENSION 01680002 C OF MCMOTF EQUAL TO MCMMOP. 01690002 CA -5. NOT ENOUGH MEMORY OBTAINED FOR BLANK COMMON. 01700002 C 01710002 C 01720002 C 01730002 C ****************************************************************** 01740002 C 01750002 C FORMATS FOR THE LINE AND ACCOUNT CARDS CAN BE FOUND IN "CPEXEC" 01760002 C 01770002 C ****************************************************************** 01780002 C 01790002 C EJECT A NEW PAGE MAY BE DESIRABLE HERE. PUT EJECT IN COL. 7. 01800002 C METHOD OF CALCULATION. 01810002 C 01820002 C ASSUMPTIONS, THEORY, EQUATIONS, ETC. 01830002 C THIS SECTION MAY BE SHORT, OR MAY BE OMITTED ALTOGETHER, 01840002 C IF THE SUBJECT IS THOROUGHLY COVERED IN THE TECHNICAL MANUAL. 01850002 C HOWEVER, THIS SECTION MAY BE A GREAT HELP IF IT BRIDGES THE GAP 01860002 C BETWEEN THE PROGRAM AND THE TECHNICAL MANUAL. FOR EXAMPLE, 01870002 C THIS SECTION CAN RELATE EQUATION NUMBERS IN THE TECHNICAL MANUAL 01880002 C TO FORTRAN STATEMENT NUMBERS IN THE PROGRAM, AND MATHEMATICAL 01890002 C SYMBOLS IN THE TECHNICAL MANUAL TO FORTRAN NAMES IN THE PROGRAM. 01900002 C TO RECORD SUCH RELATIONS, THIS SECTION WOULD HAVE TO BE WRITTEN 01910002 C AFTER THE TECHNICAL MANUAL AND THE PROGRAM ARE OTHERWISE 01920002 C COMPLETE, AND OF COURSE THIS WILL SELDOM BE DONE (MAYBE NEVER). 01930002 C 01940002 C 01950002 C LOCAL OR INTERNAL ARRAYS. 01960002 C 01970002 C CARD ( 20) = TEMPORARY STORAGE FOR ACCT CARD AND LINE CARD. 01980002 C 01990002 C 02000002 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 02010002 C 02020002 C ACCT = 'ACCT' = CODE USED TO IDENTIFY ACCOUNT CARD. 02030002 C WRIT = 'WRIT' = CODE USED TO IDENTIFY WRIT PROCESSES. 02040002 C READ = 'READ' = CODE USED TO IDENTIFY READ PROCESSES. 02050002 C BLANKS = ' ' = CODE FOR TESTING FOR BLANKS. 02060002 C BRANCH = 'BRAN' = CODE USED TO IDENTIFY BRANCH PROCESSES. 02070002 C DA = INPUT/OUTPUT INDEX TO PARAMETER AND CARD FILE. 02080002 C DEBUGF = DEBUG FLAG (' ' = OFF). 02090002 C ICIBR = INDEX TO CURRENT BRANCH = PROTAB(MCIKPE + IPIBN) = KPIBN.02100002 C ICIBRE = PTNCW*(ICIBR - 1) = PROTAB ENTRY INDEX TO CURRENT BRANCH.02110002 C ICIND = INDEX TO CURRENT NODE = PROTAB(ICIBRE + IPIBN) = KPIBN.02120002 C IPDBGN = INDEX TO KPDBGN = (LOC(KPDBGN) - LOC(KPNA))/4 + 1. 02130002 C IPFCF = INDEX TO KPFCF = (LOC(KPFCF) - LOC(KPNA))/4 + 1. 02140002 C IPIBN = INDEX TO KPIBN = (LOC(KPIBN) - LOC(KPNA))/4 + 1. 02150002 C IPLOTF = INDEX TO KPLOTF = (LOC(KPLOTF) - LOC(KPNA))/4 + 1. 02160002 C IPMITF = INDEX TO KPMITF = (LOC(KPMITF) - LOC(KPNA))/4 + 1. 02170002 C IPNA = INDEX TO KPNA = 1 (ALWAYS FIRST ENTRY IN KP-AREA). 02180002 C IPRTF = INDEX TO KPRTF = (LOC(KPRTF) - LOC(KPNA))/4 + 1. 02190002 C LBSIGN = '#' = CODE FOR TESTING DEBUG FLAG (DEBUGF). 02200002 C LCINTL = 'L ' = DEFAULT FOR LCINT (INTERPOLATION TYPE). 02210002 C LCOM = NUMBER OF WORDS OBTAINED FOR BLANK COMMON BY GETMN2. 02220002 C LCTYPS = 'S ' = DEFAULT FOR LCTYP (PROCESSING MODE). 02230002 C LINE = 'LINE' = CODE USED TO IDENTIFY LINE CARD. 02240002 C MCRTFM = MINIMUM VALUE OF MCRTF ENCOUNTERED DURING RUN. 02250002 C PEND = 'PEND' = CODE USED TO IDENTIFY THE END PROCESS SDPEND. 02260002 C EJECT 02270002 C 02280002 C 02290002 PROGRAM CSEXEC 02300002 C 02310002 IMPLICIT INTEGER (A-Z) 02320002 C 02330002 EXTERNAL CSDBUG 02340002 C 02350002 COMMON COM (1) 02360002 C 02370002 COMMON /LHEADR/ LHNHST 02380002 COMMON /LHEADR/ LHWRKS 02390002 COMMON /LHEADR/ LHWRKD 02400002 C 02410002 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/07/87 02420002 COMMON /P/ STARTP ( 2) 02430002 COMMON /P/ LCNAME , M00008 02440002 COMMON /P/ LCINT 02450002 COMMON /P/ LCTYP , M00020( 5) 02460002 COMMON /P/ LCNSP 02470002 COMMON /P/ LCTPSP 02480002 COMMON /P/ LCRL 02490002 COMMON /P/ LCSI 02500002 COMMON /P/ LCPI , M00060 02510002 COMMON /P/ LCMXFD 02520002 COMMON /P/ LCANSP 02530002 COMMON /P/ LCMXLN , M00076( 4) 02540002 COMMON /P/ ACNAME , M00096 02550002 COMMON /P/ AC64BC , M00104( 19) 02560002 COMMON /P/ ACNSP 02570002 COMMON /P/ ACUSER ( 5) , M00188( 52) 02580002 COMMON /P/ KPNA 02590002 COMMON /P/ KPRNO , M00420 02600002 COMMON /P/ KPA , M00428( 2) 02610002 COMMON /P/ KPDBGN , M00440( 6) 02620002 COMMON /P/ KPFCF , M00468( 2) 02630002 COMMON /P/ KPIUSM 02640002 COMMON /P/ KPNUSM 02650002 COMMON /P/ KPTIME 02660002 COMMON /P/ KPRTF 02670002 COMMON /P/ KPDRTF 02680002 COMMON /P/ KPMOTF , M00500 02690002 COMMON /P/ KPIBN , M00508 02700002 COMMON /P/ KPTAMF 02710002 COMMON /P/ KPLOTF 02720002 COMMON /P/ KPMITF , M00524( 9) 02730002 COMMON /P/ KPETIM , M00564( 18) 02740002 COMMON /P/ MCJOB ( 2) 02750002 COMMON /P/ MCSTEP ( 2) 02760002 COMMON /P/ MCCPRO 02770002 COMMON /P/ MCCTOT 02780002 COMMON /P/ MCDELT 02790002 COMMON /P/ MCBTIM , M00668 02800002 COMMON /P/ MCBTEM ( 2) , M00676( 2) 02810002 COMMON /P/ MCBDAT ( 2) , M00692( 5) 02820002 COMMON /P/ MCBRNF 02830002 COMMON /P/ MCEOFF 02840002 COMMON /P/ MCMITF 02850002 COMMON /P/ MCRTF , M00732 02860002 COMMON /P/ MCIKP 02870002 COMMON /P/ MCIKPE 02880002 COMMON /P/ MCNKP 02890002 COMMON /P/ MCIUSM 02900002 COMMON /P/ MCNUSM 02910002 COMMON /P/ MCTAMF , M00760 02920002 COMMON /P/ MCI1 02930002 COMMON /P/ MCI2 02940002 COMMON /P/ MCINH 02950002 COMMON /P/ MCINTR 02960002 COMMON /P/ MCOH 02970002 COMMON /P/ MCOTR , M00788( 44) 02980002 COMMON /P/ MCTADD ( 20) 02990002 COMMON /P/ MCNMOP 03000002 COMMON /P/ MCMMOP 03010002 COMMON /P/ MCMOTF ( 20) , M01056( 38) 03020002 COMMON /P/ PTNCW 03030002 COMMON /P/ PTTBLK , M01292( 4) 03040002 COMMON /P/ PTTHL 03050002 COMMON /P/ PTTHLB , M01316( 30) 03060002 COMMON /P/ PROTAB ( 2) 03070002 COMMON /P/ ENDP 03080002 C 03090002 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 03100002 C 03110002 COMMON /OPAP / OPAPF(30) 03120002 C 03130002 EQUIVALENCE (ACCARD( 1), ACNAME ) 03140002 EQUIVALENCE (LCCARD( 1), LCNAME ) 03150002 EQUIVALENCE (LCCARD(15), LCGRPI ) 03160002 EQUIVALENCE (DATTR ( 1), DENTRY(9)) 03170002 C 03180002 C CHARACTER VARIABLES AND CONSTANTS -- LOCAL 03190002 C 03200002 CHARACTER*80 CARD 03210002 CHARACTER*8 DDNM 03220002 CHARACTER*1 DEBUGF 03230002 CHARACTER*1 JCLASS 03240002 CHARACTER*8 JOBID 03250002 CHARACTER*8 JOBNAM 03260002 CHARACTER*1 LBSIGN 03270002 CHARACTER*16 PROCCH 03280002 CHARACTER*3 TSO 03290002 C 03300002 C INTEGER ARRAYS -- LOCAL 03310002 C 03320002 INTEGER ACCARD ( 23) 03330002 INTEGER CPUID ( 3) 03340002 INTEGER DATTR ( 96) 03350002 INTEGER DENTRY ( 104) 03360002 INTEGER DUMMY ( 10) 03370002 INTEGER JAPNMS ( 4) 03380002 INTEGER LCCARD ( 19) 03390002 C 03400002 C DIMENSION(2) ONLY NEEDED ON IBM TO ENSURE 8 BYTES: 03410002 REAL TDATE(2) 03420002 REAL TTIME(2) 03430002 REAL LCGRPI 03440002 C 03450002 C LOCAL VARIABLES (INTERNAL TO PROGRAM) 03460002 C 03470002 INTEGER ACCT 03480002 INTEGER ADRBUG 03490002 INTEGER BLANKS 03500002 INTEGER BRANCH 03510002 INTEGER CRAY 03520002 INTEGER IBM 03530002 INTEGER LCINTL 03540002 INTEGER LCTYPS 03550002 INTEGER LINE 03560002 INTEGER PARM 03570002 INTEGER PEND 03580002 INTEGER TIMELM 03590002 C 03600002 C INITIALIZATION 03610002 C 03620002 PARAMETER (IPR=99, ITR=2) 03630002 C 03640002 DATA ACCT / 'ACCT'/ 03650002 DATA BLANKS / ' '/ 03660002 DATA BRANCH / 'BRAN'/ 03670002 DATA CRAY / 'CRAY'/ 03680002 DATA DA / 1 / 03690002 DATA DEBUGF / ' ' / 03700002 DATA FATIOM /25/ 03710002 DATA IBM / 'IBM '/ 03720002 DATA ICIBR / 0 / 03730002 DATA ICIBRE / 0 / 03740002 DATA ICIND / 0 / 03750002 DATA IPNA / 1 / 03760002 DATA LBSIGN / '#'/ 03770002 DATA LCINTL / 'L '/ 03780002 C DATA LCOM / 0 / 03790002 DATA LCTYPS / 'S '/ 03800002 DATA LINE / 'LINE'/ 03810002 DATA MCRTFM / 0 / 03820002 DATA PARM / 'PARM'/ 03830002 DATA PEND / 'PEND'/ 03840002 DATA PROCCH / 'PROC '/ 03850002 DATA TIMELM /60/ 03860002 DATA TSO / 'TSU'/ 03870002 CDEBUG******************************************** 03880002 CCCCC CALL USWTSO ('DBGREP ', 'CSEXEC ENTERED ', 20, STATUS) 03890002 CDEBUG******************************************** 03900002 C 03910002 C INITIALIZE LABEL COMMONS 03920002 C 03930002 CALL COMINIT 03940002 C 03950002 C SATISFY EXTERNALS 03960002 C 03970002 IF (1 .EQ. 2) THEN 03980002 CALL UPAPER 03990002 CALL USGETZ 04000002 CALL UPHOST 04010002 CALL USSTHV 04020002 CALL PLOTS 04030002 CALL FOGM3D 04040002 CALL FOIP 04050002 CALL FOPARM 04060002 CALL FOSCDK 04070002 CALL FOTRCE 04080002 CALL FOVF3D 04090002 CALL S1ATP 04100002 CALL USVFUS 04110002 END IF 04120002 C 04130002 C EJECT 04140002 C PRELIMINARY OPERATIONS. 04150002 C 04160002 LHWRKD = 0 04170002 C 04180002 CALL USRDID (CPUID) 04190002 IF (S1CPCH( CPUID,1,CRAY,1,3 ).EQ.0) THEN 04200002 SYSTEM = CRAY 04210002 SYBYPW = 8 04220002 SYLOCF = 1 04230002 SYCNWB = 8 04240002 ELSE 04250002 SYSTEM = IBM 04260002 SYBYPW = 4 04270002 SYLOCF = 4 04280002 SYCNWB = 1 04290002 END IF 04300002 C 04310002 ADRBUG = LOC(CSDBUG) 04320002 CALL USSADR (ADRBUG, CSDBUG, ADRBUG) 04330002 C 04340002 C 04350002 C INITIALIZE COMMON /P/ 04360002 C 04370002 CALL CSCOMP (IPR, IER) 04380002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 04390002 C DEBUG PRINT OF KP VARIABLES 04400002 C DO 9 I = 1, MCNKP 04410002 C J = (I - 1) * PTNCW 04420002 C WRITE (IPR, 7) (PROTAB(J+K), K = 1, PTNCW) 04430002 C 7 FORMAT (//1X,'KPNA KPRNO KPOCUR KPA KPDBGS KPDBGA KPDBGN ', 04440002 C * 'KPWRKS KPWRKD KPWKS2 KPWKD2 KPWKS3 KPWKD3 KPFCF KPIRSM ',04450002 C * 'KPNRSM KPIUSM KPNUSM',/1X,A4,I6,I7,Z9,9I7,I6,4I7,/1X, 04460002 C * 'KPTIME KPRTF KPDRTF KPMOTF KPNBR KPIBN KPITSV KPTAMF ', 04470002 C * 'KPLOTF KPMITF KPPRNT KPPLOT KPPLTA KPBUGF KPWARN KPTRIO',04480002 C * ' KPWKIO KPVOLS',/1X,2I6,2I7,2I6,12I7,/1X,'KPWTSF ', 04490002 C * 'KPETIM KPDSNS KPWD40 KPWD41 KPWD42 KPWD43 KPWD44 KPWD45',04500002 C * ' KPWD46 KPWD47 KPWD48 KPWD49 KPWD50 KPWD51 KPWD52 ', 04510002 C * 'KPWD53 KPWD54',/1X,I6,17I7,/1X,'KPWD55 KPWD56',2I7) 04520002 C 9 CONTINUE 04530002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 04540002 IF (IER .GE. 2 .OR. MCNKP .LE. 1) GO TO 920 04550002 C 04560002 CALL USCLOK (MCDELT, MCCTOT) 04570002 CALL DATIME (MCBDAT, MCBTEM, MCBTIM) 04580002 C 04590002 CALL ARSET ( ACCARD, 23, BLANKS ) 04600002 CALL ARSET ( LCCARD, 19, BLANKS ) 04610002 C 04620002 CALL JPSNAM (MCJOB) 04630002 CALL S1MVCH (PROCCH, 1, MCSTEP, 1, 8) 04640002 CALL S1SCGN 04650002 C 04660002 CALL S1MVCH (MCJOB, 1, JAPNMS, 1, 16) 04670002 C 04680002 C START THE TIMER FOR LIMITING THE RUN TIME OF FOREGROUND JOBS 04690002 C 04700002 CALL JOBINF (JOBNAM, JOBID, JCLASS) 04710002 IF (JOBID(1:3) .EQ. TSO) THEN 04720002 WRITE (ITR, 9000) 04730002 CALL ZOWIE 04740002 CALL TMSTRT (TIMELM) 04750002 ENDIF 04760002 C 04770002 C ALLOW FOR UNLIMITED 207-208 (OVER-UNDER FLOW) ERRORS. 04780002 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 04790002 CALL ERRSET (207, 256, 10, 0, 0, 208) 04800002 CALL XUFLOW (0) 04810002 ENDIF 04820002 C 04830002 C COMPUTE PROTAB INDICES CORRESPONDING TO VARIABLES IN KP-AREA. 04840002 C 04850002 IPDBGN = (LOC(KPDBGN) - LOC(KPNA))/SYLOCF + 1 04860002 IPFCF = (LOC(KPFCF) - LOC(KPNA))/SYLOCF + 1 04870002 IPIBN = (LOC(KPIBN) - LOC(KPNA))/SYLOCF + 1 04880002 IPLOTF = (LOC(KPLOTF) - LOC(KPNA))/SYLOCF + 1 04890002 IPMITF = (LOC(KPMITF) - LOC(KPNA))/SYLOCF + 1 04900002 IPRTF = (LOC(KPRTF) - LOC(KPNA))/SYLOCF + 1 04910002 C 04920002 C READ THE ACCOUNT CARD, TRANSLATE, AND MOVE TO COMMON /P/. 04930002 DA = 1 04940002 CALL FORC (ACCT, 0, DA, CARD, *800) 04950002 READ (CARD, 990)(ACCARD(I),I=1,7),(ACCARD(I),I=21,23) 04960002 AC64BC = S1CVBN (CARD, 7, 5) 04970002 CALL S1MVCH ( CARD,21, ACCARD( 8),1, 18 ) 04980002 CALL S1MVCH ( CARD,39, ACCARD(13),1, 32 ) 04990002 C MAKE SURE THE LAST TWO BYTES OF THE LINE NAME ARE BLANK 05000002 CIBM CALL S1MVCH (' ',1,ACCARD,47,2) 05010002 C 05020002 C READ THE LINE CARD, TRANSLATE, AND MOVE TO COMMON /P/. 05030002 DA = 1 05040002 CALL FORC (LINE, 0, DA, CARD, *810) 05050002 READ (CARD, 991)(LCCARD(I),I=1,7),(LCCARD(I),I=10,14),LCGRPI, 05060002 * (LCCARD(I),I=16,19) 05070002 CALL S1MVCH ( CARD,21, LCCARD( 8),1, 08 ) 05080002 C 05090002 IF (ACNSP .EQ. 0 ) ACNSP = LCNSP 05100002 IF (AC64BC .EQ. 0 ) GO TO 840 05110002 IF (LCINT .EQ. BLANKS ) LCINT = LCINTL 05120002 IF (LCMXFD .EQ. 0 ) LCMXFD = LCTPSP 05130002 IF (LCMXLN .EQ. 0 ) LCMXLN = 1 05140002 IF (LCTYP .EQ. BLANKS ) LCTYP = LCTYPS 05150002 PTTHL = PTTHLB / SYBYPW 05160002 PTTBLK = (LCRL / LCPI) * SYBYPW + PTTHLB 05170002 C 05180002 C GET THE SUBMITTER NAME FROM THE JOB CARD 05190002 C 05200002 IF (JOBID(1:3) .NE. TSO) THEN 05210002 CALL JCTEXT (DUMMY(1), DUMMY(3), DUMMY(4), ACUSER(1), DUMMY(5)) 05220002 ENDIF 05230002 C 05240002 C SET THE DEBUG FLAG. 05250002 DEBUGF = CARD(10:) 05260002 C 05270002 C OBTAIN MAIN STORAGE FOR BLANK COMMON. 05280002 C 05290002 C VALUE ON PARM CARD IS K-BYTES - CONVERT TO NUMBER OF WORDS 05300002 C MCNUSM = 1024 * BCOM /4 05310002 DA = 1 05320002 CALL FORP (PARM, 0, DA, 104, DENTRY, *830) 05330002 BCOM = DATTR(1) 05340002 C 05350002 C REQUEST BLANK COMMON SPACE FOR FFT'S 05360002 C 05370002 LFOUR = LCRL / LCPI 05380002 IF (LCRL/LCSI .GT. LFOUR) LFOUR = LCRL / LCSI 05390002 CALL S1FMAG (LFOUR, MAXMAG, LPREV) 05400002 C 05410002 CALL USS2DX (LFOURX, 6) 05420002 IF (LFOUR .GT. LFOURX) LFOURX= LFOUR 05430002 IF (LFOURX .GT. 16383 ) LFOURX= 16383 05440002 CALL S1FMAG (LFOURX, MAXMAG, LFOUR) 05450002 TCOM = LFOUR * 5 05460002 IF (TCOM .LT. 0) TCOM = 0 05470002 TCOM = (4 * TCOM + 1023) / 1024 05480002 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) TCOM = 0 05490002 C 05500002 MCNUSM = 256 * (BCOM + TCOM) 05510002 CALL GETMN2 (COM, MCNUSM, MCIUSM, LCOM) 05520002 IF (MCNUSM .NE. LCOM) GO TO 820 05530002 MCIUSM = MCIUSM + 1 05540002 C 05550002 CALL ARSET (COM(MCIUSM), MCNUSM, 0) 05560002 C 05570002 C **************************************************** 05580002 C *** *** 05590002 C *** GENERATE SIN/COS TABLE FOR FFT *** 05600002 C *** *** 05610002 C **************************************************** 05620002 C 05630002 CALL S2SCG2 (MAXMAG, COM(MCIUSM)) 05640002 C 05650002 C **************************************************** 05660002 C *** *** 05670002 C *** GENERATE COEFFICIENT TABLE FOR STATICS *** 05680002 C *** *** 05690002 C **************************************************** 05700002 C 05710002 CALL USSTAT (COM(MCIUSM), LENCOF) 05720002 MCIUSM = MCIUSM + LENCOF 05730002 MCNUSM = MCNUSM - LENCOF 05740002 C 05750002 CALL CSNODE 05760002 C 05770002 IF (MCRTF .LT. 0 ) GO TO 900 05780002 C 05790002 C PRELIMINARY CALL TO THE TRACE ARRAY MANAGER. 05800002 IF (PTTBLK .LT. 3200) PTTBLK = 3200 05810002 C 05820002 MCTAMF = 1 05830002 CALL CSTRAM 05840002 IF (MCRTF .LT. 0) GO TO 900 05850002 C 05860002 C CHECK FOR INPUT PROCESS (SET MCEOFF=0 IF NONE FOUND) 05870002 C 05880002 LAST = PTNCW * MCNKP 05890002 C 05900002 DO 10 I = 1, LAST, PTNCW 05910002 IF (PROTAB(I+IPDBGN-1) .EQ. 1) GO TO 100 05920002 10 CONTINUE 05930002 C 05940002 MCEOFF = 0 05950002 MCMITF = 0 05960002 C 05970002 C==================================================================== 05980002 C 05990002 C END OF PRELIMINARY OPERATIONS. 06000002 C EJECT 06010002 C MAIN LOOP, STATEMENTS 100 TO 199. 06020002 C INDEX MCIKP RUNS FROM 1 TO MCNKP (NUMBER OF PROCESSES). 06030002 C INDEX MCIKPE + 1 POINTS TO PROTAB ENTRY CORRESPONDING TO MCIKP, 06040002 C MCIKPE = PTNCW*(MCIKP - 1). 06050002 C INDEX MCIKPE + IPVAR POINTS TO THE VARIABLE IN A PROTAB ENTRY 06060002 C WHICH CORRESPONDS TO VARIABLE KPVAR IN THE KP-AREA OF 06070002 C COMMON /P/. IPVAR IS COMPUTED INSTEAD OF BEING DEFINED AS 06080002 C A CONSTANT SO THAT IT WILL BE INDEPENDENT OF REARRANGEMENTS 06090002 C OF COMMON /P/ (EXCEPT THAT THE CALCULATION ASSUMES THAT 06100002 C KPNA WILL REMAIN THE FIRST VARIABLE IN THE KP-AREA), 06110002 C IPVAR = (LOC(KPVAR) - LOC(KPNA))/4 + 1. 06120002 C 06130002 C THERE ARE THREE RETURN POINTS NEAR THE BEGINNING OF THE LOOP, 06140002 C NAMELY 100, 110, AND 120. 06150002 C 06160002 C 100 IS THE RETURN POINT AFTER THE LOOP IS FINISHED (MCIKP = MCNKP). 06170002 C THIS RETURN IS FROM STATEMENT 500. NORMALLY THIS TEST WOULD BE 06180002 C OCCUR NEAR THE END OF THE MAIN LOOP, SAY AT 195. IT IS MOVED 06190002 C DOWN TO 500 BECAUSE OF THE SPECIAL TESTS IN SECTIONS 300 AND 400 06200002 C WHICH MUST BE DONE BEFORE THE LOOP IS RESTARTED. 06210002 C 06220002 C 110 IS THE RETURN POINT FOR A NORMAL STEP THROUGH THE LOOP (NEXT 06230002 C VALUE OF MCIKP). THIS RETURN IS FROM STATEMENT 199. 06240002 C 06250002 C 120 IS THE RETURN POINT WHEN A SPECIAL VALUE OF MCIKP HAS BEEN 06260002 C SELECTED BY ONE OF THE TESTS IN SECTIONS 300, 400, OR 600. 06270002 C SUCH A SPECIAL VALUE CAN BE SELECTED IN THREE WAYS. 06280002 C 1. IN SECTION 300, AFTER THE PROGRAM HAS DECIDED TO SKIP TO THE 06290002 C NEXT BRANCH. THIS DECISION CAN BE MADE AT THREE POINTS: 06300002 C (1) AT 130. IF THE PROCESS ABOUT TO BE EXECUTED PREVIOUSLY 06310002 C SET ITS RETURN FLAG KPRTF TO MINUS ONE (ERROR), NEITHER 06320002 C THE PROCESS NOR THE REST OF THE BRANCH WILL BE EXECUTED. 06330002 C (2) AT 150. IF THE PROCESS JUST EXECUTED SET ITS RETURN FLAG 06340002 C KPRTF TO MINUS ONE (ERROR), THE REST OF THE BRANCH WILL 06350002 C NOT BE EXECUTED. 06360002 C (3) AT 190. IF THE PROCESS JUST EXECUTED SET ITS RETURN FLAG 06370002 C TO ZERO (MEANING IT DID NOT COMPUTE AN OUTPUT TRACE TO BE 06380002 C PASSED TO THE NEXT PROCESS, BECAUSE, FOR EXAMPLE, IT IS A 06390002 C MULTIPLE-TRACE PROCESS WHICH IS COLLECTING INPUT BEFORE 06400002 C PRODUCING OUTPUT), THE REST OF THE BRANCH WILL NOT BE 06410002 C EXECUTED. 06420002 C 2. IN SECTION 400. IF THERE ARE ANY MULTIPLE-OUTPUT PROCESSES 06430002 C (PROCESSES WHICH MUST REGAIN CONTROL FOR MORE OUTPUT BEFORE 06440002 C ACCEPTING ANY MORE INPUT), CONTROL WILL BE PASSED TO THE LAST 06450002 C PROCESS ON THE LIST OF MULTIPLE-OUTPUT PROCESSES. MCNMOP IS 06460002 C THE NUMBER OF MULTIPLE-OUTPUT PROCESSES, AND THE ARRAY MCMOTF 06470002 C CONTAINS THE INDICES (VALUES OF MCIKP) FOR THE MULTIPLE-OUTPUT 06480002 C PROCESSES. WHEN A MULTIPLE-OUTPUT PROCESS SETS ITS MULTIPLE- 06490002 C OUTPUT FLAG KPMOTF, THE CONTROL PROGRAM WILL ADD ITS INDEX 06500002 C MCIKP TO THE ARRAY MCMOTF AND INCREASE THE NUMBER MCNOTF. 06510002 C THIS OPERATION IS IN STATEMENTS 160 TO 170. 06520002 C 06530002 C EJECT 06540002 C 3. IN SECTION 600. THIS SECTION IS EXECUTED WHEN THERE ARE NO 06550002 C MULTIPLE-OUTPUT PROCESSES WAITING AND NO MORE INPUT TRACES TO 06560002 C BE READ. THIS SECTION SEARCHES FOR MULTIPLE-TRACE PROCESSES 06570002 C WHICH HAVE OUTPUT WAITING EVEN THOUGH THERE IS NO MORE INPUT. 06580002 C THESE PROCESSES ARE IDENTIFIED BY THE 'FLUSH FLAG' KPLOTF. IF 06590002 C KPLOTF IS NOT ZERO, CONTROL IS GIVEN TO THE PROCESS BY 06600002 C RETURNING TO 120. 06610002 C 06620002 C START OF LOOP 100-199, MCIKP = 1 TO MCNKP. 06630002 100 CONTINUE 06640002 MCIKP = 1 06650002 MCIKPE = 0 06660002 GO TO 120 06670002 C 06680002 C===================================================================== 06690002 C 06700002 C RETURN POINT FOR NEXT VALUE OF MCIKP. 06710002 110 MCIKP = MCIKP + 1 06720002 MCIKPE = MCIKPE + PTNCW 06730002 C 06740002 C RETURN POINT FOR A SPECIALLY SELECTED VALUE OF MCIKP. 06750002 120 CONTINUE 06760002 C 130 IF PROCESS IS INACTIVE, SKIP TO NEXT BRANCH. 06770002 IF (PROTAB(MCIKPE + IPRTF) .LE. -1) GO TO 300 06780002 C IF WE HAVE JUST FINISHED A BRANCH WHICH WAS ENTERED AT AN 06790002 C INTERMEDIATE POINT BY THE SELECTION OF A MULTIPLE-OUTPUT OR 06800002 C MULTIPLE-TRACE PROCESS, DO NOT CONTINUE WITH OTHER BRANCHES 06810002 C BUT INSTEAD CALL THE END PROCESS SDPEND. 06820002 IF (PROTAB(MCIKPE + IPIBN) .GT. MCBRNF .OR. 06830002 * PROTAB(MCIKPE + IPNA) .NE. BRANCH ) GO TO 140 06840002 MCIKP = MCNKP 06850002 MCIKPE = PTNCW*(MCIKP - 1) 06860002 C 06870002 C 140 PREPARE TO CALL THE PROCESS. 06880002 C 1. KP-AREA. 06890002 C 2. TRACE ARRAYS. 06900002 C 3. PARAMETER LIST. 06910002 C 4. WALL-CLOCK (ELAPSED) TIMER. 06920002 C 5. CPU TIMER. 06930002 C 06940002 C 1. PREPARE THE CURRENT PROCESS AREA (KP-AREA). 06950002 140 CONTINUE 06960002 CALL ARMVE (PROTAB(MCIKPE+1), KPNA, PTNCW) 06970002 KPIUSM = MCIUSM 06980002 KPNUSM = MCNUSM 06990002 KPRTF = KPDRTF 07000002 MCTAMF = KPTAMF 07010002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 07020002 C DEBUG PRINT OF KP VARIABLES 07030002 C WRITE (IPR, 7) (PROTAB(MCIKPE+K), K = 1, PTNCW) 07040002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 07050002 C 07060002 C 3. OBTAIN INPUT AND OUTPUT TRACE ARRAYS. 07070002 CALL CSTRAM 07080002 IF (MCRTF .LT. 0) GO TO 900 07090002 C 07100002 C 3. PREPARE PARAMETER LIST. 07110002 MCINH = MCTADD(MCI1) 07120002 MCINTR = MCINH + PTTHLB/SYCNWB 07130002 MCOH = MCTADD(MCI2) 07140002 MCOTR = MCOH + PTTHLB/SYCNWB 07150002 C 07160002 C R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D 07170002 C 07180002 C SPECIAL CODE TO HANDLE THE PASS, PASC, ETC. SPECIAL ROUTINES 07190002 C OF R&D 07200002 C 07210002 IF (KPMITF .EQ. 0 .OR. KPMOTF .EQ. 1) GO TO 145 07220002 IF (S1CPCH(KPNA,1,'READ',1,4) .EQ. 0) GO TO 145 07230002 CALL CSTICD (MCINH, TICD) 07240002 IF (TICD .LE. 16000) GO TO 145 07250002 IF (S1CPCH(KPNA,1,'JOIN',1,4) .EQ. 0) GO TO 145 07260002 KPRTF = 2 07270002 IF (S1CPCH(KPNA,1,'NODE',1,4) .EQ. 0) KPRTF = 1 07280002 GO TO 146 07290002 C 07300002 C R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D R&D 07310002 C 07320002 C 07330002 C 4. GET CURRENT WALL-CLOCK TIME. 07340002 145 CALL DATIME (TDATE, TTIME, TIME1) 07350002 C 07360002 C 5. START CPU TIMER FOR PROCESS. 07370002 CALL USCLOK (MCDELT, MCCPRO) 07380002 C 07390002 C CALL THE PROCESS. 07400002 CALL CSCALL (MCINH, KPA) 07410002 C 07420002 C OPERATIONS FOLLOWING THE EXECUTION OF THE PROCESS. 07430002 CALL USCUMT (KPTIME, MCDELT, MCCPRO) 07440002 C 07450002 C CALCULATE THE ELAPSED (WALL-CLOCK) TIME 07460002 C 07470002 CALL DATIME (TDATE, TTIME, TIME2) 07480002 TIME2 = TIME2 - TIME1 07490002 IF (TIME2 .LT. 0) TIME2 = TIME2 + 8640000 07500002 KPETIM = KPETIM + TIME2 07510002 C 07520002 146 CALL ARMVE (KPNA, PROTAB(MCIKPE+1), PTNCW) 07530002 C SAVE THE RETURN FLAG FOR FURTHER TESTING. 07540002 MCRTF = KPRTF 07550002 C SAVE SMALLEST MCRTF FOR PRINTING BY CSSMRY. 07560002 IF (MCRTF .LT. MCRTFM) MCRTFM = MCRTF 07570002 C 07580002 C 07590002 C TESTS FOLLOWING THE PROCESS. 07600002 C 07610002 C IF DEBUG FLAG IS ON, CALL DEBUG SUBROUTINE. 07620002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 07630002 C DEBUG PRINT OF KP VARIABLES 07640002 C WRITE (IPR, 7) (PROTAB(MCIKPE+K), K = 1, PTNCW) 07650002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 07660002 IF (DEBUGF .EQ. LBSIGN) CALL CSCALL (MCINH,ADRBUG) 07670002 C 07680002 C 150 IF THE PROCESS WAS MADE INACTIVE (KPRTF = -1), GO TO NEXT BRANCH. 07690002 IF (MCRTF .EQ. -1) GO TO 300 07700002 C 07710002 C IF THE PROCESS RETURNED AN ERROR CODE (KPRTF < -1), STOP THE JOB. 07720002 IF (MCRTF .LT. -1) GO TO 900 07730002 C 07740002 C IF END OF FILE WAS JUST ENCOUNTERED (MCEOFF = 0 AND MCMITF NOT 0),07750002 C SET MCMITF TO ZERO AND GO TO 600 TO TEST FOR MULTIPLE-TRACE 07760002 C PROCESSES THAT STILL HAVE OUTPUT WITH NO MORE INPUT. 07770002 IF (MCEOFF .NE. 0 .OR. MCMITF .EQ. 0) GO TO 155 07780002 MCMITF = 0 07790002 GO TO 600 07800002 C 07810002 C===================================================================== 07820002 C 07830002 C 155 IF THE PROCESS HAS ASKED THAT THE INPUT TRACE BE PASSED ALONG 07840002 C TO THE OUTPUT WITHOUT CHANGE (KPRTF = 2), MOVE THE INPUT TO THE 07850002 C OUTPUT. THE SPECIAL MOVE PROGRAM USED, CSTRMV, HANDLES THE 07860002 C ADDRESSES IN THE PARAMETER LIST. THIS PROGRAM CANNOT BE USED AS 07870002 C A GENERAL-PURPOSE MOVE PROGRAM. 07880002 155 CONTINUE 07890002 IF (MCRTF .NE. 2) GO TO 160 07900002 CALL CSTRMV (MCINH, PTTBLK, MCOH) 07910002 C 07920002 C 160 IF THE PROCESS JUST DECLARED THAT IT HAS MORE OUTPUT BEFORE 07930002 C ACCEPTING ANY MORE INPUT (KPMOTF NOT 0), INCREASE THE NUMBER OF 07940002 C MULTIPLE-OUTPUT PROCESSES THAT ARE WAITING FOR CONTROL, AND ADD 07950002 C MCIKP TO THE ARRAY MCMOTF OF MULTIPLE-OUTPUT PROCESSES. 07960002 160 CONTINUE 07970002 IF (KPMOTF .EQ. 0) GO TO 180 07980002 MCNMOP = MCNMOP + 1 07990002 IF (MCNMOP .LE. MCMMOP) GO TO 165 08000002 MCRTF = -4 08010002 GO TO 900 08020002 C 08030002 C===================================================================== 08040002 C 08050002 165 MCMOTF(MCNMOP) = MCIKP 08060002 C 08070002 C 180 AT THIS POINT IT IS KNOWN THAT THE RETURN FLAG MCRTF (NOW EQUAL 08080002 C TO KPRTF) IS NOT NEGATIVE. 08090002 C THEN, IF MCRTF = 0, MEANING NO OUTPUT TRACE RETURNED BY THE 08100002 C PROCESSING PROGRAM, SKIP TO THE NEXT BRANCH WHICH PROCEEDS FROM 08110002 C THE SAME NODE AS THE PROCESS JUST EXECUTED. 08120002 C IF MCRTF IS NOT ZERO, TEST FOR THE END OF THE LIST OF PROCESSES. 08130002 C IF AT END, GO TO FIRST END-OF-LIST TEST (AT 400). 08140002 C IF NOT AT END, GO BACK TO 110 TO TAKE NEXT VALUE OF MCIKP. 08150002 180 IF (MCRTF .EQ. 0 ) GO TO 300 08160002 IF (KPNA .EQ. PEND ) GO TO 400 08170002 GO TO 110 08180002 C 08190002 C 199 END OF MAIN LOOP 100-199. 08200002 C 08210002 C===================================================================== 08220002 C 08230002 C 08240002 C 300 SKIP TO NEXT BRANCH. 08250002 C THE NEXT BRANCH IS DEFINED AS ONE OF THE FOLLOWING: 08260002 C 1. A BRANCH WHICH IS ATTACHED TO THE CURRENT NODE, I.E., THE 08270002 C SAME NODE AS THE PROCESS WHICH CAUSED THE SKIP. 08280002 C 2. A BRANCH WHICH IS ATTACHED TO AN EARLIER NODE IN THE 08290002 C SEQUENCE IS PROCESSES. 08300002 300 CONTINUE 08310002 C IF ALREADY AT END, GO TO FIRST END-OF-LIST TEST (AT 400). 08320002 IF (KPNA .EQ. PEND ) GO TO 400 08330002 C IF IN FIRST BRANCH, BEFORE FIRST NODE, THERE WILL NOT BE ANOTHER 08340002 C BRANCH THAT CAN BE EXECUTED. GO TO PEND (END PROCESS), IN ORDER 08350002 C TO START THE LOOP AGAIN WITH THE FIRST PROCESS, OTHERWISE BACK 08360002 C UP LIST OF PROCESSES LOOKING FOR AN OUTPUT PROCESS SETTING EACH 08370002 C NON-OUTPUT PROCESS INACTIVE (KPRTF = -100). ANY READ PROCESS MUST 08380002 C HAVE THE END-OF-FILE FLAG SET TO ALLOW FOR CLEANUP. 08390002 IF (MCRTF .EQ. -1) GO TO 302 08400002 IF (KPIBN .NE. 170) GO TO 305 08410002 302 IF (MCIKP .EQ. 1) GO TO 303 08420002 IF (MCRTF .NE. -1) GO TO 304 08430002 MCIKP = MCIKP - 1 08440002 MCIKPE = MCIKPE - PTNCW 08450002 IF (PROTAB(MCIKPE+IPNA) .EQ. BRANCH ) THEN 08460002 ICIND = PROTAB(MCIKPE + IPIBN) 08470002 GO TO 320 08480002 END IF 08490002 IF (PROTAB(MCIKPE + IPDBGN) .EQ. 0) THEN 08500002 PROTAB(MCIKPE+IPRTF) = -100 08510002 GO TO 302 08520002 END IF 08530002 IF (PROTAB(MCIKPE+IPDBGN) .EQ. 2) GO TO 305 08540002 PROTAB(MCIKPE+IPRTF) = -100 08550002 IF (PROTAB(MCIKPE+IPDBGN) .NE. 1) GO TO 302 08560002 C 08570002 303 PROTAB(MCIKPE + IPMITF) = 0 08580002 MCMITF = 0 08590002 MCEOFF = 0 08600002 GO TO 600 08610002 C 08620002 304 CONTINUE 08630002 MCIKP = MCNKP 08640002 MCIKPE = PTNCW*(MCIKP - 1) 08650002 GO TO 120 08660002 C 08670002 C===================================================================== 08680002 C 08690002 C SAVE THE INDEX TO THE NODE FOR THE PROCESS JUST EXECUTED. 08700002 305 CONTINUE 08710002 ICIBR = PROTAB(MCIKPE + IPIBN) 08720002 ICIBRE = PTNCW*(ICIBR - 1) 08730002 ICIND = PROTAB(ICIBRE + IPIBN) 08740002 C ENTER LOOP AT END-OF-LOOP TEST. 08750002 GO TO 320 08760002 C 310 LOOP 310-320 SEARCHES FOR THE NEXT BRANCH. 08770002 C THE NEXT BRANCH IS ONE OF THE FOLLOWING. 08780002 C 1. A BRANCH ATTACHED TO THE CURRENT NODE, I.E., 08790002 C A BRANCH FOR WHICH KPIBN = ICIND. 08800002 C 2. A BRANCH ATTACHED TO AN EARLIER NODE, I.E., 08810002 C A BRANCH FOR WHICH KPIBN < ICIND. 08820002 310 CONTINUE 08830002 MCIKP = MCIKP + 1 08840002 MCIKPE = MCIKPE + PTNCW 08850002 IF (PROTAB(MCIKPE+IPNA ) .EQ. BRANCH .AND. 08860002 * PROTAB(MCIKPE+IPIBN) .LE. ICIND 08870002 * .OR. 08880002 * PROTAB(MCIKPE+IPNA) .EQ. PEND ) GO TO 120 08890002 320 CONTINUE 08900002 IF (KPNA .EQ. PEND ) GO TO 400 08910002 GO TO 310 08920002 C 08930002 C===================================================================== 08940002 C 08950002 C TEST FOR MULTIPLE-OUTPUT PROCESSES (WHICH MUST REGAIN CONTROL FOR 08960002 C MORE OUTPUT BEFORE ACCEPTING ANY MORE INPUT). 08970002 400 CONTINUE 08980002 MCBRNF = -86 08990002 IF (MCNMOP .EQ. 0) GO TO 500 09000002 MCIKP = MCMOTF(MCNMOP) 09010002 MCIKPE = PTNCW*(MCIKP - 1) 09020002 MCMOTF(MCNMOP) = 0 09030002 MCNMOP = MCNMOP - 1 09040002 C SET BRANCH FLAG SO THAT ONLY THE BRANCH CONTAINING 09050002 C THIS PROCESS WILL BE EXECUTED. 09060002 ICIBR = PROTAB(MCIKPE + IPIBN) 09070002 IF (ICIBR .EQ. 170) GO TO 120 09080002 ICIBRE = PTNCW*(ICIBR - 1) 09090002 MCBRNF = PROTAB(ICIBRE + IPIBN) 09100002 GO TO 120 09110002 C 09120002 C===================================================================== 09130002 C 09140002 500 CONTINUE 09150002 IF (MCEOFF .NE. 0) GO TO 100 09160002 C 09170002 C 09180002 C TEST FOR MULTIPLE-TRACE PROCESSES WHICH HAVE MORE OUTPUT EVEN 09190002 C THOUGH THERE IS NO MORE INPUT. 09200002 600 CONTINUE 09210002 MCIKP = 1 09220002 MCIKPE = 0 09230002 GO TO 620 09240002 610 MCIKP = MCIKP + 1 09250002 MCIKPE = MCIKPE + PTNCW 09260002 620 IF (PROTAB(MCIKPE+IPLOTF) .EQ. 0 09270002 * .OR. PROTAB(MCIKPE+IPRTF ) .LE. -1 09280002 * .OR. PROTAB(MCIKPE+IPFCF ) .EQ. 1) GO TO 630 09290002 PROTAB(MCIKPE+IPMITF) = 0 09300002 C SET BRANCH FLAG SO THAT ONLY THE BRANCH CONTAINING 09310002 C THIS PROCESS WILL BE EXECUTED. 09320002 ICIBR = PROTAB(MCIKPE + IPIBN) 09330002 IF (ICIBR .EQ. 170) GO TO 120 09340002 ICIBRE = PTNCW*(ICIBR - 1) 09350002 MCBRNF = PROTAB(ICIBRE + IPIBN) 09360002 GO TO 120 09370002 630 IF (MCIKP .GE. MCNKP) GO TO 900 09380002 GO TO 610 09390002 C 09400002 C===================================================================== 09410002 C 09420002 C ERROR RETURNS FROM CARD FETCH PROGRAM FORC. 09430002 800 CONTINUE 09440002 MCRTF = -2 09450002 GO TO 900 09460002 810 MCRTF = -3 09470002 GO TO 900 09480002 820 MCRTF = -5 09490002 GO TO 900 09500002 830 MCRTF = -6 09510002 C GO TO 900 09520002 840 MCRTF = -7 09530002 WRITE (IPR, 997) 09540002 C GO TO 910 09550002 C 09560002 C===================================================================== 09570002 C 09580002 900 CONTINUE 09590002 C 09600002 C 09610002 IF (MCRTFM .LT. MCRTF) MCRTF = MCRTFM 09620002 CALL CSSMRY 09630002 CALL CSACCT 09640002 C 09650002 CALL FOCP 09660002 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 09670002 CALL S1MVCH ('GM3DPARM', 1, DDNM, 1, 8) 09680002 CALL CKDD (DDNM) 09690002 IF (S1CPCH(DDNM,1,'PRESENT ',1,8) .EQ. 0) CALL FOGMCD 09700002 ENDIF 09710002 C 09720002 C CLOSE AND UNALLOCATE THE HISTORY RECORDS WORKFILE 09730002 C 09740002 IF (LHWRKD .NE. 0) THEN 09750002 CALL FOCSD (LHWRKS) 09760002 CALL FOCDD (LHWRKD) 09770002 CALL UGUWRK (LHWRKS, LHWRKD, ERR1, ERR2) 09780002 IF (ERR1 .NE. 1) WRITE (IPR, 995) ERR1, ERR2 09790002 END IF 09800002 C 09810002 C CLOSE AND UNALLOCATE THE HISTORY RECORDS WORKFILE (OPAP) 09820002 C 09830002 DO 905 I = 1,10 09840002 J = (I-1)*3 09850002 IF ( OPAPF(J+3).LE.0 ) GO TO 905 09860002 BSAMAD = OPAPF(J+2) 09870002 BDAMAD = OPAPF(J+1) 09880002 IF (SYBYPW.EQ.8) CALL FOCDD(BDAMAD) 09890002 CALL UGUWRK (BSAMAD, BDAMAD, ERR1, ERR2) 09900002 IF (ERR1 .NE. 1) WRITE (IPR, 996) ERR1, ERR2 09910002 905 CONTINUE 09920002 C 09930002 C FREE ALL SUBPOOL 1 09940002 C 09950002 910 CONTINUE 09960002 CALL FRESP1 09970002 C 09980002 IF (JOBID(1:3) .EQ. TSO) THEN 09990002 CALL TMSTOP 10000002 ENDIF 10010002 C 10020002 C 10030002 C 10040002 IF( MCRTF.LT.-1 .OR. MCRTFM.LT.-1 ) CALL XDUMPX 10050002 920 STOP 10060002 C 10070002 C FORMAT STATEMENTS 10080002 C 10090002 9000 FORMAT (/5X,'PROCESSING HAS BEGUN') 10100002 C 10110002 C FORMAT STATEMENT FOR THE ACCT CARD. 10120002 C ACCOUNT CODE (SECOND "A4" & "1X" BELOW) WILL BE REDONE AS AN 10130002 C INTEGER USING S1CVBN. 10140002 CC990 FORMAT(A4,A2,A4,1X,A1,A1,I2,I5,4A4,A2,8A4,1X,I3,A2,I4) 10150002 990 FORMAT(A4,A2,A4,1X,A1,A1,I2,I5, 51X,I3,A2,I4) 10160002 C 10170002 C FORMAT STATEMENT FOR THE LINE CARD. 10180002 CC991 FORMAT(A4,3A1,2X,A1,2I5,2X,2A4,9I5,1X,A4) 10190002 CC991 FORMAT(A4,3A1,2X,A1,2I5, 10X,9I5,1X,A4) 10200002 991 FORMAT(A4,3A1,2X,A1,2I5, 10X,5I5,F5.0,3I5,1X,A4) 10210002 C 10220002 995 FORMAT (/5X,'*** UNALLOCATE OF THE HISTORY RECORDS WORKFILE ', 10230002 * 'FAILED. ERROR CODE = ',I4,' SVC99 ERROR = ',Z8,' ***') 10240002 C 10250002 996 FORMAT (/5X,'*** UNALLOCATE OF THE HISTORY OPAP WORKFILE ', 10260002 * 'FAILED. ERROR CODE = ',I4,' SVC99 ERROR = ',Z8,' ***') 10270002 C 10280002 997 FORMAT (/5X,'*** NO ORGANIZATION CHARGE CODE SPECIFIED ON THE', 10290003 * ' ACCT CARD ***') 10300003 C 10310002 END 10320002