CTITLEUSPHD -- PRINT HEADINGS FOR PROCESSES 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. MCMILLAN 00020001 CA DESIGNER R. MCMILLAN 00030001 CA LANGUAGE FORTRAN 00040001 CA SYSTEM IBM AND CRAY 00050001 CA WRITTEN 06-10-75 00060001 C REVISED 04-18-80 HHL. USE DATIME FOR DATE AND TIME 00070001 C INSTEAD OF S1DATE AND S1TIME. 00080001 C REVISED 04-08-81 SAS. ADDED 'COMM' CARD MESSAGE 00090001 C STRING TO PROCESS HEADING PRINT. 00100001 C REVISED 12-01-83 NTS. CHANGE LINE NAME TO 20 00110001 C CHARACTERS. CHANGES IN THE FORMAT 00120001 C # 9000( PROC), AND # 9010( PREP). 00130001 C REVISED 09-14-84 ESN. TO MAKE COMPATIBLE WITH CRAY. 00140001 C REVISED 04-26-85 MJM. REMOVE PAGE EJECT FOR PREPS. 00150001 C REVISED 06-22-86 JGM CORRECTED ALIGNMENT OF TEXT AND 00160001 C IFIRST FLAG. 00170001 C REVISED 03-08-89 ESN. PRINT JOB NUMBER. 00180001 CA 00190001 CA CALL USPHD (TYPE, ACLNAM,KPNA, KPRNO, TEXT, TEXTLN, IPR) 00200001 CA INPUT TYPE = 1 FOR PREPARATION AND =2 FOR PROCESSOR I4 00210001 CA INPUT ACLNAM = LINE NUMBER IN EBCDIC CODE 5A4 00220001 CA INPUT KPNA = PROCESS NAME A4 00230001 CA INPUT KPRNO = PROCESS NUMBER I4 00240001 CA INPUT TEXT = MESSAGE TO BE PRINTED IN HEADING A80 00250001 CA INPUT TEXTLN = NUMBER OF CHARACTERS IN TEXT (MAX=80) I4 00260001 CA INPUT IPR = PRINT UNIT I4 00270001 CA 00280001 CA 00290001 CA THIS PROGRAM PRINTS A HEADING FOR THE PREPARATION ROUTINES AND 00300001 CA THE PROCESSORS. AN OPTIONAL MESSAGE TEXT MAY BE INCLUDED IN 00310001 CA THE HEADING. THE MESSAGE MAY BE UP TO 80 CHARACTERS LONG. IF 00320001 CA TEXTLN = 0 THEN NO MESSAGE WILL BE ADDED TO THE HEADER. THE 00330001 CA FIRST CALL DETERMINES THE TYPE OF HEADING PRINTED, I.E. "TYPE" 00340001 CA IS IGNORED AFTER THE FIRST CALL. A MESSAGE WILL BE PRINTED IF 00350001 CA THE MESSAGE TEXT IS GREATER THAN 80 CHARACTERS. 00360001 CA 00370001 CA 00380001 C 00390001 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 00400001 C 00410001 C X ( 20) = MESSAGE CENTERED AND READY TO PRINT R8 00420001 C C ( 20) = COMMENT CENTERED AND READY TO PRINT R8 00430001 C 00440001 C 00450001 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00460001 C 00470001 C DATE = CURRENT CALENDER DATE A8 00480001 C FCF = FIRST CALL FLAG I4 00490001 C JOBCLS = JOB CLASS OF CURRENT JOB A1 00500001 C JOBNAM = NAME OF CURRENT JOB A8 00510001 C JOBNUM = NUMBER OF CURRENT JOB A8 00520001 C TIME = TIME OF DAY A8 00530001 C TYPSAV = TYPE OF HEADING DESIRED (SET TO FIRST "TYPE") I4 00540001 C TDUMM = DUMMY VARIABLE FOR USE WITH DATIME ROUTINE I4 00550001 C EJECT 00560001 C 00570001 SUBROUTINE USPHD (TYPE, ACLNAM,KPNA, KPRNO, TEXT, TEXTLN, IPR) 00580001 C 00590001 IMPLICIT INTEGER (A-Z) 00600001 C 00610001 C 00620001 C INTEGER ARRAYS IN PARAMETER LIST. 00630001 CHARACTER ACLNAM*20 00640001 CHARACTER TEXT *160 00650001 C 00660001 C 00670001 C CHARACTER ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 00680001 CHARACTER C *160 00690001 CHARACTER DATE *8 00700001 CHARACTER JOBCLS*8 00710003 CHARACTER JOBNAM*8 00720001 CHARACTER JOBNUM*8 00730001 CHARACTER TIME *8 00740001 CHARACTER X *160 00750001 C 00760001 C 00770001 C INTEGER VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00780001 DATA FCF /0/ 00790001 DATA IFIRST /0/ 00800001 DATA TDUMM /0/ 00810001 C 00820001 C EJECT 00830001 C 00840001 C 00850001 C CHECK TO SEE IF THIS IS THE FIRST TIME THROUGH 00860001 C 00870001 IF (FCF .GT. 2) GO TO 10 00880001 IF (FCF .NE. 0) GO TO 5 00890001 CALL DATIME (DATE,TIME,TDUMM) 00900001 C CALL S1TIME (DATE) ** USING DATIME ** 00910001 CALL JOBINF (JOBNAM, JOBNUM, JOBCLS) 00920001 TYPSAV = TYPE 00930001 C 00940001 C CHECK FOR 'COMM' CARD MESSAGE STRING 00950001 C 00960001 5 IF (FCF .GE. 1 .AND. TYPSAV .EQ. 2) GO TO 10 00970001 CALL ARSET (C, 20, ' ') 00980001 C 00990001 FCF = FCF + 1 01000001 IF (FCF .EQ. 1 .AND. TYPSAV .EQ. 1) GO TO 10 01010001 IF (FCF .EQ. 2 .AND. TYPSAV .EQ. 1) GO TO 10 01020001 C 01030001 DA = 1 01040001 CALL FORC ('COMM',0,DA,X, *10) 01050002 C 01060001 CALL S1MVCH (X,11,C,6,70) 01070002 C 01080001 C BLANK THE MESSAGE TEXT AREA 01090001 C 01100001 10 CALL ARSET (X, 20, ' ') 01110001 IF (TEXTLN.LE.0) GO TO 20 01120001 N = TEXTLN 01130001 IF (TEXTLN.GT.80) N = 80 01140001 CHAR = (80 - N) / 2 + 1 01150001 CALL S1MVCH (TEXT,1,X,CHAR,N) 01160001 C 01170001 C CHECK FOR PRE-PROCESSOR OR PROCESSOR 01180001 C 01190001 20 IF (TYPSAV.EQ.1) GO TO 30 01200001 C MUST BE A PROCESSOR 01210001 WRITE (IPR,9000) ACLNAM,C,DATE,TIME,KPNA,KPRNO,X,JOBNAM, 01220001 * JOBNUM 01230001 GO TO 40 01240001 C PRE-PROCESSOR 01250001 30 CONTINUE 01260001 IF (IFIRST .EQ. 0 ) THEN 01270001 IFIRST = 1 01280001 WRITE (IPR,9010) ACLNAM,C,DATE,TIME,KPNA,KPRNO,X,JOBNAM, 01290001 * JOBNUM 01300001 ELSE 01310001 WRITE (IPR,9011) ACLNAM,C,DATE,TIME,KPNA,KPRNO,X,JOBNAM, 01320001 * JOBNUM 01330001 END IF 01340001 C 01350001 40 IF (TEXTLN.GT.80) WRITE (IPR,9020) 01360001 RETURN 01370001 C 01380001 9000 FORMAT ('1',132('=')/1X, A20, ' |',A80, 01390001 * T104,'| DATE ',A8,' TIME ',A8/1X,A4,I1,' PROC ', 01400001 * 8X,'|',A80,'| JOB ',A8,'(',A8,')',/, 01410001 * 1X,132('=')//) 01420001 C 01430001 9010 FORMAT ('1',132('=')/1X, A20, ' |',A80, 01440001 * T104,'| DATE ',A8,' TIME ',A8/1X,A4,I1,' PREP ', 01450001 * 8X,'|',A80,'| JOB ',A8,'(',A8,')',/, 01460001 * 1X,132('=')//) 01470001 C 01480001 9011 FORMAT (' ',//,132('=')/1X, A20, ' |',A80, 01490001 * T104,'| DATE ',A8,' TIME ',A8/1X,A4,I1,' PREP ', 01500001 * 8X,'|',A80,'| JOB ',A8,'(',A8,')',/, 01510001 * 1X,132('=')//) 01520001 C 01530001 9020 FORMAT (20X,'**** MESSAGE TEXT FOR HEADING CANNOT EXCEED 80 ', 01540001 * 'CHARACTERS ****'//) 01550001 C 01560001 END 01570001