FTN4,L,Q C C C DATE: SEPTEMBER 10,1979 C NAME: FTSMT C SOURCE: 02145-18012 C RELOC: 02145-16009 C PGMR: D.E.B. C C******************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, C REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE C WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C******************************************************************** C SUBROUTINE FTSMT(IDCB,VALUS), 02145-1X012 REV. 2001 800304 C THIS IS THE OUTPUT FORMATTING ROUTINE FOR FTEST, THE L-SERIES FUNCTIONAL C TEST. IDCB CONTAINS THE FILE INFORMATION FOR THE OUTPUT FILE, VALUS C CONTAINS THE VALUES WHICH ARE TO BE OUTPUT. C BUFR IS THE TEMPORARY BUFFER IN WHICH EACH OUTPUT STRING IS BUILT UP C TEMP IS A TEMPORARY BUFFER FOR HOLDING INTERMEDIATE STRINGS C IMPLICIT INTEGER (A-Z) INTEGER IDCB(144) INTEGER VALUS(64,8) INTEGER BUFR(40) INTEGER TEMP(6) C C PRINT THE HEADER, LINE BY LINE DO 10 IJ=1,40 10 BUFR(IJ)=20040B CALL LOCF(IDCB,IERR,IREC,ERB,IOFF) CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL STV(BUFR,15,26H L-SERIES FUNCTIONAL TEST ,1,13) CALL WRITF(IDCB,IERR,BUFR(3),36,0) DO 20 IJ=1,40 20 BUFR(IJ)=20040B CALL STV(BUFR,19,12H REV. 800304,1,6) CALL WRITF(IDCB,IERR,BUFR(3),36,0) DO 25 IJ=1,40 25 BUFR(IJ)=20040B CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL FTIME(BUFR(14)) CALL WRITF(IDCB,IERR,BUFR(3),36,0) DO 30 IJ=1,40 30 BUFR(IJ)=20040B CALL STV(BUFR,15,24H PASS # $$$$$$ OF $$$$$$,1,12) CALL CNUMD(VALUS(64,1),BUFR(19)) CALL CNUMD(VALUS(64,2),BUFR(24)) CALL WRITF(IDCB,IERR,BUFR(3),36,0) DO 40 IJ=1,40 40 BUFR(IJ)=20040B CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL STV(BUFR,7,32H DEVICE STATUS AT PASSES ,1,16) CALL STV(BUFR,23,32HPASSES PASSES PASSES PASSES ,1,16) CALL WRITF(IDCB,IERR,BUFR(3),36,0) CALL STV(BUFR,3,30H LU TYPE LAST PASS,1,15) CALL STV(BUFR,18,30H PASSED DOWN FAILED BUS,1,15) CALL STV(BUFR,33,14HY IFC FAIL ,1,7) CALL WRITF(IDCB,IERR,BUFR(3),36,0) DO 50 IJ=1,40 50 BUFR(IJ)=20040B CALL WRITF(IDCB,IERR,BUFR(3),36,0) C FOR EACH LU IDENTIFY ITS TYPE, STATUS, ETC. AND FORMAT AND PRINT THAT C INFORMATION. C DO 1000 I=1,63 C IF TYPE IS -2 THEN THE LU IS NOT CONFIGURED, SKIP ENTIRELY IF(VALUS(I,2).EQ.-2) 1000,105 105 DO 110 IJ=1,40 110 BUFR(IJ)=20040B C PUT THE LU NUMBER IN THE FIRST FIELD CALL CNUMD(I,BUFR(2)) IF((VALUS(I,2).GE.3).AND.(VALUS(I,2).LE.7))114,117 114 TEMP=VALUS(I,2) VALUS(I,TEMP)=VALUS(I,TEMP)+1 117 IF((VALUS(I,1).EQ.0B).OR.(VALUS(I,1).EQ.5B)) 120,140 120 CALL STV(BUFR,6,12HKEYBD CTL DV,1,6) GOTO 600 140 IF(VALUS(I,1).EQ.12B) 160,180 160 CALL STV(BUFR,6,12HLINE PRINTER,1,6) GOTO 600 180 IF(VALUS(I,1).EQ.20B) 200,220 200 CALL STV(BUFR,6,12HSER RECORDNG,1,6) IF(VALUS(I,2).EQ.4)600,696 220 IF(VALUS(I,1).EQ.30B)240,260 240 CALL STV(BUFR,6,12HFLEXBLE DISC,1,6) GOTO 600 260 IF((VALUS(I,1).EQ.31B).OR.(VALUS(I,1).EQ.32B)) 280,300 280 CALL STV(BUFR,6,12HMOV HD DISC ,1,6) GOTO 600 300 IF (VALUS(I,1).EQ.-100) 320,340 320 DO 330 IJ=6,40 330 BUFR(IJ)=2H-- CALL STV(BUFR,20,16H LU UNASSIGNED -,1,8) GOTO 900 340 IF(VALUS(I,8).EQ.0B)360,370 360 CALL STV(BUFR,6,12HUNSPORTD SER,1,6) GOTO 600 370 IF(VALUS(I,1).EQ.11B)375,380 375 CALL STV(BUFR,6,12HHP-IB BUS LU,1,6) GOTO 600 380 IF(VALUS(I,8).EQ.37B)400,420 400 CALL STV(BUFR,6,12HUNSPORTD HPB,1,6) GOTO 696 420 IF(VALUS(I,8).EQ.50B)440,600 440 CALL STV(BUFR,6,12HUNSPORTD PAR,1,6) GOTO 600 600 GOTO (900,900,620,640,660,680,690,900,695,900)VALUS(I,2) 620 CALL STV(BUFR,14,6HPASSED,1,3) GOTO 700 640 CALL STV(BUFR,14,6HDOWN ,1,3) GOTO 700 660 CALL STV(BUFR,14,6HFAILED,1,3) GOTO 700 680 CALL STV(BUFR,14,6HBUSY ,1,3) GOTO 700 690 CALL STV(BUFR,14,8HIFC FAIL,1,4) GOTO 700 695 CALL STV(BUFR,14,8HUNMOUNTD,1,4) GOTO 697 696 CALL STV(BUFR,14,8HUNTESTED,1,4) 697 DO 698 M=19,40 698 BUFR(M)=2H-- GOTO 900 700 DO 720 J=3,6 720 CALL CNUMD(VALUS(I,J),BUFR(7+4*J)) CALL CNUMD(VALUS(I,7),BUFR(36)) 900 CALL WRITF(IDCB,IERR,BUFR(3),36,0) 1000 CONTINUE DO 1100 Z=1,3 1100 CALL WRITF(IDCB,IERR,BUFR,1,0) CALL APOSN(IDCB,IERR,IREC,ERB,IOFF) RETURN END