GEANT321/ggeom/gfupar.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFUPAR(JVO,JIN,NPAR,NATT,PAR,ATT)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    ROUTINE TO FETCH USER PARAMETERS AND ATTRIBUTES FOR         *
  17 C.    *    THE VOLUME FROM VOLUME ADDRESS JVO AND IF GSPOSP TYPE       *
  18 C.    *    VERSION DEFINED BY IN ADDRESS JIN.                          *
  19 C.    *                                                                *
  20 C.    *    ==>Called by : <USER>                                       *
  21 C.    *         Author  P.Zanarini  *********                          *
  22 C.    *                                                                *
  23 C.    ******************************************************************
  24 C.
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcunit.inc"
  27 #include "geant321/gconsp.inc"
  28       DIMENSION PAR(*),ATT(*)
  29 C.
  30 C.               ---------------------------------------
  31 C.
  32       NPAR=Q(JVO+5)
  33       NATT=Q(JVO+6)
  34       ISH=Q(JVO+2)
  35       JPAR=JVO+7
  36       JATT=JVO+7+NPAR
  37 C
  38       IF(NPAR.GT.0) GO TO 10
  39       IF(NPAR.NE.0) GO TO 900
  40       IF(JIN.LE.0) GO TO 910
  41 C
  42       JPAR=JIN+9
  43       NPAR=Q(JPAR)
  44       JPAR=JPAR+1
  45 C
  46    10 CONTINUE
  47 C
  48 C             NPAR : 30 ---> 12
  49 C
  50       IF(ISH.EQ.28) NPAR=12
  51 C
  52       IF(NPAR.LE.0) GO TO 920
  53       CALL UCOPY(Q(JPAR),PAR,NPAR)
  54       CALL UCOPY(Q(JATT),ATT,NATT)
  55 C
  56       IF(ISH.NE.4) GO TO 20
  57 C
  58 C              TRAPEZOID
  59 C
  60       PH=90.0
  61       IF(PAR(2).NE.0.)PH=ATAN2(PAR(3),PAR(2))*RADDEG
  62       TT=PAR(2)**2+PAR(3)**2
  63       IF(TT.GT.0.0) TT=SQRT(TT)
  64       PAR(2)=ATAN(TT)*RADDEG
  65       IF(PH.LT.0.0) PH=PH+360.0
  66       PAR(3)=PH
  67       PAR(7)=ATAN(PAR(7))*RADDEG
  68       IF(PAR(7).GT.90.0) PAR(7)=PAR(7)-180.0
  69       PAR(11)=ATAN(PAR(11))*RADDEG
  70       IF(PAR(11).GT.90.0) PAR(11)=PAR(11)-180.0
  71 C
  72       GO TO 99
  73    20 CONTINUE
  74 C
  75       IF(ISH.NE.10) GO TO 99
  76 C
  77 C              PARALLELEPIPED.
  78 C
  79       PH=90.0
  80       IF(PAR(5).NE.0.)PH=ATAN2(PAR(6),PAR(5))*RADDEG
  81       TT=PAR(5)**2+PAR(6)**2
  82       IF(TT.GT.0.0) TT=SQRT(TT)
  83       PAR(4)=ATAN(PAR(4))*RADDEG
  84       IF(PAR(4).GT.90.0) PAR(4)=PAR(4)-180.0
  85       PAR(5)=ATAN(TT)*RADDEG
  86       IF(PH.LT.0.0) PH=PH+360.0
  87       PAR(6)=PH
  88 C
  89       GO TO 99
  90 C
  91   900 CONTINUE
  92 C
  93       WRITE(CHMAIL,1000) NPAR
  94       CALL GMAIL(0,0)
  95  1000 FORMAT(' **** ERROR IN GFUPAR - NPAR FROM JVO =',I5,' LE 0 ****')
  96 C
  97       GO TO 99
  98   910 CONTINUE
  99 C
 100       WRITE(CHMAIL,1010) JIN
 101       CALL GMAIL(0,0)
 102  1010 FORMAT(' **** ERROR IN GFUPAR - NPAR FROM VOL 0 AND JIN ='
 103      +,I12,' IS LE 0 ****')
 104 C
 105       GO TO 99
 106   920 CONTINUE
 107 C
 108       WRITE(CHMAIL,1020) NPAR
 109       CALL GMAIL(0,0)
 110  1020 FORMAT(' **** ERROR IN GFUPAR - NPAR FROM JIN =',I5,' LE 0 ****')
 111 C
 112    99 CONTINUE
 113       END