GEANT321/gdraw/geditv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:29  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GEDITV(IMENU)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Edit volumes (only for interactive version)              *
  17 C.    *                                                                *
  18 C.    *       IMENU = option selected from menu (input)                *
  19 C.    *                                                                *
  20 C.    *    ==>Called by : GINC3                                        *
  21 C.    *       Author    P.Zanarini  *********                          *
  22 C.    *                                                                *
  23 C.    ******************************************************************
  24 C.
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcnum.inc"
  27 #include "geant321/gcunit.inc"
  28 #if defined(CERNLIB_USRJMP)
  29 #include "geant321/gcjump.inc"
  30 #endif
  31       CHARACTER*4 CHNAME,CHNEW,NAMDIV,NAMMOT
  32 C.
  33 C.    ------------------------------------------------------------------
  34 C.
  35       CALL UCTOH('    ',IBLA,4,4)
  36 C
  37       CALL KUPROC('Give volume NAME',CHNAME,NCH)
  38       CALL UCTOH(CHNAME,NAME,4,NCH)
  39       IVO=IUCOMP(NAME,IQ(JVOLUM+1),NVOLUM)
  40       IF (IVO.LE.0) GO TO 999
  41       JVO=LQ(JVOLUM-IVO)
  42 C
  43 C             Get IVOMOT,NIN,JIN
  44 C
  45       IF (IMENU.GE.4.AND.IMENU.LE.6) THEN
  46          CALL KUPROI('Give copy NR',NR)
  47          DO 20 IVOMOT=1,NVOLUM
  48             JVOMOT=LQ(JVOLUM-IVOMOT)
  49             NIN=Q(JVOMOT+3)
  50             IF (NIN.LT.0) THEN
  51                NIN=1
  52                IDIV=1
  53             ELSE
  54                IDIV=0
  55             ENDIF
  56             DO 10 IN=1,NIN
  57                JIN=LQ(JVOMOT-IN)
  58                IVOSON=Q(JIN+2)
  59                IF (IDIV.EQ.1) THEN
  60                   IF (IVOSON.EQ.IVO) GO TO 30
  61                ELSE
  62                   NRSON=Q(JIN+3)
  63                   IF (IVOSON.EQ.IVO.AND.NRSON.EQ.NR) GO TO 30
  64                ENDIF
  65    10       CONTINUE
  66    20    CONTINUE
  67          GO TO 999
  68    30    CONTINUE
  69       ENDIF
  70 C
  71 C             Get IVOMOT,JDIV
  72 C
  73       IF (IMENU.GE.7.AND.IMENU.LE.8) THEN
  74          DO 40 IVOMOT=1,NVOLUM
  75             JVOMOT=LQ(JVOLUM-IVOMOT)
  76             NIN=Q(JVOMOT+3)
  77             IF (NIN.GE.0) GO TO 40
  78             JDIV=LQ(JVOMOT-1)
  79             IVOSON=Q(JDIV+2)
  80             IF (IVOSON.EQ.IVO) GO TO 50
  81    40    CONTINUE
  82          GO TO 999
  83    50    CONTINUE
  84       ENDIF
  85 C
  86       IF (IMENU.EQ.1) THEN
  87 C
  88 C             Modify shape parameters PAR given by GSVOLU
  89 C
  90          NP=Q(JVO+5)
  91          DO 60 I=1,NP
  92             PAR=Q(JVO+6+I)
  93             WRITE (CHMAIL,1100) I,PAR
  94             CALL GMAIL(0,0)
  95             CALL KUPROR('Give new value',PAR)
  96             Q(JVO+6+I)=PAR
  97    60    CONTINUE
  98
  99 C
 100       ELSE IF (IMENU.EQ.2) THEN
 101 C
 102 C             Modify NAME given by GSVOLU
 103 C
 104          CALL KUPROC('Give new NAME',CHNEW,NCH)
 105          NEWNAM=IBLA
 106          CALL UCTOH(CHNEW,NEWNAM,4,NCH)
 107          IQ(JVOLUM+IVO)=NEWNAM
 108 C
 109       ELSE IF (IMENU.EQ.3) THEN
 110 C
 111 C             Delete NAME given by GSVOLU
 112 C
 113    70    CONTINUE
 114          DO 90 IVOMOT=1,NVOLUM
 115             JVOMOT=LQ(JVOLUM-IVOMOT)
 116             NIN=Q(JVOMOT+3)
 117             IF (NIN.LT.0) NIN=1
 118             DO 80 IN=1,NIN
 119                JIN=LQ(JVOMOT-IN)
 120                IVOSON=Q(JIN+2)
 121                NR=Q(JIN+3)
 122                IF (IVOSON.EQ.IVO) GO TO 100
 123    80       CONTINUE
 124    90    CONTINUE
 125          GO TO 110
 126 C
 127   100    CONTINUE
 128 C
 129 C             Unlink NAME,NR
 130 C
 131 #if !defined(CERNLIB_USRJMP)
 132          CALL GUNLIV(IVO,NR,IVOMOT)
 133 #endif
 134 #if defined(CERNLIB_USRJMP)
 135          CALL JUMPT3(JUNLIV,IVO,NR,IVOMOT)
 136 #endif
 137          WRITE (CHMAIL,1000) NAME
 138          CALL GMAIL(0,0)
 139  1000   FORMAT (' *** GEDITV: ',A4,' UNLINKED')
 140 C
 141 C             Try another link
 142 C
 143          GO TO 70
 144 C
 145   110    CONTINUE
 146 C
 147 C             No more links; now delete NAME
 148 C
 149          IQ(JVOLUM+IVO)=IBLA
 150 C
 151       ELSE IF (IMENU.EQ.4) THEN
 152 C
 153 C             Unlink NAME,NR given by GSPOS/GSDIV
 154 C
 155 #if !defined(CERNLIB_USRJMP)
 156          CALL GUNLIV(IVO,NR,IVOMOT)
 157 #endif
 158 #if defined(CERNLIB_USRJMP)
 159          CALL JUMPT3(JUNLIV,IVO,NR,IVOMOT)
 160 #endif
 161 C
 162       ELSE IF (IMENU.EQ.5) THEN
 163 C
 164 C             Modify X0,Y0,Z0 of NAME,NR given by GSPOS
 165 C
 166          X0=Q(JIN+5)
 167          Y0=Q(JIN+6)
 168          Z0=Q(JIN+7)
 169          CALL KUPROR('Give X0',X0)
 170          CALL KUPROR('Give Y0',Y0)
 171          CALL KUPROR('Give Z0',Z0)
 172          Q(JIN+5)=X0
 173          Q(JIN+6)=Y0
 174          Q(JIN+7)=Z0
 175 C
 176       ELSE IF (IMENU.EQ.6) THEN
 177 C
 178 C             Modify IROT of NAME,NR given by GSPOS
 179 C
 180          IROT=Q(JIN+4)
 181          CALL KUPROI('Give IROT',IROT)
 182          Q(JIN+4)=IROT
 183 C
 184       ELSE IF (IMENU.EQ.7.OR.IMENU.EQ.8) THEN
 185 C
 186          IF (IMENU.EQ.7) THEN
 187 C
 188 C             Modify NDIV given by GSDIV
 189 C
 190             NDIV=Q(JDIV+3)
 191             CALL KUPROI('Give NDIV',NDIV)
 192             Q(JDIV+3)=NDIV
 193 C
 194          ELSE
 195 C
 196 C             Modify IAXIS given by GSDIV
 197 C
 198             IAXIS=Q(JDIV+1)
 199             CALL KUPROI('Give IAXIS',IAXIS)
 200             Q(JDIV+1)=IAXIS
 201 C
 202          ENDIF
 203 C
 204 C             Unlink and delete NAME
 205 C
 206          Q(JVOMOT+3)=0
 207          CALL MZDROP(IXCONS,LQ(JVOMOT-1),' ')
 208          JV = LQ(JVOLUM-IVOMOT)
 209          CALL MZPUSH(IXCONS,JV,-1,0,'I')
 210          CALL UHTOC(IQ(JVOLUM+IVO),4,NAMDIV,4)
 211          IQ(JVOLUM+IVO)=IBLA
 212 C
 213 C             Redivide (division is now at NVOLUM-th position)
 214 C
 215          CALL UHTOC(IQ(JVOLUM+IVOMOT),4,NAMMOT,4)
 216          NDIV=Q(JDIV+3)
 217          IAXIS=Q(JDIV+1)
 218          CALL GSDVN(NAMDIV,NAMMOT,NDIV,IAXIS)
 219 C
 220 C             Swap new division with old one (links + names)
 221 C
 222          CALL DZSWAP(IXCONS,LQ(JVOLUM-NVOLUM),LQ(JVOLUM-IVO),' ')
 223          IQ(JVOLUM+IVO)=IQ(JVOLUM+NVOLUM)
 224          IQ(JVOLUM+NVOLUM)=IBLA
 225          JVOMOT=LQ(JVOLUM-IVOMOT)
 226          JDIV=LQ(JVOMOT-1)
 227          Q(JDIV+2)=IVO
 228          CALL UCTOH(NAMDIV,IQ(JVOLUM+IVO),4,4)
 229 C
 230 C             Delete definitely old division
 231 C
 232          CALL MZDROP(IXCONS,LQ(JVOLUM-NVOLUM),' ')
 233          CALL MZPUSH(IXCONS,JVOLUM,-1,-1,'I')
 234          NVOLUM=NVOLUM-1
 235 C
 236       ENDIF
 237 C
 238  1100 FORMAT('  PAR(',I2,') =',F10.3)
 239   999 RETURN
 240       END