GEANT321/ggeom/gprotx.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:54  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPROTX(NUMB)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to print rotation matrices structure JROTM       *
  17 C.    *       NUMB     Rotation matrix number                          *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : <USER>, GPRINT                               *
  20 C.    *         Author  R.Brun  S.Giani *********                      *
  21 C.    *                                                                *
  22 C.    ******************************************************************
  23 C.
  24 #include "geant321/gcbank.inc"
  25 #include "geant321/gcunit.inc"
  26       CHARACTER*32 CHLINE,CHSTRI(50)
  27 C.
  28 C.    ------------------------------------------------------------------
  29 C.
  30       IF (JROTM.LE.0) GO TO 999
  31 C
  32       IF (NUMB  .EQ.0)THEN
  33          WRITE (CHMAIL,10000)
  34          CALL GMAIL(0,0)
  35          N1     = 1
  36          N2     = IQ(JROTM-2)
  37       ELSE
  38          N1     = ABS(NUMB)
  39          N2     = ABS(NUMB)
  40       ENDIF
  41 C
  42 *      IF(NUMB.GE.0) THEN
  43 *         WRITE (CHMAIL,1001)
  44 *         CALL GMAIL(0,1)
  45 *      ENDIF
  46 C
  47       DO 10 I=N1,N2
  48          JR = LQ(JROTM-I)
  49          IF (JR.LE.0) GO TO 10
  50 C
  51          IFLAG = Q(JR+10)
  52          CHLINE='Matrix Number='
  53          ILEN=LENOCC(CHLINE)+1
  54          CALL IZITOC(I,CHLINE(ILEN:))
  55          CHSTRI(1)=CHLINE
  56          CHLINE='RM(1,1)='
  57          ILEN=LENOCC(CHLINE)+1
  58 *      CALL IZRTOC(Q(JR+1),CHLINE(ILEN:))
  59          WRITE(CHLINE(ILEN:),10200)Q(JR+1)
  60          CHSTRI(2)=CHLINE
  61          CHLINE='RM(2,1)='
  62          ILEN=LENOCC(CHLINE)+1
  63 *      CALL IZRTOC(Q(JR+2),CHLINE(ILEN:))
  64          WRITE(CHLINE(ILEN:),10200)Q(JR+2)
  65          CHSTRI(3)=CHLINE
  66          CHLINE='RM(3,1)='
  67          ILEN=LENOCC(CHLINE)+1
  68 *      CALL IZRTOC(Q(JR+3),CHLINE(ILEN:))
  69          WRITE(CHLINE(ILEN:),10200)Q(JR+3)
  70          CHSTRI(4)=CHLINE
  71          CHLINE='RM(1,2)='
  72          ILEN=LENOCC(CHLINE)+1
  73 *      CALL IZRTOC(Q(JR+4),CHLINE(ILEN:))
  74          WRITE(CHLINE(ILEN:),10200)Q(JR+4)
  75          CHSTRI(5)=CHLINE
  76          CHLINE='RM(2,2)='
  77          ILEN=LENOCC(CHLINE)+1
  78 *      CALL IZRTOC(Q(JR+5),CHLINE(ILEN:))
  79          WRITE(CHLINE(ILEN:),10200)Q(JR+5)
  80          CHSTRI(6)=CHLINE
  81          CHLINE='RM(3,2)='
  82          ILEN=LENOCC(CHLINE)+1
  83 *      CALL IZRTOC(Q(JR+6),CHLINE(ILEN:))
  84          WRITE(CHLINE(ILEN:),10200)Q(JR+6)
  85          CHSTRI(7)=CHLINE
  86          CHLINE='RM(1,3)='
  87          ILEN=LENOCC(CHLINE)+1
  88 *      CALL IZRTOC(Q(JR+7),CHLINE(ILEN:))
  89          WRITE(CHLINE(ILEN:),10200)Q(JR+7)
  90          CHSTRI(8)=CHLINE
  91          CHLINE='RM(2,3)='
  92          ILEN=LENOCC(CHLINE)+1
  93 *      CALL IZRTOC(Q(JR+8),CHLINE(ILEN:))
  94          WRITE(CHLINE(ILEN:),10200)Q(JR+8)
  95          CHSTRI(9)=CHLINE
  96          CHLINE='RM(3,3)='
  97          ILEN=LENOCC(CHLINE)+1
  98 *      CALL IZRTOC(Q(JR+9),CHLINE(ILEN:))
  99          WRITE(CHLINE(ILEN:),10200)Q(JR+9)
 100          CHSTRI(10)=CHLINE
 101          CHLINE='Iflag='
 102          ILEN=LENOCC(CHLINE)+1
 103          CALL IZITOC(IFLAG,CHLINE(ILEN:))
 104          CHSTRI(11)=CHLINE
 105          CHLINE='Theta1='
 106          ILEN=LENOCC(CHLINE)+1
 107          CALL IZRTOC(Q(JR+11),CHLINE(ILEN:))
 108          CHSTRI(12)=CHLINE
 109          CHLINE='Phi1='
 110          ILEN=LENOCC(CHLINE)+1
 111          CALL IZRTOC(Q(JR+12),CHLINE(ILEN:))
 112          CHSTRI(13)=CHLINE
 113          CHLINE='Theta2='
 114          ILEN=LENOCC(CHLINE)+1
 115          CALL IZRTOC(Q(JR+13),CHLINE(ILEN:))
 116          CHSTRI(14)=CHLINE
 117          CHLINE='Phi2='
 118          ILEN=LENOCC(CHLINE)+1
 119          CALL IZRTOC(Q(JR+14),CHLINE(ILEN:))
 120          CHSTRI(15)=CHLINE
 121          CHLINE='Theta3='
 122          ILEN=LENOCC(CHLINE)+1
 123          CALL IZRTOC(Q(JR+15),CHLINE(ILEN:))
 124          CHSTRI(16)=CHLINE
 125          CHLINE='Phi3='
 126          ILEN=LENOCC(CHLINE)+1
 127          CALL IZRTOC(Q(JR+16),CHLINE(ILEN:))
 128          CHSTRI(17)=CHLINE
 129          CALL IGMESS(17,CHSTRI,'PRINT','P')
 130 *      WRITE (CHMAIL,1002) I,(Q(JR+J),J = 1,9),IFLAG,(Q(JR+J),J = 11,16)
 131 *      CALL GMAIL(0,0)
 132    10 CONTINUE
 133 C
 134 10000 FORMAT ('0',51('='),1X,'ROTATION MATRICES',2X,50('='))
 135 10100 FORMAT ('0','MATRIX',1X,'<',17('-'),' ROTATION MATRIX',1X,17('-')
 136      +,'>',' FLAG','  THET1','   PHI1','  THET2','   PHI2','  THET3'
 137      +,'   PHI3')
 138 * 1002 FORMAT (' ',I6,9F6.3,I5,6F7.2)
 139 10200 FORMAT (E12.5)
 140   999 END