*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/06 10:46:58  mclareni
* Initial revision
*
*
#include "test_include/pilot.h"
      SUBROUTINE CQHEAD (IFLAGH,IHEAD,IHEAD2,INFORM,NAMES)

C-    Starting a new lot of check-data,  user called

#include "zebra/zbcd.inc"
#include "zebra/zunit.inc"
#include "test_include/cqc.inc"
#include "test_include/cqc1.inc"
C--------------    End CDE                             --------------
#if !defined(CERNLIB_F77TRARG)
      DIMENSION    IHEAD(9), IHEAD2(9), INFORM(9), NAMES(9)
#endif
#if defined(CERNLIB_F77TRARG)
      CHARACTER*(*) IHEAD, IHEAD2, INFORM, NAMES
#endif
      DIMENSION    MLP(100),      MPU(80)
      EQUIVALENCE (MLP(1),M(1)), (MPU(1),M(111))

      DIMENSION    ISYMB(9)
      SAVE         ISYMB
#if defined(CERNLIB_QHOLL)
      DATA  ISYMB  /4HA   , 4HF   , 4HI   , 4HO   , 4HH   ,
     +              4HL   , 4HB   , 4HJ   , 4HP   /
#endif

C-    IQCOPT(1)      Execution
C-    IQCOPT(2)      Listing
C-    IQCOPT(3)      Punching
C-    IQCOPT(4)      Comparing
C-    IQCOPT(5)      Stop on comparison failure
C-    IQCOPT(6)      Maximum output
C-    IQCOPT(7)      Check machine-dependent parameters also
C-    IQCOPT(8)      Tempor. inhibition of checking,
C-                   CQ is used for printing only

C-------           Digest header

C-    IFLAGH = -1  cancel
C-              0  same lot continued, change format or naming
C-              1  same lot cont., new sub-title, or format or naming
C-              2  next lot, same name
C-              3  new  lot, new  name

      IF (IQCOPT(1).EQ.0)    RETURN
      IF   (IFLAGH)          81, 19, 11
   11 IF   (IFLAGH-2)        12, 14, 13
   12 IF (IQCOPT(2).EQ.0)          GO TO 19
      GO TO 15

   13 CALL UCTOH1 (IHEAD,M(11),4)
      CALL UBUNCH (M(11),M(1), 4)
#if !defined(CERNLIB_QHOLL)
      CALL UCTOH ('A   F   I   O   H   L   B   J   P   ',ISYMB,4,36)
#endif
      IF (M(1).EQ.NAME)            GO TO 14
      NAME = M(1)
      NUM  = 0
   14 NUM  = NUM + 1
      M(1) = NAME
      M(2) = NUM

   15 CALL UCTOH1 (IHEAD2,M(3),50)
      N = IUFIND (IQDOT,M,3,51)
      IF (IFLAGH.GE.2)             GO TO 16
      WRITE (IQPRNT,9014) (M(J), J=3,N)
      GO TO 19

   16 WRITE (IQPRNT,9015) (M(J), J=1,N)
      WRITE (IQPRNT,9016)
      IF (IQTYPE.NE.0 .AND. IQTYPE.NE.IQPRNT)
     +                     WRITE (IQTYPE,9015) (M(J),J=1,N)
      IF (IQCOPT(3).NE.0)  WRITE (IQPNCH,9017) (M(J),J=1,N)

C------            Position check-cards

      IQCHEK= IQCOPT(4)
      IF (IQCOPT(4).EQ.0)          GO TO 18
      CALL CQPOS
      IF (IQCHEK.EQ.0)             GO TO 18
      WRITE (IQPRNT,9018)

