* * $Id: dzdata.F,v 1.1.1.1 1996/03/06 10:47:06 mclareni Exp $ * * $Log: dzdata.F,v $ * Revision 1.1.1.1 1996/03/06 10:47:06 mclareni * Zebra * * *----------------------------------------------------------- #include "zebra/pilot.h" #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT)) #include "zebra/debugvf1.inc" #endif SUBROUTINE DZDATA (CHTEXT) SAVE IHOLE #include "zebra/mqsys.inc" #include "zebra/qequ.inc" #include "zebra/mzcn.inc" #include "zebra/zmach.inc" #include "zebra/zunit.inc" #include "zebra/dzc1.inc" PARAMETER ( MLITXQ = 6 ) PARAMETER ( NLINEQ = 24 ) PARAMETER ( MLLKBQ = 17 , MLLKEQ = 24 ) PARAMETER ( MLDRQ = 10 ) PARAMETER ( MLIDBQ = 11 , MLIDEQ = 14 ) PARAMETER ( NENLNQ = 5 ) PARAMETER ( NLNGRQ = 10 ) CHARACTER*(*) CHTEXT CHARACTER CHROUT*(*),CHSTAK*6 ,CTEXT1*1,CSTART*3 PARAMETER (CHROUT = 'DZDATA') DATA IHOLE /4H*HO*/ #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT)) #include "zebra/debugvf2.inc" #endif CHSTAK = CQSTAK(MCQSIQ:) CQSTAK(MCQSIQ:) = CHROUT IF (NDW.LE.0) GO TO 999 CTEXT1 = CHTEXT(1:1) CSTART = ' ' IF (LEN(CHTEXT).GT.1) THEN IF (CTEXT1.EQ.'+') CSTART = CHTEXT(2:) ENDIF 9 IF (CHTEXT.NE.CDUMMQ.AND.CTEXT1.NE.'+') THEN CQLINE = ' '//CHTEXT CQLINE(60:) = '--------------------' CALL DZTEXT(0,CDUMMQ,1) ENDIF JDST = 1 10 JDL = JDST 12 NSAME= IUSAME (LQ(LBASE+KQS+1),JDL,NDW,30,JSAME) JDL = JSAME + NSAME - 1 IF (JDL.NE.NDW) JDL=10*(JDL/10) IF (JSAME.NE.JDST) GO TO 20 16 J = LBASE + JSAME N = JDL+1 - JSAME WRITE(CQLINE,'(T30,''====='',I9,'' WORDS from'',I9, X '' to'',I9,'' all contain'',Z18)') N,JSAME,JDL,LQ(J+KQS) CALL DZTEXT(0,CDUMMQ,1) IF (JDL.GE.NDW) GO TO 999 JDST= JDL + 1 GO TO 10 20 JDE = JSAME - 1 N = JDE - JDST NPG = N/NENLNQ + 1 IF (NPG.GT.NLNGRQ) NPG = NLNGRQ NPG1= NPG + 1 NGRV= N/(NPG*NENLNQ) + 1 CALL ZPAGE (IQPRNT,NPG1) NGRP = (NQLNOR-NQUSED)/NPG1 NGRV = MIN(NGRV,NGRP) NSTEP= NPG*NGRV JDE = MIN(NDW,JDST-1+NENLNQ*NSTEP) IF (JDE.NE.NDW.AND.JDE.GE.JDL) GO TO 12 JSAME= MAX(JDE+1,JSAME) NPG = MIN(NPG,JDE+1-JDST) DO 300 JGROUP=1,NGRV IF (JGROUP.GT.1) CALL ZPAGE(IQPRNT,1) CQLINE = ' '//CSTART ILINE = MLITXQ DO 200 JLINE=1,NPG JD = JDST DO 100 JWORD=1,NENLNQ IF (JD.GT.JDE) GO TO 100 CALL DZTYP IPBEG = ILINE + 1 IPEND = ILINE + NLINEQ IF (JTYP.LT.0) THEN WRITE(CQLINE(ILINE+1:ILINE+6),'(I6)') JD+IBASE IF (IQFOUL.EQ.0) THEN IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.1) I CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '(' IF (IQND.LT.0) IQID = IHOLE WRITE W (CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ),'(A4)')IQID ELSEIF (IQFOUL.GT.0) THEN CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '?' CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ) = '****' ELSE CQLINE(ILINE+MLDRQ:ILINE+MLDRQ) = '?' CQLINE(ILINE+MLIDBQ:ILINE+MLIDEQ) = '-' ENDIF WRITE W (CQLINE(ILINE+MLLKBQ:ILINE+MLLKEQ),'(I8)') W LQ(KQS+LBASE+JD) ILINE = ILINE + NLINEQ ELSEIF (JTYP.EQ.1) THEN #if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBX)||defined(CERNLIB_QMND3)||defined(CERNLIB_QMCRY)||defined(CERNLIB_QMDOS) WRITE(CQLINE(IPBEG:IPEND),'(I6,1X,''Z'',Z16)') #endif #if (!defined(CERNLIB_QMIBM))&&(!defined(CERNLIB_QMIBX))&&(!defined(CERNLIB_QMND3))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMDOS)) WRITE(CQLINE(IPBEG:IPEND),'(I6,1X,''Z'',Z16.16)') #endif W JD+IBASE,LQ(KQS+LBASE+JD) ELSEIF (JTYP.EQ.2) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,I18)') W JD+IBASE,LQ(KQS+LBASE+JD) ELSEIF (JTYP.EQ.3) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,8X,F10.1)') W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ) ELSEIF (JTYP.EQ.4) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,6X,F12.3)') W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ) ELSEIF (JTYP.EQ.5) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,2X,F16.7)') W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ) ELSEIF (JTYP.EQ.6) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,2X,E16.7)') W JD+IBASE,Q(KQS+LBASE+JD-NOFLIQ) ELSEIF (JTYP.EQ.7) THEN WRITE(CQLINE(IPBEG:IPEND),'(I6,13X,''"'',A4)') W JD+IBASE,LQ(KQS+LBASE+JD) ENDIF ILINE = IPEND JD = JD + NSTEP 100 CONTINUE CALL DZTEXT(0,CDUMMQ,1) CQLINE = ' '//CSTART ILINE = MLITXQ 200 JDST= JDST + 1 300 CONTINUE JDST= JDE + 1 IF (JDST.LT.JSAME) GO TO 20 IF (JDST.LT.NDW) GO TO 16 999 CQSTAK(MCQSIQ:) = CHSTAK END