This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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