GEANT321/gdraw/gdfspc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1998/09/25 09:23:48  mclareni
   6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:23  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GDFSPC(NAME,ISORT,INTER)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *       Draw a set of full specification of KNAME                *
  20 C.    *       and all its sons (not duplicated);                       *
  21 C.    *       if ISORT=1 plots will be alfabetically sorted;           *
  22 C.    *       if INTER=1 it will prompt the user at each plot          *
  23 C.    *                                                                *
  24 C.    *    ==>Called by : <USER>, <GXINT>                              *
  25 C.    *       Author : P.Zanarini   *********                          *
  26 C.    *                                                                *
  27 C.    ******************************************************************
  28 C.
  29 #include "geant321/gcunit.inc"
  30 #include "geant321/gcdraw.inc"
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gcnum.inc"
  33       LOGICAL MORE
  34       CHARACTER*4 CHKEY,NAME,NAME1,NAMOLD
  35 C.
  36 C.    ------------------------------------------------------------------
  37 C.
  38 C             Is NAME an existing volume ?
  39 C
  40       CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
  41       IF (IVO.LE.0) GO TO 999
  42 C
  43 C             Build tree structure using view bank 11
  44 C
  45       IVTREE=NKVIEW+1
  46       CALL UCTOH (NAME, IROOT, 4, 4)
  47       CALL GDTR0 (IVTREE, IROOT, 0, IER)
  48       IF (IER.NE.0) GO TO 999
  49 C
  50       JN=1
  51 C
  52       DO 10 J=2,NUMND1
  53          IQ(JSCA1+J)=0
  54    10 CONTINUE
  55 C
  56       IQ(JSCA1+1)=JN
  57       JMAX=1
  58       J=1
  59    20 CONTINUE
  60       JX=IQ(JXON1+IQ(JSCA1+J))
  61    30 IF (JX.EQ.0) GO TO 40
  62       JMAX=JMAX+1
  63       IQ(JSCA1+JMAX)=JX
  64       JX=IQ(JBRO1+JX)
  65       GO TO 30
  66    40 J=J+1
  67       IF (J.LE.JMAX) GO TO 20
  68 C
  69       DO 50 I=1,JMAX
  70          IQ(JSCA1+I)=IQ(JNAM1+IQ(JSCA1+I))
  71    50 CONTINUE
  72 C
  73       IF (ISORT.NE.1) GO TO 110
  74 #if defined(CERNLIB_VAX)||defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
  75 C
  76 C             Reverse bytes of word to be sorted
  77 C
  78       CALL VXINVB(IQ(JSCA1+1),JMAX)
  79 #endif
  80 C
  81 C             Perform bubble sort on names in ISCA1 (ascending order)
  82 C
  83       NEXLAS=JMAX-1
  84       MORE=.TRUE.
  85 C
  86    70 CONTINUE
  87       IF (.NOT.MORE) GO TO 90
  88       MORE=.FALSE.
  89       DO 80  I=1,NEXLAS
  90          IF (IQ(JSCA1+I).LE.IQ(JSCA1+I+1)) GO TO 80
  91          ITEMP=IQ(JSCA1+I)
  92          IQ(JSCA1+I)=IQ(JSCA1+I+1)
  93          IQ(JSCA1+I+1)=ITEMP
  94          MORE=.TRUE.
  95    80 CONTINUE
  96       GO TO 70
  97 C
  98    90 CONTINUE
  99 #if defined(CERNLIB_VAX)||defined(CERNLIB_MSDOS)||defined(CERNLIB_WINNT)||(defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC))
 100 C
 101 C             Reverse bytes of words that have been sorted
 102 C
 103       CALL VXINVB(IQ(JSCA1+1),JMAX)
 104 #endif
 105 C
 106 C             Draw specs stored in ISCA1
 107 C
 108   110 CONTINUE
 109       NAMOLD=' '
 110       DO 120 I=1,JMAX
 111          KNAME=IQ(JSCA1+I)
 112          CALL UHTOC(KNAME,4,NAME1,4)
 113          IF (NAME1.EQ.NAMOLD) GO TO 120
 114          NAMOLD=NAME1
 115          WRITE (CHMAIL,1000) NAME1
 116          CALL GMAIL(0,0)
 117          CHKEY=' '
 118          NCH=0
 119          IF (INTER.EQ.1) THEN
 120             CALL IGTERM
 121             CALL KUALFA
 122             CALL KUPROC('<CR>, NO, STOP',CHKEY,NCH)
 123             IF (CHKEY.EQ.'STOP') GO TO 999
 124          ENDIF
 125          CALL ICLRWK(0,0)
 126          IF (NCH.GT.0) GO TO 120
 127          CALL GDSPEC(NAME1)
 128   120 CONTINUE
 129 C
 130 C             Delete tree structure on view bank 11
 131 C
 132       CALL GDTR99(IVTREE)
 133 C
 134  1000 FORMAT (' DRAWING SPEC OF ',A4)
 135   999 RETURN
 136       END