C File name: UNMACD.FOR !Rev 8301.301 C C This module provides diagnostic support for UNMAC. C C***************************************************************** C SUBROUTINE Q DEBUG !Rev 8301.301 C COMMON /LUN/ LUN IN, LUN OUT, LUN TT COMMON /REWIND/ RWND FL, DO RWND LOGICAL RWND FL, DO RWND COMMON /DEBUG/ DEBUG(50) LOGICAL DEBUG C WRITE (LUN TT,10) 10 FORMAT(//' UNMAC has been compiled with diagnostic support.'/ 1 ' You may selectively turn on diagnostics for some of the'/ 2 ' routines in the program.'//) C DO 20 I=1,50 DEBUG(I) = .FALSE. 20 CONTINUE RWND FL = .FALSE. C WRITE (LUN TT,30) 30 FORMAT(' Do you want any diagnostics? ',$) IF (NO()) RETURN WRITE (LUN TT,40) 40 FORMAT(' Diagnostics for UNMACR routines? ',$) IF (NO()) GO TO 50 CALL DQUERY (1,'MD INIT') CALL DQUERY (2,'NXT MOD') 50 CONTINUE C WRITE (LUN TT,60) 60 FORMAT (' Diagnostics for UNMAC0 routines? ',$) IF (NO()) GO TO 70 CALL DQUERY (3,'LIB FND') CALL DQUERY (4,'RT LIB') CALL DQUERY (5,'RSX LIB') 70 CONTINUE C DEBUG(10) = .FALSE. WRITE (LUN TT,110) 110 FORMAT (' Diagnostics for UNMACI routines? ',$) IF (NO()) GO TO 120 DEBUG(10) = .TRUE. CALL DQUERY (11,'GET BLK') CALL DQUERY (12,'RD NEXT') CALL DQUERY (13,'RD NAME') CALL DQUERY (14,'RD WORD') CALL DQUERY (15,'RD BYTE') 120 CONTINUE C WRITE (LUN TT,210) 210 FORMAT (' Diagnostics for UNMAC1 routines? ',$) IF (NO()) GO TO 220 CALL DQUERY (21,'PASS 1 ') CALL DQUERY (22,'GSD 1 ') CALL DQUERY (23,'TXT 1 ') CALL DQUERY (24,'RLD 1 ') 220 CONTINUE C WRITE (LUN TT,310) 310 FORMAT(' Diagnostics for UNMAC2 routines? ',$) IF (NO()) GO TO 320 CALL DQUERY (31,'PASS 2 ') CALL DQUERY (32,'GSD 2 ') CALL DQUERY (33,'TXT ') CALL DQUERY (34,'RLD ') CALL DQUERY (35,'BUILD ') 320 CONTINUE C WRITE (LUN TT,400) 400 FORMAT (' Do you want to REWIND after each module? ',$) RWND FL = .NOT. NO() C RETURN END SUBROUTINE DQUERY (N,STRING) !Rev 8301.121 BYTE OUT(10),STRING(1) COMMON /DEBUG/ DEBUG(50) LOGICAL DEBUG,NO COMMON /LUN/ LUN IN, LUN OUT, LUN TT C DO 10 I=1,8 LCHAR = STRING(I) IF (LCHAR.EQ.0) GO TO 20 OUT(I) = LCHAR K = I 10 CONTINUE C 20 OUT(K+1) = '?' OUT(K+2) = ' ' K = K+2 C DO 40 I=1,K WRITE (LUN TT, 30) OUT(I) 30 FORMAT (1H+,A1,$) 40 CONTINUE C IF (NO()) GO TO 50 DEBUG(N) = .TRUE. 50 CONTINUE C RETURN END LOGICAL FUNCTION NO(IDUMMY) !Rev 8205.181 C COMMON /LUN/ LUN IN, LUN OUT, LUN TT C BYTE IANS C READ (LUN TT,10) IANS 10 FORMAT (A1) NO = IANS.NE.'Y' C RETURN END