C UUUUUUUUUUUUUUUUUU U N C L A S S F I E D UUUUUUUUUUUUUUUUUUUU C C M G O L D . F O R C C THIS PRORGAM VERIFIES MODS GOLD DATA. THE PROGRAM WILL NOT OPERATE C CORRECTLY UNLESS THE MODS TRANSFER IS ACCOMPLISHED USING THE MODS GOLD C DATA FORMAT FOR INPUT. DISPLAY THE HELP FILE 'MODXXX.HLP' FOR INFO C ON THE MODS GOLD DATA FORMAT AND HOW TO CREATE A MODS GOLD TAPE. C C THIS PROGRAM MONITORS THE MODS GOLD SFID COUNTER THAT OCCURS FOR EACH C MODS GOLD SUBFRAME. THE COUNTER DIFFERENCE BETWEEN ANY ADJACENT C SUBFRAMES SHOULD BE ONE. THE COUNTER SHOULD ROLL OVER AT 255 (HEX 00FF). C IF NOT A 'SFID ERROR' IS REPORTED. THE EXTRACTION SOFTWARE MONITORS THE C SECOND SYNC WORD IN EACH MAJOR FRAME. THIS PROGRAM VERIFIES THE FIRST C SYNC WORD FOR EVERY MAJOR AND MINOR FRAME. IF NOT CORRECT, A DATA C PATTERN ERROR-SYNC WORD ERROR IS DECLARED. FINALLY, THE PROGRAM VERIFIES C THE DSI MODEL 7121 PROM PATTERN THAT OCCURS WITHIN EACH SUBFRAME. C AFTER ALL THE DATA IS VERIFIED, OR THE SELECTED STOP TIME IS REACHED, C THE ACCUMULATED SFID, SYNC AND DATA ERRORS FOR EACH MUX CHANNEL C IS DISPLAYED. C C THIS PROGRAM IS INTENDED TO RUN ON STANDARD DEU'S WITH PDP-11/34A CPU'S C UNDER RT-11SJ V5.01 AND ABOVE. C C C JUNE 1995 - V1.0 - J. MARTIN / ATK C C C SUBROUTINES.... C C COL132 = XMIT ANSI CODE TO CLEAR SCREEN. C HELP = OPEN AND DISPLAY FILE DK:MODXXX.HLP C MTINI = INITIALIZE NUWC, RI MT HANDLER C MTRWND = NUWC, RI MT REWIND C ONLINE = CHECK MTS ONLINE BIT, RETURN IMMEDIATELY C RSTAT = DECODE MT STATUS REG, WAIT UNTIL PREVIOUS C COMMAND COMPLETES. C MTREAD = NUWC, RI MT READ C LMSB = ROTATE 8 BIT WORD 180 DEGRESS. STORE IN 16 BIT WORD. C SHIFT 8 BITS RIGHT (TO AVOID SIGN BIT). USED TO C DECODE 7121 SFID. C IHEX = TRANSLATE 16 BIT SIGNED WORD INTO FOUR ASCII HEX C CHARACTERS. RT-11 FOR IV HAS NO HEX FORMAT SPEC. C JTIME = CONVERT IE TIME WORDS TO REAL NUMBERS. DECODE C INTO MMMM.SSSS FORMAT. C C VARIBLES, BUFFERS, CONSTANTS... C C CHAR = HOLDS SYS CON KEY PRESSES C IBLOCK = TAPE READ BUFFER C IHDR = TAPE LABEL BUFFER C IPROM = 7121 PROM PATTERN C IBYTES = # OF 8 BIT BYTES TO ISSUE TO MTREAD C ITAPE = # OF 16 BIT WORDS IN ONE TAPE RECORD C ISFERR = 4 SFID ERROR ACCUMULATORS (1 FOR EACH CHANNEL) C ISWERR = 4 SYNC WORD ERROR ACCUMULATORS C IDPERR = 4 DATA PATTERN ERROR ACCUMULATORS C FSTART = IE TIME TO START TEST AT C FSTOP = IE TIME TO STOP TEST AT C IWORD = IBLOCK BUFFER POINTER C IFRAME = CURRENT SUBFRAME C IREC = TAPE RECORD ACCUMULATOR C ISUBF = # OF MINOR SUBFRAMES PER MAJOR FRAME C ISFID = WORD POSITION OF MAJOR SFID C IWDFR = # OF WORDS PER SUBFRAME C ICHAN = NUMBER OF MUX/DECOM CHANNELS C ICNUM = MUX/DECOM CHANNEL # POINTER C ICHK = EXPECTED SFID VAULE C IPRT = ACTUAL SFID VAULE FOR DISPLAY ROUTINE C ICUR = CURRENT SFID C IPREV = LAST SFID C IP = PROM BUFFER POINTER FOR DISPLAY ROUTINE C ISTAT = SHOW COUNTERS CODE ENTERED FLAG C C IMPLICIT INTEGER*2 (I,J,K), REAL(F,G) LOGICAL*1 CHAR(2), CSTAT(2) C C IBLOCK IS BIG ENOUGH TO HOLD LARGEST POSSIBLE MODS TAPE RECORD C IF ACUTAL RECORD IS SMALLER, REMAINING BUFFER IS NOT FILLED. C DIMENSION IBLOCK(9374), IHDR(56), IPROM(256), 1ISFERR(4), ISWERR(4), IDPERR(4) DATA IBLOCK/9374*0/ DATA IHDR/56*0/ DATA IPROM/256*0/ C C 4 ERROR ACCUMULATORS (4 EACH) C DATA ISFERR/4*0/ DATA ISWERR/4*0/ DATA IDPERR/4*0/ C C DO NOT BYPASS INDIVIDUAL ERROR REPORTING IS DEFAULT C DO NOT SHOW ACCUMULATOR ERROR COUNTERS IS DEFAULT C CHAR(1)='Y' CSTAT(1)=' ' C C SO EOT WILL NOT RETURN TO LABEL 304 IF 'S' NEVER PRESSED. C ISTAT=0 C C READ ENTIRE TAPE IS DEFAULT (UNLESS TIME IS .GE. 999.9999) C FSTART=000.0000 FSTOP=999.9999 C C IWORD POINTS PAST FRAME HEADER (1 STATUS, 4 TIME WDS) C IWORD=5 IFRAME=1 ICNUM=1 C 11 FORMAT(X) !SKIPS A LINE IN DISPLAY C C LA120 IGNORES COL132 CODES, VT TERMINAL PROCESSES C CALL COL132 C C INITIALIZE NUWC, RI MT HANDLERS C CALL MTINI TYPE *,' MGOLD v1.0' TYPE *,' ' C 14 FORMAT(A1) TYPE *,' Display file MGOLD.HLP for instructions.' TYPE *,' ' C 20 WRITE(7,11) 12 FORMAT(X,'Enter the MODS GOLD magtape unit # (0,1,2 or 3) > ',$) WRITE(7,12) ACCEPT *,IUNIT IF(IUNIT .GE. 0 .AND. IUNIT .LE. 3) GO TO 25 TYPE *,'*** Enter 0, 1, 2 or 3 ***' GO TO 20 C C REWIND SELECTED MAGTAPE UNIT. CHECK ONLINE STATUS C DO NOT ISSUE ANY MT COMMANDS UNTIL REWIND COMPLETES C 25 CALL MTRWND(IUNIT) CALL ONLINE(IOFF) !ONLINE INFORMS IF IOFF IF(IOFF .EQ. 1) GO TO 25 !ISSUE COMMAND UNTIL ONLINE CALL RSTAT(IFLAG,IREC,IREROR,IMTS,IUNIT) !IF -IOFF THEN WAIT UNITL C MTRWND COMPLETES. C READ TAPE LABEL. C UNEXPLAINED ANOMALLY: ACUTAL # OF BYTES IN LABEL IS 112. C IF NOT AT BOT WHEN REWIND, MTS REC LENGTH ERROR BIT SET ON C SOME AVIV SYSTEMS. IBYTES=224 AVOIDS. (WE ONLY DECODE 112). C C IBYTES=224 100 CALL MTREAD(IUNIT,IBYTES,IBLOCK(1)) CALL RSTAT(IFLAG,IREC,IREROR,IMTS,IUNIT) IF(IREROR .EQ. 0) GO TO 101 !IREROR=1 IF MTC ERROR WRITE(7,11) !BIT SET TYPE *,' *** ERROR READING TAPE LABEL ***' 102 FORMAT(X,'Continue anyway? (Y/N DEFAULT:N) > ',$) WRITE(7,11) WRITE(7,102) READ(5,14) IANS IF(IANS .EQ. 'Y') GO TO 103 IF(IANS .EQ. 'y') GO TO 103 GO TO 999 C 104 FORMAT(X,'Enter the MODS data type (RC/SP) > ',$) 114 FORMAT(A2) 103 WRITE(7,104) READ(5,114) ITYPE C C IF(ITYPE .EQ. 'RC') GO TO 150 IF(ITYPE .EQ. 'SP') GO TO 150 C TYPE *,'*** Enter RC or SP ***' GO TO 103 C C NO READ ERROR READING TAPE LABEL... C 31 FORMAT(56A2) 32 FORMAT(X,'MT',I1,': LABEL = ',56A2) 33 FORMAT(A2,110X) 101 DECODE(IBYTES,31,IBLOCK) IHDR DECODE(IBYTES,33,IBLOCK) ITYPE WRITE(7,11) WRITE(7,32) IUNIT, IHDR WRITE(7,11) C C LARGEST POSSIBLE MODS RECORD SIZE.. C IBYTES=18752 C C HEADER DATA TYPE IS RC C 150 IF(ITYPE .NE. 'RC') GO TO 151 IBYTES=12376 !BYTES PER TAPE RECORD ITAPE=IBYTES/2 !WORDS PER TAPE RECORD ISFID=13 !SFID WORD POSITION IWDFR=773 !WORDS PER SUBFRAME ISUBF=2 !SUBFRAMES PER RECORD ICHAN=4 !# OF MUX CHANNELS IWDFR=IWDFR*ICHAN !MULTI CHANNEL DATA.. GO TO 200 C 151 IF(ITYPE .NE. 'SP') GO TO 443 IBYTES=18752 ITAPE=IBYTES/2 ISFID=11 IWDFR=781 ISUBF=4 ICHAN=3 IWDFR=IWDFR*ICHAN GO TO 200 C C READ THE FIRST DATA RECORD SO WE CAN VERIFY DATA C IS MODS GOLD. ALSO I NEED A STARTING VALUE FOR THE C SFID COUNTER... C 200 CALL MTREAD(IUNIT,IBYTES,IBLOCK(1)) IREC=IREC+1 CALL RSTAT(IFLAG,IREC,IREROR,IMTS,IUNIT) IF(IFLAG .EQ. 1) GO TO 1000 !IFLAG=1 IF MTS EOF BIT SET. IF(IREROR .EQ. 1) GO TO 200 C C DECODE SFID COUNTER SO IT MAKES SENSE. ACUTAL COUNTER C HAS LSB AT MSB POSITIONS SWAPPED. THIS IS A HARDWARE CHARACTERISTIC C OF THE SIMULATOR AND IS NOT USER PROGRAMMABLE. C CALL LMSB(IBLOCK(ISFID),ICUR) C IPREV=ICUR-ISUBF !BIAS IPREV FOR FIRST RECORD. C (SFID CHECK ADDS ISUBF TO C VALUE OF LAST SFID) C C DECODE TIME FROM WORDS 2,3 AND 4. CONVERT TO A REAL NUMBER. C FTIM1=FLOAT(IBLOCK(2)) FTIM2=FLOAT(IBLOCK(3)) FTIM3=FLOAT(IBLOCK(4)) CALL JTIME(FTIM1,FTIM2,FTIM3,FTIME,IERR) C C IS TAPE MODS? C C MODS RCV IS 4 CHANNEL C IF(ITYPE .EQ. 'RC' .AND. IBLOCK(12) .EQ. 44) GO TO 444 C C MODS SP IS 3 CHANNEL C IF(ITYPE .EQ. 'SP' .AND. IBLOCK(12) .NE. 44) GO TO 444 GO TO 443 !TAPE IS NOT MODS... C C TAPE IS MODS, IS IT MODS GOLD? (CHECKS PROM PATTERN VAULES). C 444 IF(ITYPE .EQ. 'RC' .AND. IBLOCK(37) .EQ. "177777 1.AND. IBLOCK(41) .EQ. 0) GO TO 400 IF(ITYPE .EQ. 'SP' .AND. IBLOCK(29) .EQ. "177777 1.AND. IBLOCK(32) .EQ. 0) GO TO 400 C C TAPE IS EITHER NOT MODS OR NOT MODS GOLD. C 443 WRITE(7,11) WRITE(7,447) 447 FORMAT(X,30X,'*** TAPE NOT MODS GOLD ***') WRITE(7,11) GO TO 999 C C LOAD PROM TABLE. SEE DSI MANUAL 15-018028/0049a-0020a MODEL 7121 C PCM/PSK SIMULATOR PG. 13. PATTERN IS: C C PATTERN RANGE COMMENTS C C A) 001-008 = WORD NUMBER (HEX 0001-0008) C B) -009 = FULL SCALE OR HEX FFFF C C) -010 = HEX 0000 C D) 011-026 = WALK BIT LEFT WITH LSB SET (HEX 0001-8001) C E) 027-256 = WORD NUMBER (HEX 001B-0100) C C THIS PATTERN WILL DETECT: C 1) NOISEY DATA C 2) STUCK BITS C 3) SHIFTED DATA C 4) INOP BUFFERS IN DEU DATA PATHS C A) REPEATED WORDS (LOAD/UNLOAD PROBLEMS) C B) BUFFER SELECTION LOGIC. (OUT OF ORDER BUFFERS) C 5) ETC... C C THIS PATTERN WILL NOT DETECT REVERSED DATA CHANNELS.... C C C FROM THIS POINT FORWARD IT IS RECOMMENDED THAT THE READER HAVE A C DUMP OF A MODS GOLD TAPE RECORD. IT'S WHAT I USED TO WRITE THE C REST OF THIS CODE... C C LOAD PATTERN "A" C 400 DO 461 I=1, 8 IPROM(I)=I 461 CONTINUE C C LOAD PATTERN "B" AND "C" C IPROM(9)="177777 IPROM(10)=0 C C LOAD PATTERN "D" C IBIT=1 DO 452 I=11, 26 IPROM(I)=IBIT IBIT=IBIT*2 !WALK BIT LEFT 452 CONTINUE C DO 453 I=12, 26 !SET ALL CLEARED LSB'S IPROM(I)=IPROM(I)+1 453 CONTINUE C C LOAD PATTERN "E" C DO 455 I=27, 256 IPROM(I)=I 455 CONTINUE C C TEST CONTROL HERE ..... C WRITE(7,11) 403 FORMAT(X,' SELECT TEST MODE:') 401 FORMAT(X,' 1 - ENTIRE TAPE') 402 FORMAT(X,' 2 - SELECT START/STOP TIMES') 404 FORMAT(X,' Enter 1 or 2 (DEFAULT:1) > ',$) WRITE(7,403) WRITE(7,11) WRITE(7,401) WRITE(7,402) WRITE(7,11) WRITE(7,404) C READ(5,14) IANS IF(IANS .EQ. '2') GO TO 600 C C 44 IS LOC OF RT11 JSW. STAYS IN EFFECT UNTIL PROGRAM TERM. C CALL IPOKE("44,"10100.OR.IPEEK("44)) !ENABLE KEYBOARD INTERUPTS GO TO 1288 C C EDIT TEST PARAMETERS.. C 600 WRITE(7,11) 601 FORMAT(X,'Enter START time (MMM.SSSS DEFAULT:',F9.4,') > ',$) 602 FORMAT(X,'Enter STOP time (MMM.SSSS DEFAULT: 999.9999) > ',$) C 611 WRITE(7,601) FTIME 610 FORMAT(F9.4) 612 FORMAT(I4) FSTART=FTIME READ(5,610) FSTR IF(FSTR .EQ. 0.0000) GO TO 450 !IF JUST PRESSING ... IF(FSTR .GE. 1.0000) GO TO 449 !INPUT WITH A DECIMAL POINT.. FSTR=FSTR*10000 !ENTERING A NUMBER WITH NO 449 FSTART=FSTR !DECMIAL POINT RETURNS C !NUMBER / 10000 450 WRITE(7,602) READ(5,610) FSTP IF(FSTP .EQ. 0.0000) GO TO 451 IF(FSTP .GE. 1.0000) GO TO 448 FSTP=FSTP*10000 C 448 FSTOP=FSTP 451 IF(FSTOP .GT. FSTART) GO TO 500 TYPE *,'*** STOP TIME MUST BE GREATER THAN START TIME ***' WRITE(7,11) GO TO 611 C C C MOVE TAPE TO FSTART (COURSE SEARCH ONLY). C 500 IF(FTIME .GE. FSTART) GO TO 503 !NO READ HERE IF DEFAULT CALL MTREAD(IUNIT,IBYTES,IBLOCK(1)) !START TIME... IREC=IREC+1 CALL RSTAT(IFLAG,IREC,IREROR,IMTS,IUNIT) IF(IFLAG .EQ. 1) GO TO 1000 !TAPE EOF IF(IREROR .EQ. 1) GO TO 500 !TAPE READ ERROR C FTIM1=FLOAT(IBLOCK(2)) FTIM2=FLOAT(IBLOCK(3)) FTIM3=FLOAT(IBLOCK(4)) CALL JTIME(FTIM1,FTIM2,FTIM3,FTIME,IERR) C CALL LMSB(IBLOCK(ISFID),ICUR) IPREV=ICUR-ISUBF C GO TO 500 C 502 FORMAT(X,'START TIME REACHED AT RECORD ',I5,' TIME: ',F9.4) 503 WRITE(7,11) WRITE(7,502) IREC,FTIME WRITE(7,11) C C DO TWICE BECAUSE THERE ARE TWO PATHS TO MAIN LOOP. C CALL IPOKE("44,"10100.OR.IPEEK("44)) !ENABLE KEYBOARD INTR C C OPERATOR INFO.... C 1288 WRITE(7,11) TYPE *,'=============================================================' TYPE *,' RECOGNIZED KEY PRESSES:' TYPE *,' ' TYPE *,' D = DISABLE INDIVIDUAL ERROR REPORTING.' TYPE *,' S = SHOW ACCUMULATED ERROR COUNTERS.' TYPE *,' ^C^C = PROGRAM ABORT.' TYPE *,' ANY OTHER KEY = ENABLE INDIVIDUAL ERROR REPORTING.' TYPE *,'=============================================================' WRITE(7,11) WRITE(7,11) GO TO 301 !PROCESS FIRST RECORD. C C START OF MAIN PROCESSING LOOP....... C C CHECK SYS CON, READ NEXT TAPE RECORD C 300 ICHAR=ITTINR() !CHECK KEYBOARD IF(ICHAR .LT. 0) GO TO 304 !NO KEY WAS PRESSED CSTAT(1)=ICHAR !A KEY WAS PRESSED ISAVE=CHAR(1) !SAVE CHAR(1) CHAR(1)=ICHAR IF(CSTAT(1) .NE. 'S') GO TO 304 ISTAT=1 !RETURN TO 304 FLAG CHAR(1)=ISAVE !RESTORE CHAR(1) GO TO 1700 !SHOW COUNTERS C 304 CALL MTREAD(IUNIT,IBYTES,IBLOCK(1)) !READ A TAPE RECORD ICNUM=1 !RESET CHANNEL # IWORD=5 !POINT PAST FRAME HEADER IREC=IREC+1 !RECORD ACCUMULATOR IFRAME=1 !SUBFRAME COUNTER CALL RSTAT(IFLAG,IREC,IREROR,IMTS,IUNIT) !CHECK READ STATUS IF(IFLAG .EQ. 1) GO TO 1000 !TAPE EOF FLAG IF(IREROR .EQ. 1) GO TO 300 !TAPE READ ERROR C CALL LMSB(IBLOCK(ISFID),ICUR) !DECODE CURRENT SFID C FTIM1=FLOAT(IBLOCK(2)) !CONVERT TIME WORDS FTIM2=FLOAT(IBLOCK(3)) !TO REAL NUMBERS. FTIM3=FLOAT(IBLOCK(4)) CALL JTIME(FTIM1,FTIM2,FTIM3,FTIME,IERR) !DECODE TIME STAMP C IF(FTIME .GE. FSTOP) GO TO 1700 !CHECK FOR STOP TIME. C C IS NEXT SFID GOING TO ROLL OVER? C (7121 SFID WILL NEVER BE .GT. 255) C 301 ICHK=IPREV+ISUBF IF(ICHK .GE. 256) ICHK=ICHK-256 !ROLLS OVER TO 0. C IF(ICUR .EQ. ICHK) GO TO 399 !CHECK CURRENT SFID IPRT=ICUR !MOVE TO PRINT FIELD GO TO 360 !REPORT THE ERROR 399 IPREV=ICUR !STORE CURRENT SFID C C EXPECTED SFID IN CURRENT RECORD, ITTERIATE THRU SUBFRAMES C C CHECK FIRST SYNC (XFER CHECKS SECOND) C ICNUM=1 !DECOM CHANNEL # DO 332 I=1, ISUBF !CHECK SYNC WORDS C DO 333 J=0, ICHAN-1 IF(IBLOCK(IWORD+J) .NE. "147537) GO TO 370 !(HEX C5F5. SEE DUMP) 333 CONTINUE C IWORD=IWORD+IWDFR !POINT TO NEXT SUBFRAME IFRAME=IFRAME+1 332 CONTINUE C C CHECK PROM PATTERN C IWORD=5 IFRAME=0 C C NEXT SUBFRAME C 902 ILOOP=4 !PROM PATTERN STARTS AT 4 IF NEW SUBFRAME ICOUNT=ICHAN*3 !ICOUNT KEEPS ENABLES NEXT SUBFRAME IFRAME=IFRAME+1 !# OF SUBFRAMES COUNTER C C DEBUG. VERIFIES 2ND SFID, C 2ND PROM CYCLE IS PROCESSED C C IF(IFRAME .EQ. 2) IPROM(1)=9 C ICNUM=1 IWORD=IWORD+(ICHAN*3) !POINT TO START OF PATTERN C C NEXT PROM CYCLE C 901 DO 907 JJ=ILOOP, 256 C !COMPARE EACH CHANNEL DO 908 K=0, ICHAN-1 !TO PROM PATTERN C IF(IWORD .GT. ITAPE) GO TO 300 !NEXT RECORD IF(ICOUNT .EQ. IWDFR) GO TO 902 !NEXT SUBFRAME IF(IBLOCK(IWORD) .NE. IPROM(JJ)) GO TO 800 !REPORT THE ERROR ICOUNT=ICOUNT+1 !FOR NEXT SUBFRAME IWORD=IWORD+1 !TAPE BUFFER POINTER ICNUM=ICNUM+1 !CHANNEL # POINTER IF(ICNUM .GT. ICHAN) ICNUM=1 !ROLLS OVER AT ICHAN C 908 CONTINUE C 907 CONTINUE C ILOOP=1 !SUBSEQUENT PROM PATTERNS START AT 1 IN PROM BUFFER GO TO 901 !CHECK NEXT PATTERN C C C ERROR DISPLAY ROUTINES... C C SFID DIDN'T INCR BY STEP VALUE C 360 ISFERR(ICNUM)=ISFERR(ICNUM)+1 !INCREMENT CHANNEL C !ERROR COUNTER IF(CHAR(1) .EQ. 'D') GO TO 1363 !SET FROM 300 C 1362 CALL IHEX(IPRT,ININE,H1,H2,H3,H4) !DECODE SFID'S INTO CALL IHEX(ICHK,ININE,H5,H6,H7,H8) !ASCII HEX CHARACTERS. C 204 FORMAT(X,30X,' *** SFID ERROR ***') 201 FORMAT(X,30X,'ACTUAL SFID: ',4A1) 202 FORMAT(X,30X,'EXPECTED SFID: ',4A1) 205 FORMAT(X,30X,' CH # ',I1) 203 FORMAT(X,30X,'*** POSSIBLE MISSING DATA ***') C WRITE(7,11) WRITE(7,11) WRITE(7,204) WRITE(7,11) WRITE(7,372) IREC,IFRAME,FTIME WRITE(7,11) WRITE(7,201) H1,H2,H3,H4 WRITE(7,202) H5,H6,H7,H8 WRITE(7,205) ICNUM WRITE(7,11) WRITE(7,203) WRITE(7,11) WRITE(7,11) C 1363 IPREV=ICUR !SAVE CURRENT SFID GO TO 300 !TOP OF MAIN LOOP C C SYNC WORD ERROR IN FIRST SYNC WORD C 370 ISWERR(ICNUM)=ISWERR(ICNUM)+1 !INCREMENT ERROR COUNTER IF(CHAR(1) .EQ. 'D') GO TO 300 C 371 FORMAT(X,30X,'*** DATA PATTERN ERROR ***') 372 FORMAT(X,16X,'RECORD: ',I5,' SUBFRAME: ',I1,' TIME: ',F9.4) 375 FORMAT('+',4A1,' ',$) 378 FORMAT('+','ACTUAL: ',$) 379 FORMAT('+','EXPECTED: ',$) 376 FORMAT('+','CF5F ',$) 381 FORMAT('+','002C ',$) 380 FORMAT('+',' CH # ',$) 385 FORMAT('+',I1,' ',$) 396 FORMAT(X,30X,' *** SYNC WORD ERROR ***') 1222 WRITE(7,11) WRITE(7,371) WRITE(7,11) WRITE(7,372) IREC,IFRAME,FTIME WRITE(7,11) WRITE(7,11) C C ACTUAL C WRITE(7,378) DO 377 II=0, (ICHAN*2)-1 CALL IHEX(IBLOCK(IWORD+II),ININE,H1,H2,H3,H4) WRITE(7,375) H1,H2,H3,H4 377 CONTINUE WRITE(7,11) C C 'CF5F' x # OF CHANNELS C WRITE(7,379) DO 383 II=1, ICHAN WRITE(7,376) 383 CONTINUE C C '002C' x # OF CHANNELS C DO 384 II=1, ICHAN WRITE(7,381) 384 CONTINUE WRITE(7,11) C C ANNOTATE CHANNEL NUMBER C WRITE(7,380) DO 386 II=1, ICHAN*2 WRITE(7,385) ICNUM ICNUM=ICNUM+1 IF(ICNUM .GT. ICHAN) ICNUM=1 386 CONTINUE WRITE(7,11) WRITE(7,396) WRITE(7,11) C GO TO 300 C C UNEXPECTED PROM PATTERN C 800 IDPERR(ICNUM)=IDPERR(ICNUM)+1 !INCREMENT ERROR COUNTER IF(CHAR(1) .EQ. 'D') GO TO 300 C 1251 WRITE(7,11) IP=0 !PROM BUFFER PRINT POINTER WRITE(7,371) WRITE(7,11) WRITE(7,372) IREC,IFRAME,FTIME WRITE(7,11) WRITE(7,11) 801 FORMAT('+','WORD ',$) 802 FORMAT('+',' # ',$) 820 FORMAT('+',16X,$) 821 FORMAT('+',I4,' ',$) C C DISPLAY 10 WORDS AFTER FIRST OCCURANCE OF ERROR. C IF WE'RE GOING TO EXCEED END OF BUFFER, THEN DON'T... C C ONLY DISPLAY =< 10 WORDS SINCE MODS SP FOR EXAMPLE IS 9700 WORDS... C I=10 IF(IWORD .GE. ITAPE-10) I=ITAPE-10 !ITAPE = # WORDS IN TAPE REC C !IWORD = WORD # IN ERROR WRITE(7,820) DO 803 J=0, I-1 WRITE(7,801) 803 CONTINUE WRITE(7,11) WRITE(7,820) DO 804 J=0, I-1 WRITE(7,802) 804 CONTINUE WRITE(7,11) C C SHOW WORD #'S STARTING WITH FIRST ERROR C WRITE(7,820) DO 822 J=0, I-1 WRITE(7,821) IWORD+J 822 CONTINUE WRITE(7,11) WRITE(7,11) C C ACTUAL C WRITE(7,378) DO 805 J=0, I-1 CALL IHEX(IBLOCK(IWORD+J),ININE,H1,H2,H3,H4) WRITE(7,375) H1,H2,H3,H4 805 CONTINUE WRITE(7,11) C C DISPLAY PROM WORDS. JJ SUBSCRIPT FROM CHECK PROM C PATTERN CODE. KK LOOP OFFSET IF FIRST C ERROR OCCURED AFTER CHANNEL 1. C C C KI=ICNUM WRITE(7,379) DO 806 J=0, I-1 DO 809 KK=KI, ICHAN CALL IHEX(IPROM(JJ+J),ININE,H1,H2,H3,H4) WRITE(7,375) H1,H2,H3,H4 C C TERMINATE KK LOOP IF .GE. I C IP=IP+1 IF(IP .GE. I) GO TO 811 809 CONTINUE C C RESET KK LOOP TO START AT CH 1. C KI=1 806 CONTINUE C 811 WRITE(7,11) C C ANNOTATE DISPLAY WITH CORRESPONDING DECOM CHANNEL #.. C WRITE(7,380) DO 807 J=0, I-1 WRITE(7,385) ICNUM ICNUM=ICNUM+1 IF(ICNUM .GT. ICHAN) ICNUM=1 807 CONTINUE C WRITE(7,11) 808 FORMAT(X,30X,'*** UNEXPECTED PROM PATTERN ***') WRITE(7,808) WRITE(7,11) WRITE(7,11) C GO TO 300 C C END OF TEST COUNTERS.... C C C TAPE EOF C 1000 WRITE(7,11) 1002 FORMAT(X,25X,'*** TAPE EOF FILE MARKER SENSED ***') WRITE(7,1002) C C STOP TIME REACHED OR 'S' PRESSED AT TOP OF MAIN LOOP C 1700 WRITE(7,11) 1003 FORMAT(X,'LAST RECORD ',I6,' READ AT TIME ',F9.4) 1004 FORMAT('+','FIRST SFID ERROR OCCURED ON ',$) 1005 FORMAT('+','CHANNEL ',I1,I6,' TIMES.',$) 1006 FORMAT('+','FIRST SYNC ERROR OCCURED ON ',$) 1007 FORMAT('+','FIRST PROM ERROR OCCURED ON ',$) 1111 FORMAT('+',28X,$) C WRITE(7,1003) IREC,FTIME WRITE(7,11) WRITE(7,11) C C TOTAL SFID ERRORS BY CHANNEL. C WRITE(7,1004) WRITE(7,1005) 1,ISFERR(1) WRITE(7,11) DO 1011 I=2, ICHAN WRITE(7,1111) WRITE(7,1005) I,ISFERR(I) WRITE(7,11) 1011 CONTINUE WRITE(7,11) C C TOTAL SYNC WORD ERRORS BY CHANNEL. C WRITE(7,1006) WRITE(7,1005) 1,ISWERR(1) WRITE(7,11) DO 1012 I=2, ICHAN WRITE(7,1111) WRITE(7,1005) I,ISWERR(I) WRITE(7,11) 1012 CONTINUE WRITE(7,11) C C TOTAL PROM PATTERN ERRORS BY CHANNEL. C WRITE(7,1007) WRITE(7,1005) 1,IDPERR(1) WRITE(7,11) DO 1013 I=2, ICHAN WRITE(7,1111) WRITE(7,1005) I,IDPERR(I) WRITE(7,11) 1013 CONTINUE WRITE(7,11) C C DID WE GET HERE FROM 'S' AT TOP OF LOOP? C IF(ISTAT .EQ. 0) GO TO 999 ISTAT=0 !IF SO RESET FLAG GO TO 304 !AND KEEP PROCESSING C C REWIND TAPE UNITS C UNEXPLAINED ANOMOLY: IF NUWC, RI MTRWND ISSUED TO SOME SYSTEMS C AFTER LARGE BUFFER READS HAVE OCCURED, THEN MACHINE HALTS SOMETIMES.. C DIRECT MTC COMMAND REG BIT MANIPULATION AVOIDS. C I'M MOVING ON...... C C 999 CALL IPOKE("172522,"000017) CALL IPOKE("172522,"000417) CALL IPOKE("172522,"001017) CALL IPOKE("172522,"001417) WRITE(7,11) 998 FORMAT(X,30X,'*** MGOLD EXITING ***') C C WRITE(7,998) END