CTITLEISPARC -- MAIN DRIVER PROGRAM FOR SECOND GENERATION OF SPARC 00010019 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020019 CA DESIGNERS DANIEL POLAK AND RALPH MCMILLAN 00030019 CA LANGUAGE VS FORTRAN 00040019 CA SYSTEM IBM 00050019 CA WRITTEN 06-30-87 00060019 C REVISED 9/14/87 REM. CHANGE TEST FOR FOREGROUND TO CHECK JOBID 00070019 C REVISED 9/21/87 REM. IN FOREGROUND: IF LINK IS REQUIRED, DO NOT 00080019 C EXECUTE UNLESS WANTS TO WAIT ON LINK. 00090019 C REVISED 10/15/87 REM. ADD DUMMF TO PARAMETER LIST FOR FJPROC. 00100019 C REVISED 11/04/87 REP. REVISE PROCLC & PROCLI ARRAY UTILIZATION. 00110019 C REVISED 11/09/87 REP. CHANGES TO EXECUTE THE PROC. 00120019 C REVISED 02/25/88 REP. FIX UNALLOCATE OF UNIRAS FILES AND FT98 FOR00130019 C FOREGROUND. ALSO PREVENT PROC EXECUTION IN 00140019 C FOREGROUND. 00150019 C REVISED 02/26/88 REP. CHANGED TO UNALLOCATE ALL FILES WHEN USATT 00160019 C OR USLOAD RETURN BAD CODE. ALSO REMOVE 00170019 C DBG.SPARCX.LOAD FOR SYSLLIB LINK. 00180019 C REVISED 02/27/88 REP. ADD SEARCH FOR DUMPROC IN JCL OF FOREGROUND00190019 C EXECUTION. CHANGE VF3DPARM & GM3DPARM TO 00200019 C USNWRK/UGUWRK ALLOCATION/DEALLOCATION. 00210019 C REVISED 03/08/88 REM. FIX SPACE CALCULATION FOR SEISPARM. 00220019 C REVISED 03/24/88 REM. REDUCE LDRSIZ TO 5000 FROM 6000. 00230019 C REVISED 03/28/88 REP. CHANGE LDRSIZ BACK TO 6000. 00240019 C REVISED 03/30/88 REP. CHANGE DEBUG LEVEL PRINTS ON LINE CARD TO 00250019 C * - FORTRAN LISTINGS 00260019 C $ - FILE DEALLOCATIONS & FORTRAN LISTINGS 00270019 C # - FILE DEALLOCATIONS & FORTRAN LISTINGS 00280019 C REVISED 04/04/88 REP. ADD CATALOG CHECK FOR ULIB DSN'S. 00290019 C REVISED 04/19/88 REM. ADD TEMPORARY DATA SET NAMES FOR FILES. 00300019 C REVISED 05/27/88 REM. DOUBLE SIZE OF HISTPARM FILE TO 1000. 00310019 C REVISED 06/02/88 REP. CHANGE TEMPORARY DSN FOR SYSTERM BACK TO 00320019 C SYSTEM DEFAULT (DEALLOCATION PROBLEM OCCURS00330019 C ON DUMMY ALLOCATIONS WITH TEMPORARY DSNAME)00340019 C REVISED 09/06/88 ESN. ADD IN MATH ADVANTAGE LIBRARY TO LINK. 00350019 C REVISED 12/07/88 WAB. CHANGE USNWRK CALLS TO USNVIO; CHANGE SYSDA00360019 C TO VIO FOR HISTPARM, VF3DPARM,SEISPARM, 00370019 C REVISED 12/27/88 WAB. CHANGE SYSIN, SYSLIN, UNIRAST & FT05F001 00380019 C FILES TO VIO 00390019 C REVISED 03/06/89 ESN. ALLOCATE FT97 TO PRINTER. 00400019 C REVISED 03/13/89 ESN. ALLOCATE FIO FILES WITH PROCESS NAMES. 00410019 C REVISED 03/15/89 TJT. MODIFY GM3DPARM FILE LRECL & BLKSIZE. 00420019 C USE VIO UNLESS TOO LARGE. 00430019 C REVISED 04/07/89 ESN. ALLOCATE FT97 TO DUMMY IF NOT WANTED. 00440019 C REVISED 05/03/89 ESN. ALLOCATE GM3DPARM AND VF3DPARM FILES TO 00450019 C VIO AND IF ERROR RETURNED, TRY SYSDA. 00460019 C REVISED 08/10/89 JJC. CHANGED THE CALCULATION OF THE NUMBER OF 00470019 C RECORDS FOR THE PARAMETER FILE IN CASE OF 00480019 C VELF PROCESS EXISTING. 00490019 C REVISED 12/18/89 RDK. ADDED DBG.UNISEC.LOAD TO LIBRARY LINK 00500019 C LIST. 00510019 C REVISED 02/22/90 RDK. CHANGE UNISEC FOR V 3.0. 00520019 C REVISED 07/24/90 PJF. CHANGE UNISEC FOR V 3.1. AND FORTRAN 2.4 00530019 C REVISED 08/09/90 ESN. ALLOW UP TO 25 LIBRARIES IN LINK LIST. 00540019 C REVISED 09/12/90 ESN. ADD AN EXTRA TRACK FOR VIO VILES. 00550019 C REVISED 10/22/90 PJF. CHANGED FOR UNISEC VERSION 4.0. 00560019 C REVISED 01/09/91 ESN. DETERMINE SPACE NEEDED FOR GM3DPARM AND 00570019 C VF3DPARM FILES, THEN ALLOCATE TO EITHER 00580019 C VIO OR DISK. 00590019 C REVISED 02/25/91 ESN. ALLOCATE PIO FILE. 00600019 C REVISED 08/20/91 LWC. CHANGE UNISEC FOR VERSION 4.1 00610019 C REVISED 09/29/91 ESN. CHECK ON 3-CHARACTERS OF TSO ID. 00620019 C REVISED 09/30/91 ESN. ALLOCATE FT97 IF TSO. 00630019 C REVISED 11/04/91 ESN. LIMIT SEISPARM FILE TO 50000 BLOCKS. 00640019 C REVISED 01/27/92 ESN. CHANGE 'DBGRDK.IBM.SPARCD.LOAD' TO 00650019 C 'DBG.IBM.SPARCD.LOAD' AND CHECK FOR ALL 00660019 C GAP ORG CODES INSTEAD OF JUST '21598'. 00670019 C REVISED 01/28/92 ESN. CHECK FOR ONLY PRODUCTION ORG CODES. 00680019 C REVISED 09/08/93 ESN. REMOVE 'SYS1.SAPOLMDO' FROM LINKLB. 00690019 C REVISED 11/29/94 ESN. CHANGE ALLOCATION OF SYSLOUT TO REMOVE VBA 00700019 CA 00710019 CA 00720019 CA THIS PROGRAM DRIVES THE SPARC PROCESSING SYSTEM. 00730019 CA 00740019 CA 00750019 C EJECT 00760019 C 00770019 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00780019 C 00790019 C NAME TYPE DESCRIPTION 00800019 C 00810019 C ADUMMK I4 DYNAMIC ALLOCATION KEYS FOR A DUMMY FILE 00820019 C ADUMMP CH8 DYNAMIC ALLOCATION PARAMETERS FOR A DUMMY FILE 00830019 C ADYNAK I4 DYNAMIC ALLOCATION KEYS FOR FILE DYNALCDS 00840019 C ADYNAP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE DYNALCDS 00850019 C AFT05K I4 DYNAMIC ALLOCATION KEYS FOR FILE FT05F001 00860019 C AFT05N CH44 DYMAMICALLY ALLOCATED DSN FOR FILE FT05F001 00870019 C AFT05P CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE FT05F001 00880019 C AHISTK I4 DYNAMIC ALLOCATION KEYS FOR FILE HISTPARM 00890019 C AHISTN CH44 DYMAMICALLY ALLOCATED DSN FOR FILE HISTPARM 00900019 C AHISTP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE HISTPARM 00910019 C AISHRK I4 DYNAMIC ALLOCATION KEYS FOR INPUT ONLY, SHARED 00920019 C ACCESS FILES 00930019 C ACCESS FILES 00940019 C AISHRP CH8 DYNAMIC ALLOCATION PARAMETERS FOR INPUT ONLY, SHARED00950019 C ACCESS FILES 00960019 C AOUTHK I4 DYNAMIC ALLOCATION KEYS FOR OUTPUT TO HOLD QUEUE 00970019 C AOUTHP CH8 DYNAMIC ALLOCATION PARAMETERS FOR OUTPUT TO HOLD 00980019 C QUEUE 00990019 C AOUTPK I4 DYNAMIC ALLOCATION KEYS FOR OUTPUT TO PRINTER 01000019 C AOUTPP CH8 DYNAMIC ALLOCATION PARAMETERS FOR OUTPUT TO PRINTER 01010019 C ASEISK I4 DYNAMIC ALLOCATION KEYS FOR FILE SEISPARM 01020019 C ASEISN CH44 DYMAMICALLY ALLOCATED DSN FOR FILE SEISPARM 01030019 C ASEISP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE SEISPARM 01040019 C ASHRK I4 DYNAMIC ALLOCATION KEYS FOR SHARED ACCESS FILES 01050019 C ASHRP CH8 DYNAMIC ALLOCATION PARAMETERS FOR SHARED ACCESS FILE01060019 C ASLIBK I4 DYNAMIC ALLOCATION KEYS FOR FILE SYSLIB 01070019 C ASLIBP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE SYSLIB 01080019 C ASLINK I4 DYNAMIC ALLOCATION KEYS FOR FILE SYSLIN 01090019 C ASLINP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE SYSLIN 01100019 C ASSINK I4 DYNAMIC ALLOCATION KEYS FOR FILE SYSIN 01110019 C ASSINP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE SYSIN 01120019 C ATERMK I4 DYNAMIC ALLOCATION KEYS FOR OUTPUT TO TERMINAL 01130019 C ATERMP CH8 DYNAMIC ALLOCATION PARAMETERS FOR OUTPUT TO TERMINAL01140019 C AUNIK I4 DYNAMIC ALLOCATION KEYS FOR FILE UNIRAST 01150019 C AUNIN CH44 DYMAMICALLY ALLOCATED DSN FOR FILE UNIRAST 01160019 C AUNIP CH8 DYNAMIC ALLOCATION PARAMETERS FOR FILE UNIRAST 01170019 C ALDSNN CH44 DATA SET NAME FOR DOING ALLOCATIONS & DEALLOCATIONS 01180019 C BLANKN CH44 BLANK DATA SET NAME 01190019 C CARD CH80 SPARC CARD IMAGE 01200019 C COUNT I4 CONCATENATED DATASET COUNTER 01210019 C CSLIBP CH8 CHARCTER STRING 'SYSLIB ' 01220019 C DALLOC CH44 LIST OF ALLOCATED DSN'S THAT NEED TO BE FREED 01230019 C DALLOP CH44 LIST OF ALLOCATED PRINT DSN'S THAT NEED TO BE FREED 01240019 C DATE CH8 DATE IN EBCDIC CODE, MO/DA/YR 01250019 C DDNCC CH8 FILE NAMES OF CONCATENATED DATASETS 01260019 C DEST CH4 SYSOUT NODE DESTINATION 01270019 C DFDEST CH4 DEFAULT SYSOUT NODE DESTINATION 01280019 C DLM CH4 CHARACTER STRING 'DLM=' 01290019 C DLMCRD CH7 CHARACTER STRING '//SEIS.' 01300019 C DLMTR CH2 JCL DELIMITER 01310019 C DSNSHR CH44 NAMES OF DATASETS ALLOCATED 'SHR' 01320019 C DSNUNI CH44 NAMES OF UNIRAS DATASET FOR INPUT ONLY, 'SHR' ACCESS01330019 C ECB I4 EVENT CONTROL BLOCK 01340019 C ERR I4 ERROR FLAG 01350019 C ERRIN I4 SVC99 ERROR CODE 01360019 C FALLOC CH8 LIST OF ALLOCATED FILES THAT NEED TO BE FREED 01370019 C FALLOP CH8 LIST OF ALLOCATED PRINT FILES THAT NEED TO BE FREED 01380019 C FILEN CH8 FILE NAME 01390019 C FILSHR CH8 NAMES OF FILES FOR DATASETS ALLOCATED 'SHR' 01400019 C FILUNI CH8 NAMES OF UNIRAS FILES FOR INPUT ONLY, SHARED ACCESS 01410019 C FT05F I4 FT05F001 ALLOCATED FLAG 01420019 C GAPORG CH5 GAP ORG CODE NUMBERS 01430019 C GAPX CH4 SYSOUT NODE FOR OPERATER'S REPORT 01440019 C GA3D CH4 GA3D CHARACTER STRING 01450019 C GA3DF I4 GA3D PROCESS PRESENT FLAG 01460019 C GEOMF I4 GEOM PROCESS PRESENT FLAG 01470019 C GM3D CH4 GM3D CHARACTER STRING 01480019 C GM3DDA I4 DIRECT DCB ADDRESS (ONLY SAVED FOR UNALLOCATE) 01490019 C GM3DDD CH8 VF3DPARM DDNAME 01500019 C GM3DSA I4 SEQUENTIAL DCB ADDRESS (ONLY SAVED FOR UNALLOCATE) 01510019 C GM3DF I4 GM3D PROCESS PRESENT FLAG 01520019 C IDYNAP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE DYNALCDS 01530019 C IFT05P I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE FT05F001 01540019 C IHISTP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE HISTPARM 01550019 C INP I4 FILE UNIT NUMBER FOR THE SPARC CARDS 01560019 C IPR I4 CURRENT PRINT UNIT NUMBER 01570019 C IPREP I4 PRINT UNIT NUMBER FOR THE PREP STEP 01580019 C IPROC I4 PRINT UNIT NUMBER FOR THE PROC STEP 01590019 C ISEISP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE SEISPARM 01600019 C ISLINP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE SYSLIN 01610019 C ISSINP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE SYSIN 01620019 C ITR I4 PRINT UNIT NUMBER FOR THE TERMINAL 01630019 C IXNA I4 INDEX INTO PROCLC FOR PROCESS NAME (=1) 01640019 C IXOCUR I4 INDEX INTO PROCLI FOR PROCESS OCCURRENCE NO. (=3) 01650019 C IXPRNT I4 INDEX INTO PROCLI FOR PRINT UNIT (=5) 01660019 C IXPTAB I4 INDEX INTO PROCLI FOR PTAB INDEX (=4) 01670019 C IXRNO I4 INDEX INTO PROCLI FOR PROCESS NUMBER (=2) 01680019 C IUNIP I4 DYNAMIC ALLOCATION PARAMETERS FOR FILE UNIRAST 01690019 C JCL CH1 CHARACTER STRING '/' 01700019 C JCLASS CH1 JOB CLASS 01710019 C JOBID CH8 JOB ID - USED TO TEST FOR FOREGROUND 01720019 C JOBNAM CH8 JOB NAME 01730019 C LCBGSP I4 BEGINNING SHOTPOINT FROM THE LINE CARD 01740019 C LCDRYF CH4 PREPARATION OR PROCESSING FLAG FROM LINE CARD 01750019 C LCENSP I4 ENDING SHOTPOINT FROM THE LINE CARD 01760019 C LCMXLN I4 MAXIMUM NUMBER OF 3D LINES FROM THE LINE CARD 01770019 C LCNSP I4 NUMBER OF SHOTPOINTS ON THE LINE FROM THE LINE CARD 01780019 C LCTPSP I4 NUMBER OF TRACES PER SHOTPOINT FROM THE LINE CARD 01790019 C LDRSIZ CH4 SIZE FOR THE LOADER AS A CHARACTER STRING OF '7000' 01800019 C LINE CH4 CHARACTER STRING 'LINE' 01810019 C LINECD CH80 LINE CARD 01820019 C LNKPREP I4 LINK (LOAD) NEEDED FLAG FOR PREP 01830019 C LNKPROC I4 LINK (LOAD) NEEDED FLAG FOR PROC 01840019 C LINKLB CH44 SPARC LINK DATASET NAMES 01850019 C MXALC I4 MAXIMUM NUMBER OF ALLOCATED FILES 01860019 C MXALP I4 MAXIMUM NUMBER OF ALLOCATED PRINT FILES 01870019 C MXPROC I4 MAXIMUM NUMBER OF PROCESSES ALLOWED IN A SPARC JOB 01880019 C MXULIB I4 MAXIMUM NUMBER OF ULIB CARDS ALLOWED 01890019 C MXVELF I4 MAXIMUM NUMBER CARDS FOR ONE VELOCITY ID IN VELF. 01900019 C NALLOC I4 NUMBER OF ALLOCATED FILES THAT NEED TO BE FREED 01910019 C NALLOP I4 NUMBER OF ALLOCATED PRINT FILES THAT NEED TOBE FREED01920019 C NCARDS I4 NUMBER OF SPARC CARDS 01930019 C NGAPOC I4 NUMBER OF GAP ORG CODES 01940019 C NGM3D I4 NUMBER OF GM3D CARDS 01950019 C NINAF I4 NINA PROCESS PRESENT FLAG 01960019 C NLLINK I4 NUMBER OF SPARC LINK DATASETS 01970019 C NOERR I4 PRINT FLAG INDICATING WHETHER NO ERRORS OCCURRED 01980019 C NOERRZ I4 HEX. NUMBER INDICATING A SUCCESSFUL ATTACH OF A 01990019 C SUBTASK 02000019 C NPPSHR I4 NUMBER OF DATASETS TO ALLOCATE WITH SHR ACCESS IN 02010019 C PREP STEP 02020019 C NPROCC I4 NUMBER OF PROC CARDS 02030019 C NPROC I4 NUMBER OF PROCESSES 02040019 C NPTAB I4 NUMBER OF PROCESSES IN THE MASTER PROCESS TABLE 02050019 C NSHRD I4 NUMBER OF DSN'S TO ALLOCATE WITH SHARED ACCESS 02060019 C NSYSLB I4 NUMBER OF DATASETS CONCATENATED TO THE SYSLIB FILE 02070019 C NULIB I4 NUMBER OF ULIB CARDS FOUND 02080019 C NUNID I4 NUMBER OF INPUT ONLY, SHARED ACCESS UNIRAS DATASETS 02090019 C NVELF I4 NUMBER OF VELF CARDS 02100019 C NVELID I4 NUMBER OF VELOCITY ID IN VELF CARDS. 02110019 C PARMS C100 ARRAY FOR EXEC CARD PARMS. 02120019 C PRCNDX I4 INDICES OF PROCESSES ON THE PROC CARD IN ALPHABETI- 02130019 C CAL ORDER 02140019 C PRINT I4 SPARC PRINT OUTPUT INDICATOR 02150019 C PROCCD CH80 ARRAY OF PROC CARDS 02160019 C PROCLC CH4 CHARACTER VARIABLES OF THE PROCESSING LIST TABLE 02170019 C PROCLC(1, N) = PROCESS NAME (KPNA) 02180019 C PROCLC(2, N) = PMODE. 1 CHARACTER 02190019 C PROCLC(3, N) = 'TAPE' WHEN TAPE OPTION 02200019 C PROCLC(4, N) = NOT USED 02210019 C PROCLC(5, N) = NOT USED 02220019 C PROCLC(6, N) = NOT USED 02230019 C PROCLI I4 INTEGER VARIABLES OF THE PROCESSING LIST TABLE 02240019 C PROCLI(1, N) = PROCESS NUMBER (KPRNO) 02250019 C PROCLI(2, N) = PROCESS OCCURRENCE NUMBER (KPOCUR) 02260019 C PROCLI(3, N) = INTEGER DEBUG FLAG (KPBUGF) 02270019 C PROCLI(4, N) = PTABMSTR ENTRY INDEX 02280019 C PROCLI(5, N) = PRINT UNIT NUMBER (KPPRNT) 02290019 C PROCLI(6, N) = NUMBER OF CARDS IN THIS PROCESS 02300019 C PROCLI(7, N) = DISK ADDRESS OF CARDS OF THIS PROCESS02310019 C PROCLI(8, N) = PROCESS EXIT STATUS (KPRTF) 02320019 C PROCLI(9, N) = WARNING FLAG (KPWARN) 02330019 C PROCLI(10, N) = PROCESS TIME (KPTIME) 02340019 C PROCLI(11, N) = PROCESS WORK I/O (KPWKIO) 02350019 C PROCLI(12, N) = NOT USED 02360019 C PROCLI(13, N) = NOT USED 02370019 C PROCLI(14, N) = NOT USED 02380019 C PROCLI(15, N) = NOT USED 02390019 C PROCN CH4 PROCESS NAME 02400019 C PRUNIT I4 PRINT UNIT NUMBERS ALLOCATED FOR EACH PROCESS 02410019 C PTABC CH4 CHARACTER VARIABLES IN THE MASTER PROCESS TABLE 02420019 C PTABI I4 INTEGER VARIABLES IN THE MASTER PROCESS TABLE 02430019 C SEISF I4 SEISPARM ALLOCATED FLAG 02440019 C SPCLUN I4 UNIT NUMBER FOR OUTPUT OF DYNAMICALLY GENERATED 02450019 C SOURCE CODE 02460019 C TIME CH8 TIME IN EBCDIC CODE, HR:MI:SC 02470019 C TNLINK I4 TOTAL (ALLOWED) NUMBER OF LINK DATASETS (STANDARD + 02480019 C THOSE FROM ULIB CARDS) 02490019 C TSO CH3 'TSU' 02500019 C TVELF I4 TOTAL ESTIMATED RECORDS FOR VELF PARAMETER FILE. 02510019 C ULIB CH4 CHARACTER STRING 'ULIB' 02520019 C ULIBDS CH65 DATASET NAMES TAKEN FROM THE ULIB CARDS 02530019 C UNIPRT CH8 CHARACTER STRING 'UNIPRNT ' 02540019 C UNIRF I4 UNIRAS ALLOCATED FLAG 02550019 C USERA CH1 ANSWER TO FOREGROUND QUESTION ABOUT LINKING. 02560019 C VF3DDA I4 DIRECT DCB ADDRESS (ONLY SAVED FOR UNALLOCATE) 02570019 C VF3DDD CH8 VF3DPARM DDNAME 02580019 C VF3DSA I4 SEQUENTIAL DCB ADDRESS (ONLY SAVED FOR UNALLOCATE) 02590019 C VF3DF I4 VF3D PROCESS PRESENT FLAG 02600019 C 02610019 C 02620019 C EJECT 02630019 C 02640019 PROGRAM ISPARC 02650019 C 02660019 IMPLICIT INTEGER (A-Z) 02670019 C 02680019 PARAMETER (INP=1, IPREP=98, IPROC=99, ITR=2, MXALC=30, MXALP=100, 02690019 * MXPROC=90, MXULIB=7, NGAPOC=3, NLLINK=16, NSHRD=6, 02700019 * NUNID=2, SPCLUN=7, TNLINK=25) 02710019 C 02720019 PARAMETER (IXNA=1, IXRNO=1, IXOCUR=2, IXPTAB=4, IXPRNT=5) 02730019 C 02740019 COMMON /MPTABI/ NPTAB, PTABI(14, 250) 02750019 COMMON /MPTABC/ PTABC(5, 250) 02760019 C 02770019 CHARACTER*4 PTABC 02780019 INTEGER PTABI 02790019 REAL TDATE(2), TTIME(2) 02800019 REAL TOTAL 02810019 C 02820019 C***********************************************************************02830019 C 02840019 C EXPLICIT TYPE DECLARATION SECTION 02850019 C 02860019 C***********************************************************************02870019 C 02880019 C CHARACTER ARRAYS 02890019 C 02900019 CHARACTER*44 DALLOC (MXALC) 02910019 CHARACTER*44 DALLOP (MXALP) 02920019 CHARACTER*8 DDNCC (TNLINK) 02930019 CHARACTER*44 DSNSHR (NSHRD) 02940019 CHARACTER*44 DSNUNI (NUNID) 02950019 CHARACTER*8 FALLOC (MXALC) 02960019 CHARACTER*8 FALLOP (MXALP) 02970019 CHARACTER*8 FILSHR (NSHRD) 02980019 CHARACTER*8 FILUNI (NUNID) 02990019 CHARACTER*5 GAPORG (NGAPOC) 03000019 CHARACTER*44 LINKLB (NLLINK) 03010019 CHARACTER*100 PARMS 03020019 CHARACTER*80 PROCCD (10) 03030019 CHARACTER*4 PROCLC (6, MXPROC) 03040019 CHARACTER*65 ULIBDS (MXULIB) 03050019 C 03060019 C INTEGER ARRAYS 03070019 C 03080019 INTEGER ECB (2) 03090019 INTEGER PROCLI (15, MXPROC) 03100019 INTEGER PRCNDX (MXPROC) 03110019 C 03120019 C CHARACTER VARIABLES AND CONSTANTS 03130019 C 03140019 CHARACTER*44 ALDSNN 03150019 CHARACTER*44 BLANKN 03160019 CHARACTER*80 CARD 03170019 CHARACTER*8 CSLIBP 03180019 CHARACTER*8 DATE 03190019 CHARACTER*4 DEST 03200019 CHARACTER*4 DFDEST 03210019 CHARACTER*4 DLM 03220019 CHARACTER*7 DLMCRD 03230019 CHARACTER*2 DLMTR 03240019 CHARACTER*8 FILEN 03250019 CHARACTER*4 GAPX 03260019 CHARACTER*4 GA3D 03270019 CHARACTER*4 GM3D 03280019 CHARACTER*2 JCL 03290019 CHARACTER*1 JCLASS 03300019 CHARACTER*8 JOBID 03310019 CHARACTER*8 JOBNAM 03320019 CHARACTER*4 LCDRYF 03330019 CHARACTER*4 LDRSIZ 03340019 CHARACTER*4 LINE 03350019 CHARACTER*80 LINECD 03360019 CHARACTER*8 MAPDDN 03370019 CHARACTER*4 PROCN 03380019 CHARACTER*8 SYSPRNT 03390019 CHARACTER*8 SYSTERM 03400019 CHARACTER*8 TIME 03410019 CHARACTER*3 TSO 03420019 CHARACTER*4 ULIB 03430019 CHARACTER*8 UNIPRT 03440019 CHARACTER*1 USERA 03450019 CHARACTER*4 VELF 03460019 C 03470019 C VARIABLES FOR DYNAMICALLY ALLOCATING GM3DPARM 03480019 C 03490019 INTEGER GM3DSA 03500019 INTEGER GM3DDA 03510019 CHARACTER*8 GM3DDD /'GM3DPARM'/ 03520019 C 03530019 C VARIABLES FOR DYNAMICALLY ALLOCATING HISTPARM 03540019 C 03550019 INTEGER AHISTK (8) /1, 4, 5, 9, 10, 19, 21, 60/ 03560019 CHARACTER*44 AHISTN /'&&HISTPARM '/ 03570019 CHARACTER*8 AHISTP (8) /'HISTPARM', 'NEW ', 'DELETE ', 03580019 * ' ', ' ', ' ', 03590019 * 'VIO ','DA '/ 03600019 INTEGER IHISTP (16) 03610019 EQUIVALENCE (AHISTP(1), IHISTP(1)) 03620019 C 03630019 C VARIABLES FOR DYNAMICALLY ALLOCATING VF3DPARM 03640019 C 03650019 INTEGER VF3DSA 03660019 INTEGER VF3DDA 03670019 CHARACTER*8 VF3DDD /'VF3DPARM'/ 03680019 C 03690019 C VARIABLES FOR DYNAMICALLY ALLOCATING SEISPARM 03700019 C 03710019 INTEGER ASEISK (8) /1, 4, 5, 9, 10, 19, 21, 60/ 03720019 CHARACTER*44 ASEISN /'&&SEISPARM '/ 03730019 CHARACTER*8 ASEISP (8) /'SEISPARM', 'NEW ', 'DELETE ', 03740019 * ' ', ' ', ' ', 03750019 * 'VIO ','DA '/ 03760019 INTEGER ISEISP (16) 03770019 EQUIVALENCE (ASEISP(1), ISEISP(1)) 03780019 C 03790019 C VARIABLES FOR DYNAMICALLY ALLOCATING SYSIN 03800019 C 03810019 INTEGER ASSINK (11) /1, 4, 5, 7, 10, 11, 21, 48, 60, 66, 03820019 * 73/ 03830019 CHARACTER*8 ASSINP (11) /'SYSIN ', 'NEW ', 'DELETE ', 03840019 * ' ', ' ', ' ', 'VIO ', ' ', 03850019 * 'PS ', ' ', 'FB '/ 03860019 INTEGER ISSINP (22) 03870019 EQUIVALENCE (ASSINP(1), ISSINP(1)) 03880019 C 03890019 C VARIABLES FOR DYNAMICALLY ALLOCATING SYSLIN 03900019 C 03910019 INTEGER ASLINK (11) /1, 4, 5, 7, 10, 11, 21, 48, 60,66,73/03920019 CHARACTER*8 ASLINP (11) /'SYSLIN ', 'NEW ', 'DELETE ', 03930019 * ' ', ' ', ' ', 'VIO ', ' ', 03940019 * 'PS ', ' ', 'FB '/ 03950019 INTEGER ISLINP (22) 03960019 EQUIVALENCE (ASLINP(1), ISLINP(1)) 03970019 C 03980019 C VARIABLES FOR DYNAMICALLY ALLOCATING SYSLIB 03990019 C 04000019 INTEGER ASLIBK (2) /1, 4/ 04010019 CHARACTER*8 ASLIBP (2) /'SYSLIB ', 'SHR '/ 04020019 C 04030019 C VARIABLES FOR DYNAMICALLY ALLOCATING FT02F001 TO THE TERMINAL 04040019 C 04050019 INTEGER ATERMK (3) /1, 40, 73/ 04060019 CHARACTER*8 ATERMP (3) /'FT02F001', ' ','VBA '/ 04070019 C 04080019 C VARIABLES FOR DYNAMICALLY ALLOCATING FT05F001 04090019 C 04100019 INTEGER AFT05K (7) /1, 4, 5, 9, 10, 21, 60/ 04110019 CHARACTER*44 AFT05N /'&&FT05F001 '/ 04120019 CHARACTER*8 AFT05P (7) /'FT05F001', 'NEW ', 'DELETE ', 04130019 * ' ', ' ', 'VIO ', 04140019 * 'PS '/ 04150019 INTEGER IFT05P (14) 04160019 EQUIVALENCE (AFT05P(1), IFT05P(1)) 04170019 C 04180019 C VARIABLES FOR DYNAMICALLY ALLOCATING A FILE TO THE PRINTER 04190019 C 04200019 INTEGER AOUTPK (4) /1, 24, 73, 88/ 04210019 CHARACTER*8 AOUTPP (4) /' ', 'A ', 'VBA ', 04220019 * ' '/ 04230019 C 04240019 C VARIABLES FOR DYNAMICALLY ALLOCATING A FILE TO THE HOLD QUEUE 04250019 C OR MSSGCLASS 04260019 INTEGER AOUTHK (5) /1, 24, 73, 88, 89/ 04270019 CHARACTER*8 AOUTHP (5) /' ', 'H ', 'VBA ', 04280019 * ' ', ' '/ 04290019 C 04300019 C VARIABLES FOR DYNAMICALLY ALLOCATING A FILE TO A DUMMY DATASET 04310019 C 04320019 INTEGER ADUMMK (2) /1, 36/ 04330019 CHARACTER*8 ADUMMP (2) /' ', ' '/ 04340019 C 04350019 C VARIABLES FOR DYNAMICALLY ALLOCATING AN EXISTING DATASET WITH 04360019 C SHARED ACCESS 04370019 C 04380019 INTEGER ASHRK (2) /1, 4/ 04390019 CHARACTER*8 ASHRP (2) /' ', 'SHR '/ 04400019 C 04410019 C VARIABLES FOR DYNAMICALLY ALLOCATING INPUT ONLY, SHARED ACCESS 04420019 C DATASETS (UNIRAS) 04430019 C 04440019 INTEGER AISHRK (4) /1, 4, 33, 82/ 04450019 CHARACTER*8 AISHRP (4) /' ', 'SHR ', 'I ', ' '/ 04460019 C 04470019 C VARIABLES FOR DYNAMICALLY ALLOCATING UNIRAST 04480019 C 04490019 INTEGER AUNIK (8) /1, 4, 5, 8, 10, 21, 60, 82/ 04500019 CHARACTER*44 AUNIN /'&&UNIRAST '/ 04510019 CHARACTER*8 AUNIP (8) /'UNIRAST ', 'NEW ', 'DELETE ', 04520019 * ' ', ' ', 'VIO ', 04530019 * 'PS ', ' '/ 04540019 INTEGER IUNIP (14) 04550019 EQUIVALENCE (AUNIP(1), IUNIP(1)) 04560019 C 04570019 C VARIABLES FOR DYNAMICALLY ALLOCATING DYNALCDS 04580019 C 04590019 INTEGER ADYNAK (8) /1, 4, 5, 8, 10, 11, 21, 60/ 04600019 CHARACTER*8 ADYNAP (8) /'DYNALCDS', 'NEW ', 'DELETE ', 04610019 * ' ', ' ', ' ', 'VIO ', 04620019 * 'PS '/ 04630019 INTEGER IDYNAP (16) 04640019 EQUIVALENCE (ADYNAP(1), IDYNAP(1)) 04650019 C 04660019 C VARIABLES FOR DYNAMICALLY UNALLOCATING FILES 04670019 C 04680019 INTEGER UNALK (2) /1, 5/ 04690019 CHARACTER*8 UNALP (2) /' ', ' '/ 04700019 C 04710019 C DATA STATEMENT DEFINING THE STANDARD LINK DATASET NAMES 04720019 C 04730019 DATA LINKLB /'DBG.SPARCXA.LOAD ', 04740019 * 'DBG.SPARCJG.LOAD ', 04750019 * 'SYS3.FORTVS.VSF2LINK ', 04760019 * 'SYS3.FORTVS.VSF2LOAD ', 04770019 * 'SYS3M.FORTVS.VSF2FORT ', 04780019 * 'SYS3.ESV.ESVVLIB ', 04790019 * 'DBG.UNI5R3.EDP.LOAD ', 04800019 * 'DBG.UNI5R3.ORIG.LOAD ', 04810019 * 'DBG.VER41.UNILIB.LOAD ', 04820019 * 'SYS1.SUBLIB ', 04830019 * 'SYS1.LINKLIB ', 04840019 * 'DBG.IBM.SPARCD.LOAD ', 04850019 * 'DPR.MATHADV.LOAD ', 04860019 * 'DPR.JOBGEN.LOAD ', 04870019 * 'DPR.SPARCXA.LOAD ', 04880019 * 'DPR.SPDRIVER.LOAD '/ 04890019 C 04900019 C DATA STATEMENT DEFINING THE SHARED ACCESS DATASET NAMES 04910019 C 04920019 DATA DSNSHR /'SYS1.IDLIB ', 04930019 * 'DBG.SPARC.ACCOUNT ', 04940019 * 'DBG.SPARC.PRIORITY ', 04950019 * 'DBG.SPARC.PLOTQ ', 04960019 * 'DBG.SPARC.PLOTQA ', 04970019 * 'SYSM.PIOAM.DATA '/ 04980019 C 04990019 C DATA STATEMENT DEFINING THE INPUT ONLY SHARED ACCESS DATASET NAMES05000019 C 05010019 DATA DSNUNI /'DBG.UNI5R3.ORIG.UNIMESS ', 05020019 * 'DBG.UNI5R3.ORIG.UNITEXT '/ 05030019 C 05040019 C DATA STATEMENT DEFINING THE SHARED ACCESS FILE NAMES 05050019 C 05060019 DATA FILSHR /'SPARCSID', 05070019 * 'SPARCACC', 05080019 * 'PRIORITY', 05090019 * 'ONLINPLT', 05100019 * 'ONLINPLA', 05110019 * 'PIEPF '/ 05120019 C 05130019 C DATA STATEMENT DEFINING THE UNIRAS FILE NAMES 05140019 C 05150019 DATA FILUNI /'UNIMESS ', 05160019 * 'UNITEXT '/ 05170019 C 05180019 C DATA STATEMENT DEFINING THE GAP ORG CODES 05190019 C 05200019 DATA GAPORG /'21598', 05210019 * '45365', 05220019 * '45381' / 05230019 C 05240019 C DATA STATEMENTS FOR INITIALIZATION OF VARIABLES AND CONSTANTS 05250019 C 05260019 DATA ALDSNN /' '/ 05270019 DATA BLANKN /' '/ 05280019 DATA CSLIBP /'SYSLIB '/ 05290019 DATA DFDEST /'N8R2'/ 05300019 DATA DLM /'DLM='/ 05310019 DATA DLMCRD /'//SEIS.'/ 05320019 DATA DLMTR /'@^'/ 05330019 DATA GAPX /'N8R1'/ 05340019 DATA GA3D /'GA3D'/ 05350019 DATA GM3D /'GM3D'/ 05360019 DATA JCL /'//'/ 05370019 DATA LDRSIZ /'6000'/ 05380019 DATA LINE /'LINE'/ 05390019 DATA MAPDDN /'SYSLOUT '/ 05400019 DATA NOERRZ /Z40000000/ 05410019 DATA SYSPRNT /'SYSPRINT'/ 05420019 DATA SYSTERM /'SYSTERM '/ 05430019 DATA TSO /'TSU'/ 05440019 DATA ULIB /'ULIB'/ 05450019 DATA UNIPRT /'UNIPRNT '/ 05460019 DATA VELF /'VELF'/ 05470019 C 05480019 C***********************************************************************05490019 C 05500019 C SPARC PREPARATION STEP SECTION 05510019 C 05520019 C***********************************************************************05530019 C 05540019 C INITIALIZE SOME VARIABLES 05550019 C 05560019 FT05F = 0 05570019 GEOMF = 0 05580019 GA3DF = 0 05590019 GM3DF = 0 05600019 IPR = IPREP 05610019 DUMMF = 0 05620019 EXTEND = 1 05630019 FT97 = 0 05640019 LNKPREP = 0 05650019 LNKPROC = 0 05660019 NALLOC = 0 05670019 NALLOP = 0 05680019 NINAF = 0 05690019 NCARDS = 0 05700019 NGM3D = 0 05710019 NOERR = 0 05720019 NPROC = 0 05730019 NSYSLB = 0 05740019 NULIB = 0 05750019 SEISF = 0 05760019 UNIRF = 0 05770019 VF3DF = 0 05780019 NVELF = 0 05790019 VELFG = 0 05800019 C 05810019 C OBTAIN THE JOB NAME 05820019 C 05830019 CALL JOBINF (JOBNAM, JOBID, JCLASS) 05840019 C 05850019 C GET EXEC CARD PARAMETERS. 05860019 C LOOK FOR "NOEXTEND", "DUMMPROC", AND "SUMMARY". 05870019 C 05880019 PARMS = ' ' 05890019 CALL GETPRM (PARMS) 05900019 I = 1 05910019 C 05920019 5 IF (PARMS(I:I) .EQ. ' ') GO TO 6 05930019 C 05940019 IF (PARMS(I:I+7) .EQ. 'DUMMPROC') THEN 05950019 IF (PARMS(I+8:I+8) .EQ. ',' .OR. 05960019 * PARMS(I+8:I+8) .EQ. ' ') DUMMF = 1 05970019 I = I + 8 05980019 END IF 05990019 C 06000019 IF (PARMS(I:I+7) .EQ. 'NOEXTEND') THEN 06010019 IF (PARMS(I+8:I+8) .EQ. ',' .OR. 06020019 * PARMS(I+8:I+8) .EQ. ' ' ) THEN 06030019 EXTEND = 0 06040019 LNKPREP = 1 06050019 LNKPROC = 1 06060019 END IF 06070019 I = I + 8 06080019 END IF 06090019 C 06100019 IF (PARMS(I:I+6) .EQ. 'SUMMARY') THEN 06110019 IF (PARMS(I+7:I+7) .EQ. ',' .OR. 06120019 * PARMS(I+7:I+7) .EQ. ' ' ) FT97 = 1 06130019 I = I + 7 06140019 END IF 06150019 C 06160019 I = I + 1 06170019 IF (I .LE. 93) GO TO 5 06180019 6 CONTINUE 06190019 C 06200019 C 06210019 FILEN = 'FTXXF001' 06220019 CALL S1BNCV (IPR, FILEN, 3, 2) 06230019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 06240019 C FOR FOREGROUND JOBS, ALLOCATE FT02F001 TO THE TERMINAL 06250019 C ALLOCATE FT98F001 ACCORDING TO THE USER'S CHOICE 06260019 C 06270019 IF (JOBID(1:3) .EQ. TSO) THEN 06280019 CALL DDALOC (3, ATERMK, ATERMP, ALDSNN, ERR, ERRIN) 06290019 IF (ERR .NE. 0) STOP 2 06300019 CAPRT 06310019 CAPRT THE FOLLOWING CODE, COMMENT "CAPRT" WILL ASK THE TERMINAL USER 06320019 CAPRT HOW TO ALLOCATE FT98 AND WILL THEN DYNAMICALLY ALLOCATE IT. 06330019 CAPRT INITIAL USE OF ISPARC WILL DEPEND ON THE FOREGROUND CLIST TO 06340019 CAPRT DO THE ALLOCATION. 06350019 CAPRT 06360019 CAPRT WRITE (ITR, 9000) 06370019 C 06380019 C GET THE OUTPUT PRINT OPTION FROM THE USER 06390019 C 06400019 CAPRT WRITE (ITR, 9010) 06410019 C 06420019 CAPRT10 READ (ITR, 9020) PRINT 06430019 C 06440019 CAPRT IF (PRINT .LT. 1 .OR. PRINT .GT. 4) THEN 06450019 CAPRT WRITE (ITR, 9030) PRINT 06460019 CAPRT GO TO 10 06470019 CAPRT END IF 06480019 C 06490019 C ALLOCATE FT98F001 BASED ON THE PRINT OPTION SELECTED 06500019 C 06510019 CAPRT ALDSNN = BLANKN 06520019 CAPRT IF (PRINT .LT. 3) THEN 06530019 CAPRT WRITE (ITR, 9040) 06540019 C 06550019 CAPRT20 READ (ITR, 9050) DEST 06560019 C 06570019 CAPRT IF (DEST .NE. 'N8R2' .AND. DEST(:2) .NE. 'N1') THEN 06580019 CAPRT WRITE (ITR, 9060) DEST 06590019 CAPRT GO TO 20 06600019 CAPRT END IF 06610019 C 06620019 C ALLOCATE FT98F001 TO THE PRINTER 06630019 C 06640019 CAPRT IF (PRINT .EQ. 1) THEN 06650019 CAPRT AOUTPP(1) = FILEN 06660019 CAPRT AOUTPP(4)(1:4)= DEST 06670019 CAPRT CALL DDALOC (4, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 06680019 C 06690019 C ALLOCATE FT98F001 TO THE HOLD QUEUE 06700019 C 06710019 CAPRT ELSE 06720019 CAPRT AOUTHP(1) = FILEN 06730019 CAPRT AOUTHP(2)(1:4) = 'H ' 06740019 CAPRT AOUTHP(4)(1:4) = DEST 06750019 CAPRT ALDSNN = BLANKN 06760019 CAPRT CALL DDALOC (5, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 06770019 CAPRT END IF 06780019 C 06790019 C ALLOCATE FT98F001 TO THE TERMINAL 06800019 C 06810019 CAPRT ELSE IF (PRINT .EQ. 3) THEN 06820019 CAPRT ATERMP(1) = FILEN 06830019 CAPRT CALL DDALOC (3, ATERMK, ATERMP, ALDSNN, ERR, ERRIN) 06840019 C 06850019 C ALLOCATE FT98F001 TO DUMMY 06860019 C 06870019 CAPRT ELSE IF (PRINT .EQ. 4) THEN 06880019 CAPRT ADUMMP(1) = FILEN 06890019 CAPRT CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 06900019 CAPRT END IF 06910019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 06920019 C FOR BACKGROUND JOBS, ALLOCATE FT98F001 TO MSGCLASS DEFAULT 06930019 C 06940019 ELSE 06950019 ALDSNN = '&&FT98F001 ' 06960019 AOUTHP(1) = FILEN 06970019 AOUTHP(2)(1:4) = ' ' 06980019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 06990019 C-------------------------------------------------------------------- 07000019 IF (ERR .NE. 0) THEN 07010019 WRITE (6, 9070) FILEN, ERR, ERRIN, ALDSNN 07020019 GO TO 332 07030019 END IF 07040019 C 07050019 NALLOP = NALLOP + 1 07060019 DALLOP(NALLOP) = ALDSNN 07070019 FALLOP(NALLOP) = FILEN 07080019 END IF 07090019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 07100019 C 07110019 C ALLOCATE FT97F001 TO PRINT IF NOT FOREGROUND 07120019 C 07130019 IF (JOBID(1:3) .NE. TSO) THEN 07140019 ALDSNN = '&&FT97F001 ' 07150019 CALL S1BNCV (97, FILEN, 3, 2) 07160019 IF (FT97 .EQ. 1) THEN 07170019 AOUTPP(1) = FILEN 07180019 CALL DDALOC (3, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 07190019 ELSE 07200019 ADUMMP(1) = FILEN 07210019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 07220019 ENDIF 07230019 C-------------------------------------------------------------------- 07240019 IF (ERR .NE. 0) THEN 07250019 WRITE (6, 9070) FILEN, ERR, ERRIN, ALDSNN 07260019 GO TO 332 07270019 ENDIF 07280019 C 07290019 NALLOP = NALLOP + 1 07300019 DALLOP(NALLOP) = ALDSNN 07310019 FALLOP(NALLOP) = FILEN 07320019 ELSE 07330019 ALDSNN = '&&FT97F001 ' 07340019 CALL S1BNCV (97, FILEN, 3, 2) 07350019 AOUTPP(1) = FILEN 07360019 CALL DDALOC (3, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 07370019 C-------------------------------------------------------------------- 07380019 IF (ERR .NE. 0) THEN 07390019 WRITE (6, 9070) FILEN, ERR, ERRIN, ALDSNN 07400019 GO TO 332 07410019 ENDIF 07420019 C 07430019 NALLOP = NALLOP + 1 07440019 DALLOP(NALLOP) = ALDSNN 07450019 FALLOP(NALLOP) = FILEN 07460019 ENDIF 07470019 C 07480019 C OPEN THE DATA CARD FILE 07490019 C 07500019 OPEN (INP) 07510019 C 07520019 C SET UP THE MASTER PROCESS TABLE 07530019 C 07540019 CALL FJPTAB (ERR) 07550019 IF (ERR .NE. 0) GO TO 332 07560019 C 07570019 C MUST CHECK FOR R&T USER OR CHECK JCL FOR FOREGROUND FOR DUMMPROC 07580019 C 07590019 IF (DUMMF .EQ. 0) THEN 07600019 FLAG = 0 07610019 20 READ (INP, 9080, END=24) CARD 07620019 CCCCCC LOOK FOR ACCT CARD. IF FOUND THEN NO JCL WILL FOLLOW 07630019 IF (CARD(1:4) .EQ. 'ACCT') THEN 07640019 C IF (CARD(7:11) .NE. '21598') DUMMF = 1 07650019 DO 21 I = 1, NGAPOC 07660019 IF (CARD(7:11) .EQ. GAPORG(I)) GO TO 22 07670019 21 CONTINUE 07680019 DUMMF = 1 07690019 22 CONTINUE 07700019 GO TO 24 07710019 ELSE 07720019 CCCCCCCC WHEN FLAG = 2; EXEC SPARC CARD WAS FOUND (NO MORE SEARCH) 07730019 IF (FLAG .EQ. 2) GO TO 20 07740019 IF (CARD(1:2) .EQ. JCL) THEN 07750019 CCCCCCCCCC LOOK FOR COMMENT CARD 07760019 IF (CARD(3:3) .EQ. '*') GO TO 20 07770019 CCCCCCCCCC WHEN FLAG = 3; EXEC SPARC CARD WAS CONTINUED 07780019 IF (FLAG .NE. 3) THEN 07790019 CCCCCCCCCCCC LOOK FOR EXEC SPARC 07800019 I = INDEX (CARD(3:71), ' EXEC') 07810019 IF (I .EQ. 0) GO TO 20 07820019 I = 3 + I + 4 07830019 J = INDEX (CARD(I:71), ' SPARC') 07840019 IF (J .EQ. 0) GO TO 20 07850019 CCCCCCCCCCCC EXEC SPARC CARD FOUND 07860019 I = I + J + 5 07870019 CCCCCCCCCCCC TEST FOR ADDITIONAL FIELDS ON EXEC SPARC CARD 07880019 IF (CARD(I:I) .NE. ',') THEN 07890019 IF (CARD(72:72) .EQ. ' ') THEN 07900019 CCCCCCCCCCCCCCCC SET FLAG TO TURN OFF SEARCH 07910019 FLAG = 2 07920019 ELSE 07930019 CCCCCCCCCCCCCCCC SET FLAG TO SHOW CONTINUATION FOUND ON CARD 07940019 FLAG = 3 07950019 END IF 07960019 GO TO 20 07970019 ELSE 07980019 IF (CARD(I+1:I+1) .EQ. ' ') THEN 07990019 CCCCCCCCCCCCCCCC SET FLAG TO SHOW CONTINUATION FOUND ON CARD 08000019 FLAG = 3 08010019 GO TO 20 08020019 END IF 08030019 END IF 08040019 CCCCCCCCCCCC SET INDEX'S FOR COLUMNS TO SEARCH ON EXEC SPARC CARD 08050019 I = I + 1 08060019 J = INDEX (CARD(I:72), ' ') 08070019 IF (J .EQ. 0) THEN 08080019 J = 71 08090019 ELSE 08100019 J = I + J - 1 08110019 END IF 08120019 ELSE 08130019 CCCCCCCCCCCC SET INDEX'S FOR COLUMNS TO SEARCH ON A CONTINUATION CARD 08140019 I = 3 08150019 J = 72 08160019 END IF 08170019 C 08180019 CCCCCCCCCC LOOK FOR JGPRAM 08190019 K = INDEX (CARD(I:J), 'JGPARM=') 08200019 IF (K .NE. 0) THEN 08210019 I = I + K + 6 08220019 CCCCCCCCCCCC JGPARM FOUND, NOW LOOK FOR DUMMPROC 08230019 K = INDEX (CARD(I:J), 'DUMMPROC') 08240019 IF (K .NE. 0) DUMMF = 1 08250019 FLAG = 2 08260019 GO TO 20 08270019 ELSE 08280019 CCCCCCCCCCCC LOOK FOR CONTINUATION INDICATION 08290019 K = INDEX (CARD(I:J), ', ') 08300019 IF (K .NE. 0 .OR. CARD(72:72) .NE. ' ') THEN 08310019 FLAG = 3 08320019 ELSE 08330019 FLAG = 2 08340019 END IF 08350019 END IF 08360019 END IF 08370019 GO TO 20 08380019 END IF 08390019 24 REWIND INP 08400019 END IF 08410019 C 08420019 C BUILD THE PROCESSING LIST TABLE 08430019 C 08440019 CALL FJPROC (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, NCARDS, 08450019 * PROCCD, NPROCC, DUMMF, IPR, ERR) 08460019 IF (ERR .GE. 2) GO TO 332 08470019 C 08480019 C CHECK IF 'VELF' PROCESS IS IN PROCESSING LIST TABLE 08490019 C 08500019 DO 25 I = 1, NPROC 08510019 IF (PROCLC(1,I) .EQ. 'VELF') THEN 08520019 VELFG = 1 08530019 NVELID = 0 08540019 NCVEL = 0 08550019 NVELF = 0 08560019 MXVELF = 1 08570019 VELIDL = -9999 08580019 ENDIF 08590019 25 CONTINUE 08600019 C 08610019 C READ DATA CARDS TO FIND THE ULIB CARDS & COUNT GM3D CARDS 08620019 C 08630019 30 READ (INP, 9080, END = 70) CARD 08640019 IF (CARD(:1) .NE. JCL(:1)) GO TO 60 08650019 IF (CARD(1:7) .NE. DLMCRD) GO TO 30 08660019 C 08670019 C IDENTIFY THE DELIMITER ON THIS CARD 08680019 C 08690019 DO 40 I = 6, 75 08700019 IF (CARD(I:I+3) .EQ. DLM) GO TO 50 08710019 C 08720019 40 CONTINUE 08730019 C 08740019 GO TO 30 08750019 C 08760019 50 DLMTR = CARD(I+4:I+5) 08770019 GO TO 30 08780019 C 08790019 C LOOK FOR A DELIMITER CARD OR A PROC CARD 08800019 C 08810019 60 IF (CARD(1:2) .EQ. DLMTR) GO TO 70 08820019 C 08830019 C COUNT THE GM3D CARDS 08840019 C 08850019 IF (CARD(1:4) .EQ. GM3D) NGM3D = NGM3D + 1 08860019 C 08870019 C IF VELF PROCESS IS IN LIST TABLE, COUNT THE VELF CARDS (NVELF), 08880019 C THE # OF VELOCITY ID (NVELID), AND THE MAXIMUM CARDS PER 08890019 C VELOCITY ID (MXVELF). 08900019 C 08910019 IF (VELFG .EQ. 1) THEN 08920019 IF (CARD(1:4) .EQ. VELF) THEN 08930019 VELID = S1CVBN(CARD, 11, 5) 08940019 IF (VELID .NE. VELIDL) THEN 08950019 VELIDL = VELID 08960019 NVELID = NVELID + 1 08970019 MXVELF = MAX0(MXVELF, NCVEL) 08980019 NCVEL = 1 08990019 ENDIF 09000019 NVELF = NVELF + 1 09010019 NCVEL = NCVEL + 1 09020019 ENDIF 09030019 ENDIF 09040019 C 09050019 C JUSTIFY THE LINE CARD 09060019 C 09070019 IF (CARD(1:4) .EQ. LINE) THEN 09080019 LINECD = CARD 09090019 CALL FJJUST (LINECD, '97') 09100019 IF (LINECD(51:55) .EQ. ' ') LINECD(51:55) = LINECD(46:50) 09110019 GO TO 30 09120019 END IF 09130019 C 09140019 C SAVE THE DATASET NAMES ON THE ULIB CARDS 09150019 C 09160019 IF (CARD(1:4) .EQ. ULIB) THEN 09170019 LNKPREP = 1 09180019 LNKPROC = 1 09190019 NULIB = NULIB + 1 09200019 C 09210019 IF (NULIB .LE. MXULIB) THEN 09220019 ULIBDS(NULIB) = CARD(16:80) 09230019 ELSE 09240019 WRITE (IPR, 9090) MXULIB 09250019 END IF 09260019 C 09270019 END IF 09280019 C 09290019 GO TO 30 09300019 C 09310019 C CHECK IF PROCESS IS DEFINED IN CPSPCL 09320019 C 09330019 70 DO 80 I = 1, NPROC 09340019 IF (PTABI(1, PROCLI(IXPTAB, I)) .EQ. 1) LNKPREP = 1 09350019 IF (PROCLC(IXNA, I) .EQ. 'GEOM') GEOMF = 1 09360019 IF (PROCLC(IXNA, I) .EQ. GA3D ) GA3DF = 1 09370019 IF (PROCLC(IXNA, I) .EQ. GM3D ) GM3DF = 1 09380019 IF (PROCLC(IXNA, I) .EQ. 'NINA') NINAF = 1 09390019 IF (PROCLC(IXNA, I) .EQ. 'VF3D') VF3DF = 1 09400019 80 CONTINUE 09410019 C 09420019 C OBTAIN NEEDED VALUES FROM THE LINE CARD 09430019 C 09440019 LCBGSP = S1CVBN (LINECD, 11, 5) 09450019 LCENSP = S1CVBN (LINECD, 16, 5) 09460019 LCNSP = S1CVBN (LINECD, 31, 5) 09470019 LCTPSP = S1CVBN (LINECD, 36, 5) 09480019 LCRL = S1CVBN (LINECD, 41, 5) 09490019 LCSI = S1CVBN (LINECD, 46, 5) 09500019 LCPI = S1CVBN (LINECD, 51, 5) 09510019 LCMXLN = S1CVBN (LINECD, 71, 5) 09520019 IF (LCMXLN .EQ. 0) LCMXLN = 1 09530019 LCDRYF = LINECD(77:80) 09540019 REWIND INP 09550019 C 09560019 C ESTIMATE THE TOTAL NUMBER OF SEISPARM RECORDS IN VELF 09570019 C 09580019 IF (VELFG .EQ. 1) THEN 09590019 VPTS = LCRL / LCPI + 1 09600019 C THE NUMBER OF RVEL RECORDS IN VELF SEISPARM 09610019 NRVEL = ((VPTS / 96)+ 1) * NVELID 09620019 C THE NUMBER OF CRMS RECORDS IN VELF SEISPARM 09630019 NCRMS = ((MXVELF * 12+ 4)/96 + 1) * NVELID 09640019 C THE TOTAL NUMBER RECORDS IN VELF SEISPARM 09650019 TVELF = NRVEL + NCRMS 09660019 ENDIF 09670019 C 09680019 C IF LINK IS REQUIRED AND EXECUTING IN FOREGROUND, ASK USER 09690019 C IF HE REALLY WANTS TO WAIT ON THE LINK. 09700019 C 09710019 IF (JOBID(1:3).EQ.TSO .AND. (LNKPREP.EQ.1 .OR. LNKPROC.EQ.1))THEN 09720019 WRITE (ITR, 9200) 09730019 READ (ITR, 9210) USERA 09740019 IF (USERA .NE. 'Y') THEN 09750019 LNKPREP = 1 09760019 LNKPROC = 1 09770019 WRITE (ITR, 9220) 09780019 GO TO 365 09790019 END IF 09800019 END IF 09810019 C 09820019 C***********************************************************************09830019 C 09840019 C IF LINK IS REQUIRED, BUILD AND COMPILE CPSPCL SUBROUTINE 09850019 C 09860019 C***********************************************************************09870019 C 09880019 C DATASET PARAMETERS FOR THE SOURCE CODE 09890019 C 09900019 IF (LNKPREP .EQ. 1) THEN 09910019 ISSINP(09) = 0 09920019 ISSINP(10) = 3 09930019 ISSINP(11) = 0 09940019 ISSINP(12) = 1 09950019 ISSINP(15) = 0 09960019 ISSINP(16) = 6160 09970019 ISSINP(19) = 0 09980019 ISSINP(20) = 80 09990019 CALL DATIME (DATE, TIME, I) 10000019 C 10010019 C BUILD THE DATA SET NAME 10020019 C 10030019 DO 90 J = 1, 8 10040019 IF (DATE(J:J) .EQ. ' ') DATE(J:J) = '0' 10050019 IF (DATE(J:J) .EQ. '/') DATE(J:J) = '$' 10060019 IF (TIME(J:J) .EQ. ' ') TIME(J:J) = '0' 10070019 IF (TIME(J:J) .EQ. ':') TIME(J:J) = '$' 10080019 IF (JOBNAM(J:J) .EQ. ' ') JOBNAM(J:J) = '0' 10090019 C 10100019 90 CONTINUE 10110019 C 10120019 C ALDSNN(01:06) = JOBNAM(1:6) 10130019 C ALDSNN(07:14) = '.FSSPC.D' 10140019 C ALDSNN(15:21) = DATE(:7) 10150019 C ALDSNN(22:23) = '.T' 10160019 C ALDSNN(24:30) = TIME(:7) 10170019 C ALDSNN(31:31) = '.' 10180019 C ALDSNN(32:39) = JOBNAM(1:8) 10190019 C ALDSNN(40:44) = '.FORT' 10200019 ALDSNN = '&&SYSIN ' 10210019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10220019 C ALLOCATE SYSIN FILE (COMPILER INPUT) FOR THE SOURCE CODE 10230019 C 10240019 CALL DDALOC (11, ASSINK, ASSINP, ALDSNN, ERR, ERRIN) 10250019 C-------------------------------------------------------------------- 10260019 IF (ERR .NE. 0) THEN 10270019 WRITE (6, 9070) ASSINP(1), ERR, ERRIN 10280019 GO TO 332 10290019 END IF 10300019 C 10310019 NALLOC = NALLOC + 1 10320019 DALLOC(NALLOC) = ALDSNN 10330019 FALLOC(NALLOC) = ASSINP(1) 10340019 C 10350019 C BUILD THE CPSPCL SOURCE CODE BASED ON THE PROCESSING LIST 10360019 C 10370019 OPEN (UNIT=SPCLUN, ERR=100, IOSTAT=IOS, FILE='SYSIN') 10380019 GO TO 110 10390019 C 10400019 100 WRITE (IPR, 9100) IOS 10410019 GO TO 332 10420019 C 10430019 110 CALL CPBFSP (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, SPCLUN) 10440019 CLOSE (SPCLUN) 10450019 C 10460019 C ALLOCATE ADDITIONAL FILES FOR THE COMPILER 10470019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10480019 C SYSLIN - OBJECT MODULE 10490019 C 10500019 ISLINP(09) = 0 10510019 ISLINP(10) = 10 10520019 ISLINP(11) = 0 10530019 ISLINP(12) = 5 10540019 ISLINP(15) = 0 10550019 ISLINP(16) = 400 10560019 ISLINP(19) = 0 10570019 ISLINP(20) = 80 10580019 C 10590019 ALDSNN = '&&SYSLIN ' 10600019 CALL DDALOC (11, ASLINK, ASLINP, ALDSNN, ERR, ERRIN) 10610019 C-------------------------------------------------------------------- 10620019 IF (ERR .NE. 0) THEN 10630019 WRITE (6, 9070) ASLINP(1), ERR, ERRIN 10640019 GO TO 332 10650019 END IF 10660019 C 10670019 NALLOC = NALLOC + 1 10680019 DALLOC(NALLOC) = ALDSNN 10690019 FALLOC(NALLOC) = ASLINP(1) 10700019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10710019 C SYSPRINT - ALLOCATE TO MSGCLASS OR DUMMY BASED ON DEBUG FLAG 10720019 C USED FOR FORTRAN COMPILER LISTING 10730019 C 10740019 FILEN = SYSPRNT 10750019 ALDSNN = '&&SYSPRNT ' 10760019 C 10770019 IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#' 10780019 + .OR. LINECD(10:10) .EQ. '*') THEN 10790019 AOUTHP(1) = FILEN 10800019 AOUTHP(2)(1:4)= ' ' 10810019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 10820019 ELSE 10830019 ADUMMP(1) = FILEN 10840019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 10850019 END IF 10860019 C-------------------------------------------------------------------- 10870019 IF (ERR .NE. 0) THEN 10880019 WRITE (6, 9070) FILEN, ERR, ERRIN 10890019 GO TO 332 10900019 END IF 10910019 C 10920019 NALLOP = NALLOP + 1 10930019 DALLOP(NALLOP) = ALDSNN 10940019 FALLOP(NALLOP) = FILEN 10950019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10960019 C SYSTERM - ALLOCATE TO DUMMY 10970019 C DSNAME SHOULD BE BLANK FOR DUMMY ALLOCATION. 10980019 C 10990019 FILEN = SYSTERM 11000019 ALDSNN = BLANKN 11010019 ADUMMP(1) = FILEN 11020019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 11030019 C-------------------------------------------------------------------- 11040019 IF (ERR .NE. 0) THEN 11050019 WRITE (6, 9070) FILEN, ERR, ERRIN 11060019 GO TO 332 11070019 END IF 11080019 C 11090019 NALLOP = NALLOP + 1 11100019 DALLOP(NALLOP) = ALDSNN 11110019 FALLOP(NALLOP) = FILEN 11120019 C 11130019 C COMPILE CPSPCL 11140019 C 11150019 C 11160019 CALL USATT ('FORTVS2 ', ERR, ECB) 11170019 CALL USWAIT (ECB) 11180019 CALL USDET (ECB) 11190019 C 11200019 IF (ERR .NE. 0 .OR. ECB(1) .NE. NOERRZ) THEN 11210019 WRITE (6, 9110) ERR, ECB(1) 11220019 GO TO 332 11230019 END IF 11240019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 11250019 C ALLOCATE FILES FOR THE LOADER 11260019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 11270019 C SYSLOUT - ALLOCATE TO MSGCLASS FOR LOAD MAP 11280019 C 11290019 FILEN = MAPDDN 11300019 AOUTHP(1) = FILEN 11310019 AOUTHP(2)(1:4)= ' ' 11320019 ALDSNN = '&&SYSLOUT ' 11330019 CALL DDALOC (2, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 11340019 C-------------------------------------------------------------------- 11350019 IF (ERR .NE. 0) THEN 11360019 WRITE (IPR, 9070) FILEN, ERR, ERRIN 11370019 GO TO 332 11380019 END IF 11390019 C 11400019 NALLOP = NALLOP + 1 11410019 DALLOP(NALLOP) = ALDSNN 11420019 FALLOP(NALLOP) = FILEN 11430019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 11440019 C SYSLIB - USER-SUPPLIED LIBRARIES 11450019 C 11460019 IF (NULIB .GT. 0) THEN 11470019 DO 120 I = 1, NULIB 11480019 ALDSNN = ULIBDS(I)(:44) 11490019 C 11500019 IF (I .EQ. 1) THEN 11510019 ASLIBP(1) = CSLIBP 11520019 ELSE 11530019 ASLIBP(1)(:4) = ULIB 11540019 CALL S1BNCV (I, ASLIBP(1), 5, 2) 11550019 END IF 11560019 C 11570019 C CHECK CATALOG FOR DSN BEFORE ALLOCATION IS DONE 11580019 C 11590019 CALL USCATC (ALDSNN, ERR) 11600019 IF (ERR .EQ. 0) THEN 11610019 WRITE (6, 9190) ALDSNN 11620019 GO TO 332 11630019 END IF 11640019 C 11650019 CALL DDALOC (2, ASLIBK, ASLIBP, ALDSNN, ERR, ERRIN) 11660019 C-------------------------------------------------------------------- 11670019 IF (ERR .NE. 0) THEN 11680019 WRITE (IPR, 9070) ASLIBP(1), ERR, ERRIN 11690019 GO TO 332 11700019 END IF 11710019 C 11720019 NSYSLB = NSYSLB + 1 11730019 DDNCC(NSYSLB) = ASLIBP(1) 11740019 C 11750019 120 CONTINUE 11760019 C 11770019 END IF 11780019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 11790019 C SYSLIB - STANDARD SPARC LIBRARIES 11800019 C 11810019 DO 130 I = 1, NLLINK 11820019 ALDSNN = LINKLB(I) 11830019 C 11840019 IF (NULIB .EQ. 0 .AND. I .EQ. 1) THEN 11850019 ASLIBP(1) = CSLIBP 11860019 ELSE 11870019 ASLIBP(1)(:4) = LINE 11880019 CALL S1BNCV (I, ASLIBP(1), 5, 2) 11890019 END IF 11900019 C 11910019 CALL DDALOC (2, ASLIBK, ASLIBP, ALDSNN, ERR, ERRIN) 11920019 C-------------------------------------------------------------------- 11930019 IF (ERR .NE. 0) THEN 11940019 WRITE (IPR, 9070) ASLIBP(1), ERR, ERRIN 11950019 GO TO 332 11960019 END IF 11970019 C 11980019 NSYSLB = NSYSLB + 1 11990019 DDNCC(NSYSLB) = ASLIBP(1) 12000019 C 12010019 130 CONTINUE 12020019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 12030019 C DYNAMIC CONCATENATION OF THE SYSLIB LIBRARY DATASETS 12040019 C 12050019 CALL USDCC (NULIB+NLLINK, DDNCC, ERR, ERRIN) 12060019 C 12070019 IF (ERR .NE. 1) THEN 12080019 WRITE (IPR, 9120) ERR, ERRIN 12090019 GO TO 332 12100019 END IF 12110019 C 12120019 C FLAG A SUCCESSFUL CONCATENATION 12130019 C 12140019 NSYSLB = -NSYSLB 12150019 END IF 12160019 C 12170019 C***********************************************************************12180019 C 12190019 C BUILD AND COMPILE OF CPSPCL SUBROUTINE COMPLETED 12200019 C ALLOCATE FILES FOR THE EXECUTION OF THE PREP STEP 12210019 C 12220019 C***********************************************************************12230019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 12240019 C ALLOCATE THE SEISPARM FILE 12250019 C 12260019 SEISF = 1 12270019 ISEISP(7) = 0 12280019 ISEISP(8) = 9984 12290019 ISEISP(9) = 0 12300019 IF (VELFG .NE. 1) THEN 12310019 ISEISP(10) = ( NCARDS + ((NCARDS - NGM3D) * LCTPSP) + 12320019 * NPROC + 3500 ) / 24 12330019 ELSE 12340019 ISEISP(10) = ( NCARDS + ((NCARDS - NGM3D - NVELF) * LCTPSP)+ 12350019 * TVELF + NPROC + 3500 ) / 24 12360019 ENDIF 12370019 IF (ISEISP(10) .GT. 50000) ISEISP(10) = 50000 12380019 ISEISP(11) = 0 12390019 ISEISP(12) = 1 12400019 CALL DDALOC (8, ASEISK, ASEISP, ASEISN, ERR, ERRIN) 12410019 C-------------------------------------------------------------------- 12420019 IF (ERR .NE. 0) THEN 12430019 WRITE (IPR, 9070) ASEISP(1), ERR, ERRIN 12440019 GO TO 332 12450019 END IF 12460019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 12470019 C ALLOCATE THE GM3DPARM FILE 12480019 C 12490019 IF (GM3DF .EQ. 1 .OR. NINAF .EQ. 1) THEN 12500019 LRECL = 23296 12510019 NREC = LCNSP * LCTPSP / 91 + 1 + 2 12520019 TOTAL = (1.0*NREC) * LRECL 12530019 IF (TOTAL .LE. 256000000.0) THEN 12540019 CALL USNVIO (NREC, LRECL, GM3DSA, GM3DDA, ERR, ERRIN, 12550019 * GM3DDD, D1, D2, D3, D4, D5) 12560019 ELSE 12570019 CALL USNWRK (NREC, LRECL, GM3DSA, GM3DDA, ERR, ERRIN, 12580019 * GM3DDD, D1, D2, D3, D4, D5) 12590019 ENDIF 12600019 C-------------------------------------------------------------------- 12610019 IF (ERR .NE. 1) THEN 12620019 WRITE (IPR, 9070) GM3DDD, ERR, ERRIN 12630019 GO TO 332 12640019 END IF 12650019 END IF 12660019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 12670019 C ALLOCATE THE HISTPARM FILE 12680019 C 12690019 IF (GEOMF .EQ. 1 .OR. NINAF .EQ. 1) THEN 12700019 IHISTP(7) = 0 12710019 IHISTP(8) = 3200 12720019 IHISTP(9) = 0 12730019 IHISTP(10) = 1000 12740019 IHISTP(11) = 0 12750019 IHISTP(12) = 1 12760019 CALL DDALOC (8, AHISTK, AHISTP, AHISTN, ERR, ERRIN) 12770019 C-------------------------------------------------------------------- 12780019 IF (ERR .NE. 0) THEN 12790019 WRITE (IPR, 9070) AHISTP(1), ERR, ERRIN 12800019 GO TO 332 12810019 END IF 12820019 END IF 12830019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 12840019 C ALLOCATE THE VF3DPARM FILE 12850019 C 12860019 IF (VF3DF .EQ. 1) THEN 12870019 LRECL = 9984 12880019 C 12890019 IF (LINECD(7:7) .EQ. 'D') THEN 12900019 NREC = ((((LCENSP - LCBGSP + 1 + 47) / 48) * LCMXLN + 12910019 * (LCMXLN + 47) / 48 * (LCENSP - LCBGSP + 1)) * 20)12920019 * / 24 * 2 12930019 ELSE 12940019 NREC =(((LCNSP + LCTPSP) * LCMXLN * 80) / 96) / 24 * 2 12950019 END IF 12960019 NREC = NREC + 5 12970019 C 12980019 TOTAL = (1.0*NREC) * LRECL 12990019 IF (TOTAL .LE. 256000000.0) THEN 13000019 CALL USNVIO (NREC, LRECL, VF3DSA, VF3DDA, ERR, ERRIN, 13010019 * VF3DDD, D1, D2, D3, D4, D5) 13020019 ELSE 13030019 CALL USNWRK (NREC, LRECL, VF3DSA, VF3DDA, ERR, ERRIN, 13040019 * VF3DDD, D1, D2, D3, D4, D5) 13050019 ENDIF 13060019 IF (ERR .NE. 1) THEN 13070019 WRITE (IPR, 9070) VF3DDD, ERR, ERRIN 13080019 GO TO 332 13090019 END IF 13100019 END IF 13110019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 13120019 C ALLOCATE THE UNIRAS FILES 13130019 C 13140019 UNIRF = 1 13150019 DO 140 I = 1, NUNID 13160019 AISHRP(1) = FILUNI(I) 13170019 ALDSNN = DSNUNI(I) 13180019 CALL DDALOC (4, AISHRK, AISHRP, ALDSNN, ERR, ERRIN) 13190019 C-------------------------------------------------------------------- 13200019 IF (ERR .NE. 0) THEN 13210019 WRITE (IPR, 9070) FILUNI(I), ERR, ERRIN 13220019 GO TO 332 13230019 END IF 13240019 140 CONTINUE 13250019 C 13260019 IUNIP(09) = 0 13270019 IUNIP(10) = 120 13280019 CALL DDALOC (8, AUNIK, AUNIP, AUNIN, ERR, ERRIN) 13290019 C-------------------------------------------------------------------- 13300019 IF (ERR .NE. 0) THEN 13310019 WRITE (IPR, 9070) AUNIP(1), ERR, ERRIN 13320019 GO TO 332 13330019 END IF 13340019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 13350019 C ALLOCATE FT05F001 13360019 C 13370019 FT05F = 1 13380019 IFT05P(07) = 0 13390019 IFT05P(08) = 80 13400019 IFT05P(09) = 0 13410019 IFT05P(10) = NCARDS 13420019 CALL DDALOC (7, AFT05K, AFT05P, AFT05N, ERR, ERRIN) 13430019 C-------------------------------------------------------------------- 13440019 IF (ERR .NE. 0) THEN 13450019 WRITE (IPR, 9070) AFT05P(1), ERR, ERRIN 13460019 GO TO 332 13470019 END IF 13480019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 13490019 C ALLOCATE THE SPARCSID FILE 13500019 C 13510019 ASHRP(1) = FILSHR(1) 13520019 ALDSNN = DSNSHR(1) 13530019 CALL DDALOC (2, ASHRK, ASHRP, ALDSNN, ERR, ERRIN) 13540019 C-------------------------------------------------------------------- 13550019 IF (ERR .NE. 0) THEN 13560019 WRITE (IPR, 9070) ASHRP(1), ERR, ERRIN 13570019 GO TO 332 13580019 END IF 13590019 C 13600019 NALLOC = NALLOC + 1 13610019 DALLOC(NALLOC) = ALDSNN 13620019 FALLOC(NALLOC) = ASHRP(1) 13630019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 13640019 C ALLOCATE FILE DYNALCDS 13650019 C 13660019 IDYNAP(09) = 0 13670019 IDYNAP(10) = 1 13680019 IDYNAP(11) = 0 13690019 IDYNAP(12) = 1 13700019 C 13710019 ALDSNN = '&&DYNALCDS ' 13720019 CALL DDALOC (8, ADYNAK, ADYNAP, ALDSNN, ERR, ERRIN) 13730019 C-------------------------------------------------------------------- 13740019 IF (ERR .NE. 0) THEN 13750019 WRITE (IPR, 9070) ADYNAP(1), ERR, ERRIN 13760019 GO TO 332 13770019 END IF 13780019 C 13790019 NALLOC = NALLOC + 1 13800019 DALLOC(NALLOC) = ALDSNN 13810019 FALLOC(NALLOC) = ADYNAP(1) 13820019 C 13830019 C VALIDATE THE PROCESSING PARAMETERS AND BUILD THE PARAMETER 13840019 C RECORDS (SPARC PREP STEP) 13850019 C 13860019 IF (LNKPREP .EQ. 0) THEN 13870019 CALL USATT ('CPPREP ', ERR, ECB) 13880019 CALL USWAIT (ECB) 13890019 CALL USDET (ECB) 13900019 C 13910019 IF (ERR .NE. 0 .OR. ECB(1) .NE. NOERRZ) THEN 13920019 WRITE (IPR, 9130) ERR, ECB(1) 13930019 GO TO 332 13940019 END IF 13950019 C 13960019 ELSE 13970019 IF (JOBID(1:3) .EQ. TSO) WRITE (ITR, 9140) 13980019 CDEBUG******************************************************* 13990019 CCCCCC CALL USWTSO('DBGREP ','ISPARC- CALL CPPREP ', 20, ERR) 14000019 CDEBUG******************************************************* 14010019 CALL USLOAD (LDRSIZ, EXTEND, 'CPPREP ', MAPDDN, ERR) 14020019 C 14030019 IF (ERR .NE. 0) THEN 14040019 WRITE (IPR, 9145) ERR 14050019 GO TO 332 14060019 END IF 14070019 C 14080019 END IF 14090019 C 14100019 C FREE FILES USED FOR LOADER 14110019 C 14120019 IF (LNKPREP .EQ. 1) THEN 14130019 C 14140019 C DECONCATENATE SYSLIB FILES 14150019 C 14160019 CALL USDDCC (CSLIBP, ERR, ERRIN) 14170019 IF (ERR .NE. 1) WRITE (IPR, 9150) ERR, ERRIN 14180019 C 14190019 C FREE SYSLIB USER-SUPPLIED LIBRARIES 14200019 C 14210019 COUNT = 0 14220019 C 14230019 IF (NULIB .GT. 0) THEN 14240019 C 14250019 DO 150 I = 1, NULIB 14260019 COUNT = COUNT + 1 14270019 ALDSNN = ULIBDS(I)(:44) 14280019 CALL DDFREE (1, 1, DDNCC(COUNT), ALDSNN, ERR, ERRIN) 14290019 IF (ERR .NE. 0) WRITE (IPR, 9160) DDNCC(COUNT), ERR, ERRIN 14300019 C 14310019 150 CONTINUE 14320019 C 14330019 END IF 14340019 C 14350019 C FREE SYSLIB STANDARD SPARC LIBRARIES 14360019 C 14370019 DO 160 I = 1, NLLINK 14380019 COUNT = COUNT + 1 14390019 ALDSNN = LINKLB(I) 14400019 CALL DDFREE (1, 1, DDNCC(COUNT), ALDSNN, ERR, ERRIN) 14410019 IF (ERR .NE. 0) WRITE (IPR, 9160) DDNCC(COUNT), ERR, ERRIN 14420019 C 14430019 160 CONTINUE 14440019 C 14450019 NSYSLB = 0 14460019 END IF 14470019 CREP 14480019 CREP FREE ALLOCATED PRINT FILES IF FOREGROUND 14490019 CREP--DON'T FREE UNTIL AFTER PROC CODE------------------------------- 14500019 CREP 14510019 CREP IF (JOBID(1:3) .EQ. TSO) THEN 14520019 CREP IF (NALLOP .GT. 0) THEN 14530019 CREP N = NALLOP 14540019 CREP NALLOP = 0 14550019 CREP DO 170 I = 1, N 14560019 CDEBUG--REP---------------------------------------------------------- 14570019 CDEBUG--REP---------------------------------------------------------- 14580019 CREP IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#') 14590019 CREP + WRITE(6,9300) I, FALLOP(I), DALLOP(I) 14600019 CDEBUG--REP---------------------------------------------------------- 14610019 CDEBUG--REP---------------------------------------------------------- 14620019 CREP UNALP(1) = FALLOP(I) 14630019 CREP CALL DDFREE (2, UNALK, UNALP, DALLOP(I), ERR, ERRIN) 14640019 CREP IF (ERR .NE. 0) WRITE (IPR, 9160) FALLOP(I), ERR, ERRIN 14650019 CREP DALLOP(I) = BLANKN 14660019 CREP FALLOP(I) = BLANKN(1:8) 14670019 CR170 CONTINUE 14680019 CREP END IF 14690019 CREP END IF 14700019 C 14710019 C FREE REST OF ALLOCATED FILES 14720019 C 14730019 IF (NALLOC .GT. 0) THEN 14740019 DO 175 I = 1, NALLOC 14750019 CDEBUG--REP---------------------------------------------------------- 14760019 IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#') 14770019 + WRITE(6,9300) I, FALLOC(I), DALLOC(I) 14780019 CDEBUG--REP---------------------------------------------------------- 14790019 UNALP(1) = FALLOC(I) 14800019 CALL DDFREE (2, UNALK, UNALP, DALLOC(I), ERR, ERRIN) 14810019 IF (ERR .NE. 0) WRITE (IPR, 9160) FALLOC(I), ERR, ERRIN 14820019 DALLOC(I) = BLANKN 14830019 FALLOC(I) = BLANKN(1:8) 14840019 175 CONTINUE 14850019 NALLOC = 0 14860019 END IF 14870019 C 14880019 C EXIT FOR FOREGROUND EXECUTION (DON'T DO PROC IF FOREGROUND) 14890019 C 14900019 IF (JOBID(1:3) .EQ. TSO) THEN 14910019 WRITE (ITR, 9170) 14920019 GO TO 330 14930019 END IF 14940019 C 14950019 C EXIT FOR A PREP ONLY JOB 14960019 C 14970019 IF (LCDRYF .EQ. 'PREP') GO TO 330 14980019 C 14990019 C***********************************************************************15000019 C 15010019 C SPARC PROCESSING STEP SECTION 15020019 C 15030019 C***********************************************************************15040019 C 15050019 IPR = IPROC 15060019 NOERR = 0 15070019 C 15080019 C DETERMINE IF LINK-EDITING IS NEEDED FOR THE PROC STEP AND ASSIGN 15090019 C PRINT UNIT NUMBERS FOR EACH PROCESS 15100019 C 15110019 C CHECK EACH PROCESS IN THE PROCESSING LIST FOR THE EXISTENCE OF 15120019 C A PROCESSING MODULE IN THE FULLY LINKED LOAD MODULE 15130019 C 15140019 PRUNIT = 7 15150019 DO 190 I = 1, NPROC 15160019 PROCN = PROCLC(IXNA, I) 15170019 IPTAB = PROCLI(IXPTAB, I) 15180019 PROCLI(IXPRNT, I) = 0 15190019 CDEBUG---REP----------- 15200019 C WRITE(6,99997) PROCN,I,IPTAB,PTABI(2,IPTAB),PRUNIT 15210019 C9997 FORMAT(' ISPARC - ',A4,4I6) 15220019 CDEBUG---REP----------- 15230019 C 15240019 IF (PTABI(2, IPTAB) .EQ. 0) GO TO 190 15250019 IF (PTABI(2, IPTAB) .EQ. 1) LNKPROC = 1 15260019 C 15270019 IF (PROCN .EQ. 'BRAN' .OR. 15280019 * PROCN .EQ. 'NODE' .OR. 15290019 * PROCN .EQ. 'PEND' ) GO TO 190 15300019 PRUNIT = PRUNIT + 1 15310019 PROCLI(IXPRNT, I) = PRUNIT 15320019 C 15330019 190 CONTINUE 15340019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15350019 C FOR FOREGROUND JOBS, ALLOCATE PRINT FILES ACCORDING TO THE USER'S 15360019 C CHOICE 15370019 C 15380019 IF (JOBID(1:3) .EQ. TSO) THEN 15390019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15400019 C ALLOCATE PRINT FILES TO THE PRINTER 15410019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15420019 IF (PRINT .EQ. 1) THEN 15430019 AOUTPP(1) = 'FTXXF001' 15440019 AOUTPP(4)(1:4)= DEST 15450019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15460019 DO 200 I = 1, NPROC 15470019 PRUNIT = PROCLI(IXPRNT, I) 15480019 IF (PRUNIT .NE. 0) THEN 15490019 CALL S1BNCV (PRUNIT, AOUTPP(1), 3, 2) 15500019 ALDSNN = '&&' // AOUTPP(1) 15510019 CALL DDALOC (4, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 15520019 C-------------------------------------------------------------------- 15530019 IF (ERR .NE. 0) THEN 15540019 FILEN = AOUTPP(1) 15550019 GO TO 250 15560019 END IF 15570019 C 15580019 NALLOP = NALLOP + 1 15590019 DALLOP(NALLOP) = ALDSNN 15600019 FALLOP(NALLOP) = AOUTPP(1) 15610019 END IF 15620019 200 CONTINUE 15630019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15640019 CALL S1BNCV (IPR, AOUTPP(1), 3, 2) 15650019 ALDSNN = '&&' // AOUTPP(1) 15660019 CALL DDALOC (4, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 15670019 C-------------------------------------------------------------------- 15680019 IF (ERR .NE. 0) THEN 15690019 FILEN = AOUTPP(1) 15700019 GO TO 250 15710019 END IF 15720019 C 15730019 NALLOP = NALLOP + 1 15740019 DALLOP(NALLOP) = ALDSNN 15750019 FALLOP(NALLOP) = AOUTPP(1) 15760019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15770019 AOUTPP(1) = UNIPRT 15780019 ALDSNN = '&&' // AOUTPP(1) 15790019 CALL DDALOC (4, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 15800019 C-------------------------------------------------------------------- 15810019 IF (ERR .NE. 0) THEN 15820019 FILEN = AOUTPP(1) 15830019 GO TO 250 15840019 END IF 15850019 C 15860019 NALLOP = NALLOP + 1 15870019 DALLOP(NALLOP) = ALDSNN 15880019 FALLOP(NALLOP) = AOUTPP(1) 15890019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15900019 C ALLOCATE PRINT FILES TO THE HOLD QUEUE 15910019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15920019 ELSE IF (PRINT .EQ. 2) THEN 15930019 AOUTHP(1) = 'FTXXF001' 15940019 AOUTHP(4)(:4) = DEST 15950019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 15960019 DO 210 I = 1, NPROC 15970019 PRUNIT = PROCLI(IXPRNT, I) 15980019 C 15990019 IF (PRUNIT .NE. 0) THEN 16000019 CALL S1BNCV (PRUNIT, AOUTHP(1), 3, 2) 16010019 ALDSNN = '&&' // AOUTHP(1) 16020019 CALL DDALOC (5, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 16030019 C-------------------------------------------------------------------- 16040019 IF (ERR .NE. 0) THEN 16050019 FILEN = AOUTHP(1) 16060019 GO TO 250 16070019 END IF 16080019 C 16090019 NALLOP = NALLOP + 1 16100019 DALLOP(NALLOP) = ALDSNN 16110019 FALLOP(NALLOP) = AOUTHP(1) 16120019 END IF 16130019 210 CONTINUE 16140019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16150019 CALL S1BNCV (IPR, AOUTHP(1), 3, 2) 16160019 ALDSNN = '&&' // AOUTHP(1) 16170019 CALL DDALOC (5, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 16180019 C-------------------------------------------------------------------- 16190019 IF (ERR .NE. 0) THEN 16200019 FILEN = AOUTHP(1) 16210019 GO TO 250 16220019 END IF 16230019 C 16240019 NALLOP = NALLOP + 1 16250019 DALLOP(NALLOP) = ALDSNN 16260019 FALLOP(NALLOP) = AOUTHP(1) 16270019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16280019 AOUTHP(1) = UNIPRT 16290019 ALDSNN = '&&' // AOUTHP(1) 16300019 CALL DDALOC (5, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 16310019 C-------------------------------------------------------------------- 16320019 IF (ERR .NE. 0) THEN 16330019 FILEN = AOUTHP(1) 16340019 GO TO 250 16350019 END IF 16360019 C 16370019 NALLOP = NALLOP + 1 16380019 DALLOP(NALLOP) = ALDSNN 16390019 FALLOP(NALLOP) = AOUTHP(1) 16400019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16410019 C ALLOCATE PRINT FILES TO THE TERMINAL 16420019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16430019 ELSE IF (PRINT .EQ. 3) THEN 16440019 ATERMP(1) = 'FTXXF001' 16450019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16460019 DO 220 I = 1, NPROC 16470019 PRUNIT = PROCLI(IXPRNT, I) 16480019 C 16490019 IF (PRUNIT .NE. 0) THEN 16500019 CALL S1BNCV (PRUNIT, ATERMP(1), 3, 2) 16510019 ALDSNN = '&&' // ATERMP(1) 16520019 CALL DDALOC (3, ATERMK, ATERMP, ALDSNN, ERR, ERRIN) 16530019 C-------------------------------------------------------------------- 16540019 IF (ERR .NE. 0) THEN 16550019 FILEN = ATERMP(1) 16560019 GO TO 250 16570019 END IF 16580019 C 16590019 NALLOP = NALLOP + 1 16600019 DALLOP(NALLOP) = ALDSNN 16610019 FALLOP(NALLOP) = ATERMP(1) 16620019 END IF 16630019 220 CONTINUE 16640019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16650019 CALL S1BNCV (IPR, ATERMP(1), 3, 2) 16660019 ALDSNN = '&&' // ATERMP(1) 16670019 CALL DDALOC (3, ATERMK, ATERMP, ALDSNN, ERR, ERRIN) 16680019 C-------------------------------------------------------------------- 16690019 IF (ERR .NE. 0) THEN 16700019 FILEN = ATERMP(1) 16710019 GO TO 250 16720019 END IF 16730019 C 16740019 NALLOP = NALLOP + 1 16750019 DALLOP(NALLOP) = ALDSNN 16760019 FALLOP(NALLOP) = ATERMP(1) 16770019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16780019 ATERMP(1) = UNIPRT 16790019 ALDSNN = '&&' // ATERMP(1) 16800019 CALL DDALOC (3, ATERMK, ATERMP, ALDSNN, ERR, ERRIN) 16810019 C-------------------------------------------------------------------- 16820019 IF (ERR .NE. 0) THEN 16830019 FILEN = ATERMP(1) 16840019 GO TO 250 16850019 END IF 16860019 C 16870019 NALLOP = NALLOP + 1 16880019 DALLOP(NALLOP) = ALDSNN 16890019 FALLOP(NALLOP) = ATERMP(1) 16900019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16910019 C ALLOCATE PRINT FILES TO DUMMY 16920019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16930019 ELSE IF (PRINT .EQ. 4) THEN 16940019 ADUMMP(1) = 'FTXXF001' 16950019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 16960019 DO 230 I = 1, NPROC 16970019 PRUNIT = PROCLI(IXPRNT, I) 16980019 C 16990019 IF (PRUNIT .NE. 0) THEN 17000019 CALL S1BNCV (PRUNIT, ADUMMP(1), 3, 2) 17010019 ALDSNN = '&&' // ADUMMP(1) 17020019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 17030019 C-------------------------------------------------------------------- 17040019 IF (ERR .NE. 0) THEN 17050019 FILEN = ADUMMP(1) 17060019 GO TO 250 17070019 END IF 17080019 C 17090019 NALLOP = NALLOP + 1 17100019 DALLOP(NALLOP) = ALDSNN 17110019 FALLOP(NALLOP) = ADUMMP(1) 17120019 END IF 17130019 230 CONTINUE 17140019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17150019 CALL S1BNCV (IPR, ADUMMP(1), 3, 2) 17160019 ALDSNN = '&&' // ADUMMP(1) 17170019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 17180019 C-------------------------------------------------------------------- 17190019 IF (ERR .NE. 0) THEN 17200019 FILEN = ADUMMP(1) 17210019 GO TO 250 17220019 END IF 17230019 C 17240019 NALLOP = NALLOP + 1 17250019 DALLOP(NALLOP) = ALDSNN 17260019 FALLOP(NALLOP) = AOUTHP(1) 17270019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17280019 ADUMMP(1) = UNIPRT 17290019 ALDSNN = '&&' // ADUMMP(1) 17300019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 17310019 C-------------------------------------------------------------------- 17320019 IF (ERR .NE. 0) THEN 17330019 FILEN = ADUMMP(1) 17340019 GO TO 250 17350019 END IF 17360019 C 17370019 NALLOP = NALLOP + 1 17380019 DALLOP(NALLOP) = ALDSNN 17390019 FALLOP(NALLOP) = ADUMMP(1) 17400019 END IF 17410019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17420019 C FOR BACKGROUND JOBS, ALLOCATE PRINT FILES TO MSGCLASS 17430019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17440019 ELSE 17450019 AOUTHP(1) = 'FTXXF001' 17460019 AOUTHP(4)(:4) = DFDEST 17470019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17480019 DO 240 I = 1, NPROC 17490019 PRUNIT = PROCLI(IXPRNT, I) 17500019 CDEBUG---REP----------- 17510019 C WRITE(6,99990) PROCLC(IXNA,I), I, PRUNIT 17520019 C9990 FORMAT(' ISPARC - ',A4,2I6) 17530019 CDEBUG---REP----------- 17540019 C 17550019 IF (PRUNIT .NE. 0) THEN 17560019 CESN CALL S1BNCV (PRUNIT, AOUTHP(1), 3, 2) 17570019 AOUTHP(1) = ' ' 17580019 AOUTHP(1) = PROCLC(IXNA,I) 17590019 CALL S1BNCV (PROCLI(IXRNO,I), AOUTHP(1), 5, 1) 17600019 IF (PROCLI(IXOCUR,I) .LE. 9) THEN 17610019 CALL S1MVCH ('0', 1, AOUTHP(1), 6, 1) 17620019 CALL S1BNCV (PROCLI(IXOCUR,I), AOUTHP(1), 7, 1) 17630019 ELSE 17640019 CALL S1BNCV (PROCLI(IXOCUR,I), AOUTHP(1), 6, 2) 17650019 ENDIF 17660019 ALDSNN = '&&' // AOUTHP(1) 17670019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 17680019 C-------------------------------------------------------------------- 17690019 IF (ERR .NE. 0) THEN 17700019 FILEN = AOUTHP(1) 17710019 GO TO 250 17720019 END IF 17730019 C 17740019 NALLOP = NALLOP + 1 17750019 DALLOP(NALLOP) = ALDSNN 17760019 FALLOP(NALLOP) = AOUTHP(1) 17770019 END IF 17780019 240 CONTINUE 17790019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17800019 AOUTHP(1) = 'FTXXF001' 17810019 CALL S1BNCV (IPR, AOUTHP(1), 3, 2) 17820019 ALDSNN = '&&' // AOUTHP(1) 17830019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 17840019 C-------------------------------------------------------------------- 17850019 IF (ERR .NE. 0) THEN 17860019 FILEN = AOUTHP(1) 17870019 GO TO 250 17880019 END IF 17890019 C 17900019 NALLOP = NALLOP + 1 17910019 DALLOP(NALLOP) = ALDSNN 17920019 FALLOP(NALLOP) = AOUTHP(1) 17930019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17940019 AOUTHP(1) = UNIPRT 17950019 ALDSNN = '&&' // AOUTHP(1) 17960019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 17970019 C-------------------------------------------------------------------- 17980019 IF (ERR .NE. 0) THEN 17990019 FILEN = AOUTHP(1) 18000019 GO TO 250 18010019 END IF 18020019 END IF 18030019 C 18040019 NALLOP = NALLOP + 1 18050019 DALLOP(NALLOP) = ALDSNN 18060019 FALLOP(NALLOP) = AOUTHP(1) 18070019 C 18080019 C-------------------------------------------------------------------- 18090019 250 CONTINUE 18100019 IF (ERR .NE. 0) THEN 18110019 WRITE (6, 9070) FILEN, ERR, ERRIN, ALDSNN 18120019 WRITE (IPREP, 9070) FILEN, ERR, ERRIN 18130019 GO TO 332 18140019 END IF 18150019 C 18160019 C***********************************************************************18170019 C 18180019 C BUILD AND COMPILE CSSDAD SUBROUTINE 18190019 C 18200019 C***********************************************************************18210019 C 18220019 C DATASET PARAMETERS FOR THE SOURCE CODE 18230019 C 18240019 IF (LNKPROC .EQ. 1) THEN 18250019 ISSINP(09) = 0 18260019 ISSINP(10) = 3 18270019 ISSINP(11) = 0 18280019 ISSINP(12) = 1 18290019 ISSINP(15) = 0 18300019 ISSINP(16) = 6160 18310019 ISSINP(19) = 0 18320019 ISSINP(20) = 80 18330019 CALL DATIME (DATE, TIME, I) 18340019 C 18350019 C BUILD THE DATA SET NAME 18360019 C 18370019 DO 260 J = 1, 8 18380019 IF (DATE(J:J) .EQ. ' ') DATE(J:J) = '0' 18390019 IF (DATE(J:J) .EQ. '/') DATE(J:J) = '$' 18400019 IF (TIME(J:J) .EQ. ' ') TIME(J:J) = '0' 18410019 IF (TIME(J:J) .EQ. ':') TIME(J:J) = '$' 18420019 IF ( JOBNAM(J:J) .EQ. ' ') JOBNAM(J:J) = '0' 18430019 C 18440019 260 CONTINUE 18450019 C 18460019 C ALDSNN(01:06) = JOBNAM(1:6) 18470019 C ALDSNN(07:14) = '.FSSDC.D' 18480019 C ALDSNN(15:21) = DATE(:7) 18490019 C ALDSNN(22:23) = '.T' 18500019 C ALDSNN(24:30) = TIME(:7) 18510019 C ALDSNN(31:31) = '.' 18520019 C ALDSNN(32:39) = JOBNAM(1:8) 18530019 C ALDSNN(40:44) = '.FORT' 18540019 ALDSNN = '&&SYSIN ' 18550019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 18560019 C ALLOCATE SYSIN FILE (COMPILER INPUT) FOR THE SOURCE CODE 18570019 C 18580019 CALL DDALOC (11, ASSINK, ASSINP, ALDSNN, ERR, ERRIN) 18590019 C-------------------------------------------------------------------- 18600019 IF (ERR .NE. 0) THEN 18610019 WRITE (IPR, 9070) ASSINP(1), ERR, ERRIN 18620019 GO TO 332 18630019 END IF 18640019 C 18650019 NALLOC = NALLOC + 1 18660019 DALLOC(NALLOC) = ALDSNN 18670019 FALLOC(NALLOC) = ASSINP(1) 18680019 C 18690019 C BUILD THE CSSDAD SOURCE CODE BASED ON THE PROCESSING LIST 18700019 C 18710019 OPEN (UNIT=SPCLUN, ERR=270, IOSTAT=IOS, FILE='SYSIN') 18720019 GO TO 280 18730019 C 18740019 270 WRITE (IPR, 9100) IOS 18750019 GO TO 332 18760019 C 18770019 280 CALL CSBFSD (PROCLC, PROCLI, PRCNDX, MXPROC, NPROC, SPCLUN) 18780019 CLOSE (SPCLUN) 18790019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 18800019 C ALLOCATE ADDITIONAL FILES FOR THE COMPILER 18810019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 18820019 C SYSLIN - OBJECT MODULE 18830019 C 18840019 ISLINP(09) = 0 18850019 ISLINP(10) = 10 18860019 ISLINP(11) = 0 18870019 ISLINP(12) = 5 18880019 ISLINP(15) = 0 18890019 ISLINP(16) = 400 18900019 ISLINP(19) = 0 18910019 ISLINP(20) = 80 18920019 C 18930019 ALDSNN = '&&SYSLIN ' 18940019 CALL DDALOC (11, ASLINK, ASLINP, ALDSNN, ERR, ERRIN) 18950019 C-------------------------------------------------------------------- 18960019 IF (ERR .NE. 0) THEN 18970019 WRITE (IPR, 9070) ASLINP(1), ERR, ERRIN 18980019 GO TO 332 18990019 END IF 19000019 C 19010019 NALLOC = NALLOC + 1 19020019 DALLOC(NALLOC) = ALDSNN 19030019 FALLOC(NALLOC) = ASLINP(1) 19040019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 19050019 C SYSPRINT - PRINTER DIAGNOSTIC FILE TO DUMMY OR MSGCLASS 19060019 C DEPENDING ON DEBUG. ALSO IF PREP HAD A LINK THEN 19070019 C FILE IS ALREADY ALLOCATED. 19080019 C 19090019 IF (LNKPREP .EQ. 0) THEN 19100019 FILEN = SYSPRNT 19110019 ALDSNN = '&&SYSPRNT ' 19120019 C 19130019 IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#' 19140019 + .OR. LINECD(10:10) .EQ. '*') THEN 19150019 AOUTHP(1) = FILEN 19160019 AOUTHP(2)(1:4)= ' ' 19170019 CALL DDALOC (3, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 19180019 ELSE 19190019 ADUMMP(1) = FILEN 19200019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 19210019 END IF 19220019 C-------------------------------------------------------------------- 19230019 IF (ERR .NE. 0) THEN 19240019 WRITE (IPR, 9070) FILEN, ERR, ERRIN 19250019 GO TO 332 19260019 END IF 19270019 C 19280019 NALLOP = NALLOP + 1 19290019 DALLOP(NALLOP) = ALDSNN 19300019 FALLOP(NALLOP) = FILEN 19310019 END IF 19320019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 19330019 C SYSTERM - TERMINAL DIAGNOSTIC FILE TO DUMMY OR MSGCLASS 19340019 C DEPENDING ON DEBUG. ALSO IF PREP HAD A LINK THEN 19350019 C FILE IS ALREADY ALLOCATED. DSNAME SHOULD BE BLANK FOR 19360019 C DUMMY ALLOCATION. 19370019 IF (LNKPREP .EQ. 0) THEN 19380019 FILEN = SYSTERM 19390019 ADUMMP(1) = FILEN 19400019 ALDSNN = BLANKN 19410019 CALL DDALOC (2, ADUMMK, ADUMMP, ALDSNN, ERR, ERRIN) 19420019 C-------------------------------------------------------------------- 19430019 IF (ERR .NE. 0) THEN 19440019 WRITE (IPR, 9070) FILEN, ERR, ERRIN 19450019 GO TO 332 19460019 END IF 19470019 C 19480019 NALLOP = NALLOP + 1 19490019 DALLOP(NALLOP) = ALDSNN 19500019 FALLOP(NALLOP) = FILEN 19510019 END IF 19520019 C 19530019 C COMPILE CSSDAD 19540019 C 19550019 CALL USATT ('FORTVS2 ', ERR, ECB) 19560019 CALL USWAIT (ECB) 19570019 CALL USDET (ECB) 19580019 C 19590019 IF (ERR .NE. 0 .OR. ECB(1) .NE. NOERRZ) THEN 19600019 WRITE (IPR, 9110) ERR, ECB(1) 19610019 GO TO 332 19620019 END IF 19630019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 19640019 C ALLOCATE FILES FOR THE LOADER 19650019 C 19660019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 19670019 C SYSLOUT - ALLOCATE TO MSGCLASS FOR LOAD MAP 19680019 C IF PREP HAD A LINK THEN FILE IS ALREADY ALLOCATED. 19690019 C 19700019 IF (LNKPREP .EQ. 0) THEN 19710019 FILEN = MAPDDN 19720019 AOUTHP(1) = FILEN 19730019 AOUTHP(2)(1:4)= ' ' 19740019 ALDSNN = '&&SYSLOUT ' 19750019 CALL DDALOC (2, AOUTHK, AOUTHP, ALDSNN, ERR, ERRIN) 19760019 C-------------------------------------------------------------------- 19770019 IF (ERR .NE. 0) THEN 19780019 WRITE (IPR, 9070) FILEN, ERR, ERRIN 19790019 GO TO 332 19800019 END IF 19810019 C 19820019 NALLOP = NALLOP + 1 19830019 DALLOP(NALLOP) = ALDSNN 19840019 FALLOP(NALLOP) = FILEN 19850019 END IF 19860019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 19870019 C SYSLIB - USER-SUPPLIED LIBRARIES 19880019 C 19890019 IF (NULIB .GT. 0) THEN 19900019 C 19910019 DO 290 I = 1, NULIB 19920019 ALDSNN = ULIBDS(I)(:44) 19930019 C 19940019 IF (I .EQ. 1) THEN 19950019 ASLIBP(1) = CSLIBP 19960019 ELSE 19970019 ASLIBP(1)(:4) = ULIB 19980019 CALL S1BNCV (I, ASLIBP(1), 5, 2) 19990019 END IF 20000019 C 20010019 C CHECK CATALOG FOR DSN BEFORE ALLOCATION IS DONE 20020019 C 20030019 CALL USCATC (ALDSNN, ERR) 20040019 IF (ERR .EQ. 0) THEN 20050019 WRITE (6, 9190) ALDSNN 20060019 GO TO 332 20070019 END IF 20080019 C 20090019 C 20100019 CALL DDALOC (2, ASLIBK, ASLIBP, ALDSNN, ERR, ERRIN) 20110019 C-------------------------------------------------------------------- 20120019 IF (ERR .NE. 0) THEN 20130019 WRITE (IPR, 9070) ASLIBP(1), ERR, ERRIN 20140019 GO TO 332 20150019 END IF 20160019 C 20170019 NSYSLB = NSYSLB + 1 20180019 DDNCC(NSYSLB) = ASLIBP(1) 20190019 C 20200019 290 CONTINUE 20210019 C 20220019 END IF 20230019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 20240019 C SYSLIB - STANDARD SPARC LIBRARIES 20250019 C 20260019 DO 300 I = 1, NLLINK 20270019 ALDSNN = LINKLB(I) 20280019 C 20290019 IF (NULIB .EQ. 0 .AND. I .EQ. 1) THEN 20300019 ASLIBP(1) = CSLIBP 20310019 ELSE 20320019 ASLIBP(1)(:4) = LINE 20330019 CALL S1BNCV (I, ASLIBP(1), 5, 2) 20340019 END IF 20350019 C 20360019 CALL DDALOC (2, ASLIBK, ASLIBP, ALDSNN, ERR, ERRIN) 20370019 C-------------------------------------------------------------------- 20380019 IF (ERR .NE. 0) THEN 20390019 WRITE (IPR, 9070) ASLIBP(1), ERR, ERRIN 20400019 GO TO 332 20410019 END IF 20420019 C 20430019 NSYSLB = NSYSLB + 1 20440019 DDNCC(NSYSLB) = ASLIBP(1) 20450019 C 20460019 300 CONTINUE 20470019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 20480019 C DYNAMIC CONCATENATION OF THE SYSLIB LIBRARY DATASETS 20490019 C 20500019 CALL USDCC (NULIB+NLLINK, DDNCC, ERR, ERRIN) 20510019 C-------------------------------------------------------------------- 20520019 IF (ERR .NE. 1) THEN 20530019 WRITE (IPR, 9120) ERR, ERRIN 20540019 GO TO 332 20550019 END IF 20560019 C 20570019 C FLAG A SUCCESSFUL CONCATENATION 20580019 C 20590019 NSYSLB = -NSYSLB 20600019 END IF 20610019 C 20620019 C***********************************************************************20630019 C 20640019 C BUILD AND COMPILE OF CSSDAD SUBROUTINE COMPLETED 20650019 C ALLOCATE FILES FOR THE EXECUTION OF THE PROC STEP 20660019 C 20670019 C***********************************************************************20680019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 20690019 C ALLOCATE THE SHARED ACCESS DATASETS 20700019 C 20710019 DO 310 I = 1, NSHRD 20720019 C DO NOT ALLOCATE PIO FILES UNLESS GA3D PRESENT 20730019 IF (I .EQ. 6) THEN 20740019 IF (GA3DF .NE. 1) GO TO 310 20750019 ENDIF 20760019 ASHRP(1) = FILSHR(I) 20770019 ALDSNN = DSNSHR(I) 20780019 CALL DDALOC (2, ASHRK, ASHRP, ALDSNN, ERR, ERRIN) 20790019 C-------------------------------------------------------------------- 20800019 IF (ERR .NE. 0) THEN 20810019 WRITE (IPR, 9070) ASHRP(1), ERR, ERRIN 20820019 GO TO 332 20830019 END IF 20840019 C 20850019 NALLOC = NALLOC + 1 20860019 DALLOC(NALLOC) = ALDSNN 20870019 FALLOC(NALLOC) = FILSHR(I) 20880019 C 20890019 310 CONTINUE 20900019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 20910019 C ALLOCATE FILE FT04F001 - FOR OFTAD PLOT FOR OPERATIONS 20920019 C 20930019 AOUTPP(1) = 'FT04F001' 20940019 AOUTPP(2)(:1) = 'V' 20950019 AOUTPP(4)(:4) = GAPX 20960019 ALDSNN = '&&FT04F001 ' 20970019 CALL DDALOC (4, AOUTPK, AOUTPP, ALDSNN, ERR, ERRIN) 20980019 C-------------------------------------------------------------------- 20990019 IF (ERR .NE. 0) THEN 21000019 WRITE (IPR, 9070) AOUTPP(1), ERR, ERRIN 21010019 GO TO 332 21020019 END IF 21030019 C 21040019 NALLOP = NALLOP + 1 21050019 DALLOP(NALLOP) = ALDSNN 21060019 FALLOP(NALLOP) = AOUTPP(1) 21070019 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 21080019 C ALLOCATE FILE DYNALCDS 21090019 C 21100019 IDYNAP(09) = 0 21110019 IDYNAP(10) = 1 21120019 IDYNAP(11) = 0 21130019 IDYNAP(12) = 1 21140019 C 21150019 ALDSNN = '&&DYNALCDS ' 21160019 CALL DDALOC (8, ADYNAK, ADYNAP, ALDSNN, ERR, ERRIN) 21170019 C-------------------------------------------------------------------- 21180019 IF (ERR .NE. 0) THEN 21190019 WRITE (IPR, 9070) ADYNAP(1), ERR, ERRIN 21200019 GO TO 332 21210019 END IF 21220019 C 21230019 NALLOC = NALLOC + 1 21240019 DALLOC(NALLOC) = ALDSNN 21250019 FALLOC(NALLOC) = ADYNAP(1) 21260019 C 21270019 C EXECUTE THE SPARC PROCESSING 21280019 C 21290019 ECB(1) = 0 21300019 ECB(2) = 0 21310019 C 21320019 IF (LNKPROC .EQ. 0) THEN 21330019 CALL USATT ('CSEXEC ', ERR, ECB) 21340019 CALL USWAIT (ECB) 21350019 CALL USDET (ECB) 21360019 C 21370019 IF (ERR .NE. 0 .OR. ECB(1) .NE. NOERRZ) THEN 21380019 WRITE (IPR, 9180) ERR, ECB(1) 21390019 GO TO 332 21400019 END IF 21410019 C 21420019 ELSE 21430019 IF (JOBID(1:3) .EQ. TSO) WRITE (ITR, 9140) 21440019 CALL USLOAD (LDRSIZ, EXTEND, 'CSEXEC ', MAPDDN, ERR) 21450019 C 21460019 IF (ERR .NE. 0) THEN 21470019 WRITE (IPR, 9185) ERR 21480019 GO TO 332 21490019 END IF 21500019 C 21510019 END IF 21520019 C 21530019 C FLAG A SUCCESSFUL EXECUTION AND THEN FREE ALL ALLOCATED FILES 21540019 C 21550019 330 CONTINUE 21560019 NOERR = 1 21570019 C 21580019 C FREE GM3DPARM FILE 21590019 C 21600019 332 CONTINUE 21610019 IF (GM3DF .EQ. 1 .OR. NINAF .EQ. 1) THEN 21620019 CALL UGUWRK (GM3DSA, GM3DDA, ERR, ERRIN) 21630019 IF (ERR .NE. 1) WRITE (IPR, 9161) GM3DDD, ERR, ERRIN 21640019 END IF 21650019 C 21660019 C FREE HISTPARM FILE 21670019 C 21680019 IF (GEOMF .EQ. 1 .OR. NINAF .EQ. 1) THEN 21690019 CALL DDFREE (1, 1, AHISTP(1), AHISTN, ERR, ERRIN) 21700019 IF (ERR .NE. 0) WRITE (IPR, 9160) AHISTP(1), ERR, ERRIN 21710019 END IF 21720019 C 21730019 C FREE VF3DPARM FILE 21740019 C 21750019 IF (VF3DF .EQ. 1) THEN 21760019 CALL UGUWRK (VF3DSA, VF3DDA, ERR, ERRIN) 21770019 IF (ERR .NE. 1) WRITE (IPR, 9161) VF3DDD, ERR, ERRIN 21780019 END IF 21790019 C 21800019 C FREE UNIRAS FILES 21810019 C 21820019 IF (UNIRF .EQ. 1) THEN 21830019 DO 335 I = 1, NUNID 21840019 AISHRP(1) = FILUNI(I) 21850019 ALDSNN = DSNUNI(I) 21860019 CALL DDFREE (2, UNALK, AISHRP(1), ALDSNN, ERR, ERRIN) 21870019 IF (ERR .NE. 0) WRITE (IPR, 9160) AISHRP(1), ERR, ERRIN 21880019 335 CONTINUE 21890019 C 21900019 CALL DDFREE (2, UNALK, AUNIP(1), AUNIN, ERR, ERRIN) 21910019 IF (ERR .NE. 0) WRITE (IPR, 9160) AUNIP(1), ERR, ERRIN 21920019 END IF 21930019 C 21940019 C FREE SEISPARM FILE 21950019 C 21960019 IF (SEISF .EQ. 1) THEN 21970019 CALL DDFREE (1, 1, ASEISP(1), ASEISN, ERR, ERRIN) 21980019 IF (ERR .NE. 0) WRITE (IPR, 9160) ASEISP(1), ERR, ERRIN 21990019 END IF 22000019 C 22010019 C FREE FT05F001 FILE 22020019 C 22030019 IF (FT05F .EQ. 1) THEN 22040019 CALL DDFREE (1, 1, AFT05P(1), AFT05N, ERR, ERRIN) 22050019 IF (ERR .NE. 0) WRITE (IPR, 9160) AFT05P(1), ERR, ERRIN 22060019 END IF 22070019 C 22080019 IF (LNKPROC .EQ. 1) THEN 22090019 C 22100019 C DECONCATENATE SYSLIB FILES 22110019 C 22120019 IF (NSYSLB .LT. 0) THEN 22130019 NSYSLB = -NSYSLB 22140019 CALL USDDCC (CSLIBP, ERR, ERRIN) 22150019 IF (ERR .NE. 1) WRITE (IPR, 9150) ERR, ERRIN 22160019 END IF 22170019 C 22180019 C FREE SYSLIB USER-SUPPLIED LIBRARIES 22190019 C 22200019 IF (NSYSLB .GT. 0) THEN 22210019 COUNT = 0 22220019 C 22230019 IF (NULIB .GT. 0) THEN 22240019 C 22250019 DO 350 I = 1, NULIB 22260019 COUNT = COUNT + 1 22270019 ALDSNN = ULIBDS(I)(:44) 22280019 CALL DDFREE (1, 1, DDNCC(COUNT), ALDSNN, ERR, ERRIN) 22290019 IF (ERR .NE. 0) WRITE (IPR, 9160) DDNCC(COUNT), ERR, ERRIN22300019 C 22310019 350 CONTINUE 22320019 C 22330019 END IF 22340019 C 22350019 C FREE SYSLIB STANDARD SPARC LIBRARIES 22360019 C 22370019 DO 360 I = 1, NLLINK 22380019 COUNT = COUNT + 1 22390019 ALDSNN = LINKLB(I) 22400019 CALL DDFREE (1, 1, DDNCC(COUNT), ALDSNN, ERR, ERRIN) 22410019 IF (ERR .NE. 0) WRITE (IPR, 9160) DDNCC(COUNT), ERR, ERRIN 22420019 C 22430019 360 CONTINUE 22440019 C 22450019 END IF 22460019 C 22470019 END IF 22480019 C 22490019 C FREE ALLOCATED PRINT FILES IF FORGROUND 22500019 C 22510019 365 CONTINUE 22520019 IF (JOBID(1:3) .EQ. TSO) THEN 22530019 IF (NALLOP .GT. 0) THEN 22540019 C 22550019 DO 370 I = 1, NALLOP 22560019 UNALP(1) = FALLOP(I) 22570019 CDEBUG--REP---------------------------------------------------------- 22580019 IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#') 22590019 + WRITE(6,9310) I, FALLOP(I), DALLOP(I) 22600019 CDEBUG--REP---------------------------------------------------------- 22610019 CALL DDFREE (2, UNALK, UNALP, DALLOP(I), ERR, ERRIN) 22620019 IF (ERR .NE. 0) WRITE (IPR, 9160) FALLOP(I), ERR, ERRIN 22630019 370 CONTINUE 22640019 END IF 22650019 END IF 22660019 C 22670019 C FREE REST OF FILES 22680019 C 22690019 IF (NALLOC .GT. 0) THEN 22700019 C 22710019 DO 375 I = 1, NALLOC 22720019 UNALP(1) = FALLOC(I) 22730019 CDEBUG--REP---------------------------------------------------------- 22740019 IF (LINECD(10:10) .EQ. '$' .OR. LINECD(10:10) .EQ. '#') 22750019 + WRITE(6,9310) I, FALLOC(I), DALLOC(I) 22760019 CDEBUG--REP---------------------------------------------------------- 22770019 CALL DDFREE (2, UNALK, UNALP, DALLOC(I), ERR, ERRIN) 22780019 IF (ERR .NE. 0) WRITE (IPR, 9160) FALLOC(I), ERR, ERRIN 22790019 375 CONTINUE 22800019 END IF 22810019 C 22820019 C PRINT AN APPROPRIATE TERMINATION MESSAGE AND STOP 22830019 C 22840019 IF (NOERR .EQ. 1) THEN 22850019 IF (JOBID(1:3) .EQ. TSO) WRITE (ITR, 9980) 22860019 ELSE 22870019 IF (JOBID(1:3) .EQ. TSO) WRITE (ITR, 9990) 22880019 STOP 16 22890019 END IF 22900019 C 22910019 STOP 22920019 C 22930019 C FORMAT STATEMENTS 22940019 C 22950019 9000 FORMAT (/5X,'ISPARC EXECUTION HAS BEGUN') 22960019 C 22970019 9010 FORMAT (//1X,'PRINT OUTPUT OPTIONS:',/1X,'1: PRINTER',/1X,'2: ', 22980019 * 'HOLD QUEUE',/1X,'3: TERMINAL',/1X,'4: NONE', 22990019 * /1X,'ENTER A PRINT OPTION') 23000019 C 23010019 9020 FORMAT (I1) 23020019 C 23030019 9030 FORMAT (1X,'INVALID PRINT OPTION ',I3) 23040019 C 23050019 9040 FORMAT (/1X,'ENTER A PRINTER DESTINATION: N8R2 OR N1') 23060019 C 23070019 9050 FORMAT (A4) 23080019 C 23090019 9060 FORMAT (1X,'INVALID PRINTER DESTINATION ',A4) 23100019 C 23110019 9070 FORMAT (/1X,30('#')/ 23120019 * ' ### ALLOCATION ERROR ON ',A8,'. ERR=',Z8,' ERRIN=',Z8/ 23130019 * ' ### SEE PROGRAMMERS'/1X,30('#')) 23140019 C 23150019 9080 FORMAT (A80) 23160019 C 23170019 9090 FORMAT ('0*** WARNING *** THE NUMBER OF ULIB CARDS EXCEEDS ARRAY',23180019 * ' SIZE LIMIT OF',I3,' ADDITIONAL CARDS IGNORED',/10X, 23190019 * 'SEE PROGRAMMER FOR SOFTWARE UPDATE') 23200019 C 23210019 9100 FORMAT (/5X,'ERROR ON OPEN OF SYSIN FILE: IOS = ',I5) 23220019 C 23230019 9110 FORMAT (/5X,'HEX ERROR CODES AFTER CALL TO FORTRAN VIA USATT. ', 23240019 * 'ERR = ',Z8,' ECB = ',Z8) 23250019 C 23260019 9120 FORMAT ('0',30('#')/ 23270019 * ' ### CONCATENATE ERROR ON SYSLIB. ERR=',Z8,' ERRIN=',Z8/ 23280019 * ' ### SEE PROGRAMMERS'/1X,30('#')) 23290019 C 23300019 9130 FORMAT (/5X,'HEX ERROR CODES AFTER CALL TO CPPREP VIA USATT. ', 23310019 * 'ERR = ',Z8,' ECB = ',Z8) 23320019 C 23330019 9140 FORMAT (/' THE LOADER HAS JUST BEEN INVOKED') 23340019 C 23350019 9145 FORMAT (/5X,'ERROR CODE AFTER CALL TO CPPREP VIA USLOAD = ',I8) 23360019 C 23370019 9150 FORMAT ('0',30('#')/ 23380019 * ' ### FILE DECONCATENATION ERROR. ERR=',Z8,' ERRIN=',Z8/ 23390019 * ' ### SEE PROGRAMMERS'/1X,30('#')) 23400019 C 23410019 9160 FORMAT ('0',30('#')/ 23420019 * ' ### UNALLOCATION ERROR ON ',A8,' ERR=',Z8,' ERRIN=',Z8/ 23430019 * ' ### SEE PROGRAMMERS'/1X,30('#')) 23440019 C 23450019 9161 FORMAT ('0',30('#')/ 23460019 * ' ### UGUWRK UNALLOCATION ERROR ON ',A8, 23470019 * ' ERR=',Z8,' ERRIN=',Z8/ 23480019 * ' ### SEE PROGRAMMERS'/1X,30('#')) 23490019 C 23500019 9170 FORMAT (/5X,'THE PREP STEP HAS JUST FINISHED') 23510019 C 23520019 9180 FORMAT (/5X,'HEX ERROR CODES AFTER CALL TO CSEXEC VIA USATT. ', 23530019 * 'ERR = ',Z8,' ECB = ',Z8) 23540019 C 23550019 9185 FORMAT (/5X,'ERROR CODE AFTER CALL TO CSEXEC VIA USLOAD = ',I8) 23560019 C 23570019 9190 FORMAT (/5X,'ERROR - ULIB DATASET NOT CATALOGED: ',A44) 23580019 C 23590019 9200 FORMAT (//' EITHER BECAUSE OF A ULIB CARD OR A NON-PRODUCTION ', 23600019 * 'PROCESS,'/' A LINK EDIT IS ABOUT TO BE PERFORMED.'/ 23610019 * ' THIS CAN BE A TIME CONSUMING ACTION.'/ 23620019 * ' DO YOU WISH TO CONTINUE AND DO THE LINK EDIT? (Y/N)') 23630019 C 23640019 9210 FORMAT (A1) 23650019 C 23660019 9220 FORMAT (//' PREP EXECUTION TERMINATING WITHOUT LINK EDIT.') 23670019 C 23680019 9300 FORMAT(' ISPARC - DEALLOCATION AFTER PREP -',I3,2X,A8,2X,A44) 23690019 C 23700019 9310 FORMAT(' ISPARC - DEALLOCATION AFTER PROC -',I3,2X,A8,2X,A44) 23710019 C 23720019 9980 FORMAT (/5X,'SUCCESSFUL EXECUTION OF ISPARC') 23730019 C 23740019 9990 FORMAT (/5X,'UNSUCCESSFUL EXECUTION OF ISPARC') 23750019 END 23760019