GEANT321/gdraw/gdcgem.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:20  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.25  by  S.Giani
  11 *-- Author :
  12 *
  13       SUBROUTINE GDCGEM(VRPX,VRPY,VRPZ,VUPX,VUPY,VUPZ,VPNX, VPNY,VPNZ,
  14      +IERR,AMTR)
  15 C.
  16 C.    ******************************************************************
  17 C.    *                                                                *
  18 C.    *                                                                *
  19 C.    *  This subroutine evaluates the Viewing Matrix with the same    *
  20 C.    *  algorithm and with the same input parameters as subroutine    *
  21 C.    *  GEVVM of GKS3D.                                               *
  22 C.    *                                                                *
  23 C.    *  Input Parameters:                                             *
  24 C.    *                                                                *
  25 c.    *       VRPX,VRPY,VRPZ,VUPX,VUPY,VUPZ,VPNX, VPNY,VPNZ            *
  26 C.    *                                                                *
  27 C.    *  Output Parameters:                                            *
  28 C.    *                                                                *
  29 C.    *       IERR,AMTR(4,4)                                           *
  30 C.    *                                                                *
  31 C.    *                                                                *
  32 C.    *       Called by :  GDCGVW                                      *
  33 C.    *                                                                *
  34 C.    *       Author : J.Salt     *********                            *
  35 C.    *                                                                *
  36 C.    ******************************************************************
  37 C.
  38 #include "geant321/gcunit.inc"
  39 *
  40       DIMENSION VRPT(3),VUPT(3),VPNT(3)
  41       DIMENSION AMTR(4,4)
  42 *
  43       IERR=0
  44       VRPT(1)=VRPX
  45       VRPT(2)=VRPY
  46       VRPT(3)=VRPZ
  47       VUPT(1)=VUPX
  48       VUPT(2)=VUPY
  49       VUPT(3)=VUPZ
  50       VPNT(1)=VPNX
  51       VPNT(2)=VPNY
  52       VPNT(3)=VPNZ
  53 *
  54       VLEN=SQRT(VPNT(1)**2+VPNT(2)**2+VPNT(3)**2)
  55       AMTR(3,1)=VPNT(1)/VLEN
  56       AMTR(3,2)=VPNT(2)/VLEN
  57       AMTR(3,3)=VPNT(3)/VLEN
  58 *
  59 *    First Row (U-axis)  := Unit Vector Perpendicular to VUP and VPN
  60 *
  61       UX=VUPT(2)*VPNT(3)-VUPT(3)*VPNT(2)
  62       UY=VUPT(3)*VPNT(1)-VUPT(1)*VPNT(3)
  63       UZ=VUPT(1)*VPNT(2)-VUPT(2)*VPNT(1)
  64       ULEN=SQRT(UX**2+UY**2+UZ**2)
  65 *
  66 *     LENGTH=0. <=> VUP and VPN are collinear
  67 *
  68       IF(ULEN.EQ.0)THEN
  69          WRITE(CHMAIL,10000)
  70          CALL GMAIL(0,0)
  71       ELSE
  72          AMTR(1,1)=UX/ULEN
  73          AMTR(1,2)=UY/ULEN
  74          AMTR(1,3)=UZ/ULEN
  75       ENDIF
  76 *
  77 *       2ND ROW(V-AXIS)  := UNIT VECTOR PERPENDICULAR TO U- AND N-AXIS
  78 *
  79       AMTR(2,1)=AMTR(3,2)*AMTR(1,3)-AMTR(1,2)*AMTR(3,3)
  80       AMTR(2,2)=AMTR(3,3)*AMTR(1,1)-AMTR(1,3)*AMTR(3,1)
  81       AMTR(2,3)=AMTR(3,1)*AMTR(1,2)-AMTR(1,1)*AMTR(3,2)
  82 *
  83 *      4TH COLUMN : = TRANSLATION FACTORS
  84 *
  85       AMTR(1,4)=-(VRPT(1)*AMTR(1,1)+VRPT(2)*AMTR(1,2)+ VRPT(3)*
  86      +AMTR(1,3))
  87       AMTR(2,4)=-(VRPT(1)*AMTR(2,1)+VRPT(2)*AMTR(2,2)+ VRPT(3)*
  88      +AMTR(2,3))
  89       AMTR(3,4)=-(VRPT(1)*AMTR(3,1)+VRPT(2)*AMTR(3,2)+ VRPT(3)*
  90      +AMTR(3,3))
  91 *
  92 *      4TH ROW
  93 *
  94       AMTR(4,1)=0.
  95       AMTR(4,2)=0.
  96       AMTR(4,3)=0.
  97       AMTR(4,4)=0.
  98 *
  99 10000 FORMAT(' **** VUP and VPN are collinear  ****')
 100 *
 101       END