C-------           Digest format

   18 JCRD = 1
   19 CALL UCTOH1  (INFORM,MUST,7)
      IF (MUST(1).EQ.IQDOT)        GO TO 41
      IF (MUST(1).EQ.IQMINS)       GO TO 41
      NENTR= 0
      CALL UCTOH1  ('(5H CQD.,I7,3H-  ', MLP(1), 17)
      CALL UCTOH1  ('(A4,2I3'          ,MPU(1), 7)
      JLP = 18
      JPU =  8

      DO 38  J=1,7
      IT = IUCOMP (MUST(J),ISYMB,9)
      IF (IT.EQ.0)                 GO TO 39
      NENTR = NENTR + 1
      KODEFM(NENTR)   = IT
      KODEFM(NENTR+1) = IT
      GO TO (21,22,23,24,25,26,27,28,29), IT

   21 CALL UCTOH1  (',4X,A4,6X'   ,MLP(JLP), 9)
      CALL UCTOH1  (',6X,A4'      ,MPU(JPU), 6)
      JLP = JLP  + 9
      JPU = JPU  + 6
      GO TO 38

   22 CALL UCTOH1  (',E14.3'      ,MLP(JLP), 6)
      CALL UCTOH1  (',E10.3'      ,MPU(JPU), 6)
      JLP = JLP  + 6
      JPU = JPU  + 6
      GO TO 38

   23 CALL UCTOH1  (',4X,I10'     ,MLP(JLP), 7)
      CALL UCTOH1  (',I10'        ,MPU(JPU), 4)
      JLP = JLP  + 7
      JPU = JPU  + 4
      GO TO 38

   24 CALL UCTOH1  (',4X,10I1'    ,MLP(JLP), 8)
      CALL UCTOH1  (',I10'        ,MPU(JPU), 4)
      JLP = JLP  + 8
      JPU = JPU  + 4
      GO TO 38

   25 CALL UCTOH1  (',4X,2A4,2X'  ,MLP(JLP),10)
      CALL UCTOH1  (',2X,2A4'     ,MPU(JPU), 7)
      JLP = JLP  + 10
      JPU = JPU  + 7
      GO TO 37

   26 CALL UCTOH1  (',I7,1X,A4,2X',MLP(JLP),12)
      CALL UCTOH1  (',I5,A4,1X'   ,MPU(JPU), 9)
      JLP = JLP  + 12
      JPU = JPU  + 9
      KODEFM(NENTR)   = 8
      GO TO 37

   27 CALL UCTOH1  (',2(3X,A4)'   ,MLP(JLP), 9)
      CALL UCTOH1  (',2(A4,1X)'   ,MPU(JPU), 9)
      JLP = JLP  + 9
      JPU = JPU  + 9
      GO TO 37

   28 CALL UCTOH1  (',2I7'        ,MLP(JLP), 4)
      CALL UCTOH1  (',2I5'        ,MPU(JPU), 4)
      JLP = JLP  + 4
      JPU = JPU  + 4
      GO TO 37

   29 CALL UCTOH1  (',2(2X,5I1)'  ,MLP(JLP), 10)
      CALL UCTOH1  (',2I5'        ,MPU(JPU), 4)
      JLP = JLP  + 10
      JPU = JPU  + 4

   37 NENTR = NENTR + 1
   38 CONTINUE

   39 MLP(JLP) = IQCLOS
      MPU(JPU) = IQCLOS
      CALL UH1TOC (MLP,MFLP,JLP)
      CALL UH1TOC (MPU,MFPU,JPU)
      IF (NENTR.EQ.0)  CALL ZFATAM ('NENTR=0 IN CQHEAD.')

C-------           Digest naming

   41 CALL UCTOH1 (NAMES,M(1),120)
      IF (M(1).EQ.IQDOT)           GO TO 89
      IF (M(1).EQ.IQMINS)          GO TO 89
      NAMEPR= 0
      CALL VZERO  (MACHFL,14)
      CALL VBLANK (NAMEVC,104)
      LENM = IUFIND (IQDOT,M,1,120) - 1
      LPUT = 7
      LK   = 0
      NH   = 0

   44 IF (NH.GE.NENTR)             GO TO 89
      LT   = LK
   45 IF (LT.GE.LENM)              GO TO 89
      LT   = LT + 1
      IF (M(LT).EQ.IQBLAN)         GO TO 45
      LK   = IUFIND (IQCOMA,M,LT,LENM)
      NP   = LK - LT

      NH   = NH + 1
      JH   = NH
      KOFM = KODEFM(NH)
      IF (KOFM-5)            52, 54, 53
   52 IF (KOFM.EQ.1)               GO TO 55
      LPUT = LPUT + 7
   53 LPUT = LPUT + 7
      JP   = MAX (1,LPUT-NP)
      NP   = LPUT - JP
      GO TO 58

   54 NH   = NH + 1
   55 JP   = LPUT + 4
      LPUT = LPUT + 14

   58 IF (NP.EQ.0)                 GO TO 44
      CALL UCOPY (M(LT),NAMEVC(JP),NP)
      IF (M(LT).EQ.IQSLAS)         GO TO 62
      IF (M(LT).NE.IQSTAR)         GO TO 44
      IFLM = 7
      GO TO 63

   62 IFLM = -7
   63 MACHFL(JH) = IFLM
      MACHFL(NH) = IFLM
      GO TO 44

   81 NAME = 0
   89 RETURN


 9014 FORMAT (1X/10H CQHEAD.  ,8X,4H--- ,60A1)
 9015 FORMAT (1X/10H CQHEAD.  ,A4,I3,5X,60A1)
 9016 FORMAT (10X,7(10H----------))
 9017 FORMAT (A4,I3,3H  0,70A1)
 9018 FORMAT (' CQHEAD.  Checked execution initiated.')
      END
*      ==================================================
#include "zebra/qcardl.inc"
