C PROGRAM TO GET SYSTEM DATE AND TIME AND PRINT HEADER WITH FILENAME. C FILED--27-JAN-83, G. BEVER. C EDITED--12-FEB-83, G. BEVER. C EDITED--4-APR-83, G. BEVER. C EDITED--13-JUN-84, G. BEVER. C C .LINK PRH,DATE C BYTE STRNG(8),IBUF(12) INTEGER*2 ISPEC(39),JSWI(4,4),JBUF(68) REAL*4 EXT(2),RMON(12) DATA JSWI/'H',3*0,'L',3*0,'M',3*0,'F',3*0/ DATA RMON/'Jan ','Feb ','Mar ','Apr ','May ','Jun ','Jul ','Aug ', C 'Sep ','Oct ','Nov ','Dec '/ C INITIALIZE PARAMS. L=0 LINE=0 C GET FILENAME ENTERED. 5 IF(ICSI(ISPEC,EXT,,JSWI,4).NE.0) GO TO 5 C ASSIGN LU 9 (FILE TO PRINT) CALL IASIGN(9,ISPEC(16),ISPEC(17),0,0) C ASSIGN LU 6 (OUTPUT FILE) CALL IASIGN(6,ISPEC(1),ISPEC(2),0,0) C IF '/H' SWITCH NOT HIT, GO TO 8. IF(JSWI(2,1).EQ.0) GO TO 8 TYPE 107 107 FORMAT(1X,'Prints out 1st file entered to 2nd file entered,'/ C ' including header of time, date, and file name. If 2nd file',/ C ' name is not entered, then the lineprinter is used.',// C ' /H switch prints out this text on console.',// C ' /L switch includes line numbers in listing.',// C ' /L/M:VAL switches includes line numbers modulo VAL (1 to VAL).' C ,// C ' /L/M:VAL/F switches does above but form feeds when VAL rolls' C ' over to 1.',// C ' EXAMPLE: .RU PRH FILE.NAM/L',/ C ' will list file FILE.NAM to the lineprinter with' C ' linenumbers.',/) GO TO 5 C CONVERT RAD50 FILENAME TO ASCII STRING. 8 CALL R50ASC(12,ISPEC(16),IBUF) C GET TIME CALL TIME(STRNG) C GET DATE CALL DATE(IDAT) C IF SYSTEM DATE WAS ENTERED, GO TO 10. ELSE IGNORE DATE PRINTOUT. IF(IDAT.NE.0) GO TO 10 WRITE(6,101)(STRNG(I),I=1,8),(IBUF(I),I=1,12) 101 FORMAT(30X,8A1,5X,9X,5X,3A1,':',6A1,'.',3A1,/) C EXTRACT MONTH, DAY, AND YEAR. 10 IMON=IRAM(IDAT,10,"17) IDAY=IRAM(IDAT,5,"37) IYR= IRAM(IDAT,0,"37)+72 C OUTPUT TIME, DATE, FILENAME TO LU 6. WRITE(6,103)(STRNG(I),I=1,8),IDAY,RMON(IMON),IYR,(IBUF(I),I=1,12) 103 FORMAT(30X,8A1,5X,I2,'-',A3,'-',I2,5X,3A1,':',6A1,'.',3A1,/) C XFER FILE TO LU 6. 20 READ(9,100,END=999) (JBUF(I),I=1,68) 100 FORMAT(68A2) LINE=LINE+1 C IF NO MODULO REQUESTED, OR MODULO REQUESTED WITHOUT VALUE, GO TO 25. IF(JSWI(2,3).NE.2) GO TO 25 C IF NOT TIME FOR LINE NUMBER TO ROLL OVER, GO TO 25. IF(LINE.LE.JSWI(4,3)) GO TO 25 LINE=1 C IF /F SWITCH NOT REQUESTED, GO TO 25. IF(JSWI(2,4).EQ.0) GO TO 25 WRITE(6,106) 12 ! FORMFEED. 106 FORMAT('+',A1,$) C DELETE TRAILING BLANKS. 25 J=68 DO 30 I=1,68 IF(JBUF(J).NE."020040) GO TO 35 30 J=J-1 C IF NO LINE NUMBER DESIRED, GO TO 36. 35 IF(JSWI(2,2).EQ.0) GO TO 36 WRITE(6,104) LINE,9,(JBUF(I),I=1,J) 104 FORMAT(1X,I5,A1,68A2) GO TO 20 36 WRITE(6,105) (JBUF(I),I=1,J) 105 FORMAT(1X,68A2) GO TO 20 999 CALL EXIT END