CTITLECPSMRY -- PREPARATION STEP SUMMARY 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH MCMILLAN 00020000 CA DESIGNER RALPH MCMILLAN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 08-20-75 00060000 C REVISED 11-23-76 BY R. MCMILLAN TO ADD CHECK FOR AN INPUT 00070000 C PROCESS. 00080000 C REVISED 03-03-77 MENDEKE - DELETED CHECK FOR INPUT PROCESS. 00090000 C REVISED 01-11-82 POLAK - CHANGED CSTIME CALL LIST. 00100000 C REVISED 01-28-83 DAVIS - PRINT DYNAMICALLY ALLOCATED DATA 00110000 C SETS. 00120000 C REVISED 09-21-84 LBL. - CRAY COMPATIBILITY. 00130000 C REVISED 04-22-85 ESN. - CRAY COMPATABILITY WITH FOWTDS. 00140000 C REVISED 06-03-87 DJP. - CHANGED PRINT UNIT FROM 6 TO 98 AND 00150000 C MADE IT A PARAMETER TO CSPMAP AND CSTIME. 00160000 C REVISED 03-08-89 ESN. - MODIFIED CALL TO CSPMAP AND CSTIME 00170001 C FOR SECOND PRINT UNIT. 00180001 CA 00190000 CA CALL CPSMRY 00200000 CA 00210000 CA 00220000 CA THIS ROUTINE PRINTS A SUMMARY FOR THE PREPARATION STEP. 00230000 CA AT THE PRESENT TIME ALL IT DOES IS CALL CSPMAP , CSTIME, AND 00240000 CA CHECKS FOR AN INPUT PROCESS. 00250000 C EJECT 00260000 C 00270000 C SPECIAL INSTRUCTIONS. NONE. 00280000 C 00290000 C CAUTIONS. NONE. 00300000 C 00310000 C ERROR MESSAGES. MESSAGE PRINTED IF NO INPUT PROCESS 00320000 C IS FOUND. (MCRTF = -22) 00330000 C 00340000 C 00350000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00360000 C 00370000 C FATIOM = INDEX IN FILE ATTRIBUTE TABLE FOR I/O MODE I4 00380000 C INDBGA = INDEX IN KP-AREA FOR KPDBGA I4 00390000 C INDFAT = INDEX TO CURRENT FILE ATTRIBUTE TABLE I4 00400000 C LAST = INDEX FOR LAST KP-AREA IN PROTAB I4 00410000 C TIME = DUMMY VARIABLE TO PASS TO CSTIME. R8 00420000 C 00430000 C EJECT 00440000 SUBROUTINE CPSMRY 00450000 C 00460000 IMPLICIT INTEGER (A-Z) 00470000 C 00480000 PARAMETER (IPR=98) 00490000 C 00500000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 00510000 COMMON /P/ STARTP ( 2) , M00000( 18) 00520000 COMMON /P/ LCDRYF , M00080( 10) 00530000 COMMON /P/ ACLNAM ( 5) , M00124( 68) 00540000 COMMON /P/ KPNA , M00416( 4) 00550000 COMMON /P/ KPDBGA , M00436( 73) 00560000 COMMON /P/ MCRTF , M00732( 3) 00570000 COMMON /P/ MCNKP , M00748( 134) 00580000 COMMON /P/ PTNCW , M01288( 37) 00590000 COMMON /P/ PROTAB ( 2) 00600000 COMMON /P/ ENDP 00610000 C 00620000 C REAL VARIABLES AND CONSTANTS--LOCAL 00630000 C 00640000 CHARACTER*8 TIME 00650000 CHARACTER*8 XIO 00660000 CHARACTER*44 XDSNAM 00670000 C 00680000 C INTERGER ARRAYS--LOCAL 00690000 C 00700000 INTEGER PRECRD (20) 00710000 C 00720000 C INTERGER VARIABLES--LOCAL 00730000 C 00740000 DATA FATIOM /25/ 00750000 DATA JPR / 0/ 00760000 C 00770000 C================================================================== 00780000 C 00790000 CALL CSPMAP (IPR, JPR) 00800000 C 00810000 IF (S1CPCH(LCDRYF,1,'PROC',1,4) .NE. 0) GO TO 20 00820000 C 00830000 C CHECK FOR AN INPUT PROCESS 00840000 C 00850000 CZ LAST = PTNCW * MCNKP 00860000 CZ INDBGA = (LOC(KPDBGA) - LOC(KPNA)) / 4 00870000 C 00880000 CZ DO 10 00890000 CZ * I = 1, LAST, PTNCW 00900000 CZ IF (PROTAB(I+INDBGA) .EQ. 0) GO TO 10 00910000 CZ INDFAT = (PROTAB(I+INDBGA) - LOC(PROTAB)) / 4 00920000 CZ IF (S1CPCH(PROTAB(INDFAT+FATIOM),1,'I',1,1) .EQ. 0) GO TO 20 00930000 CZ 00940000 CZ 10 CONTINUE 00950000 CZ 00960000 CZ MCRTF = -22 00970000 CZ WRITE (IPR, 9000) 00980000 C 00990000 20 CALL CSTIME (TIME, CTIME, IPR, JPR) 01000001 C READ MSS DATA FROM TEMPORARY DATA SET 01010000 CALL FOWTDS (PRECRD, 2, STATUS) 01020000 IF (STATUS .EQ. 2) GO TO 100 01030000 IF (STATUS .NE. 1) GO TO 40 01040000 CALL USPHD (1, ACLNAM,'EXEC', 0, 01050000 * 'DYNAMICALLY ALLOCATED DATA SETS', 31, IPR) 01060000 WRITE (IPR, 9010) 01070000 30 CONTINUE 01080000 XNAME = PRECRD(1) 01090000 XNUM = PRECRD(2) 01100000 XUNIT = PRECRD(3) 01110000 CALL S1MVCH (PRECRD(4), 1, XIO, 1, 8) 01120000 CALL S1MVCH (PRECRD(6), 1, XDSNAM, 1, 44) 01130000 WRITE (IPR, 9020) XNAME,XNUM,XUNIT,XIO,XDSNAM 01140000 CALL FOWTDS (PRECRD, 2, STATUS) 01150000 IF (STATUS .EQ. 2) GO TO 100 01160000 IF (STATUS .EQ. 1) GO TO 30 01170000 40 CONTINUE 01180000 WRITE (IPR, 9030) 01190000 100 CONTINUE 01200000 RETURN 01210000 C 01220000 9000 FORMAT ('-*** ERROR - NO INPUT PROCESS ***') 01230000 C 01240000 9010 FORMAT (////,2X,'DYNAMICALLY ALLOCATED DATA SETS',/,2X,31('-'), 01250000 * //,2X,'PROG',3X,'UNIT',3X,'I/O MODE',3X,'DATA SET NAME', 01260000 * /,2X,4('-'),3X,4('-'),3X,8('-'),3X,13('-')) 01270000 C 01280000 9020 FORMAT (/,2X,A4,I1,2X,A4,3X,A8,3X,A44) 01290000 C 01300000 9030 FORMAT (/,6X,'ERROR READING TEMPORARY DATA SET') 01310000 C 01320001 END 01330000