GEANT321/gheisha/defs.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:07  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
  11 *-- Author :
  12 C
  13 C *** VARIOUS VECTOR OPERATIONS ***
  14 C
  15 C COPIED FROM F14BLO.PAMLIB 23.4.82
  16 C AUTHOR: V.BLOBEL (UNIVERSITY OF HAMBURG)
  17 C DESYLIB
  18 C
  19 C *** BLANK COMMON REPLACED BY /VECUTY/ TO MATCH GEANT/GHEISHA CODE ***
  20 C *** NOTE THAT P(10,100) HAS BECOME PV(10,200) DUE TO THIS         ***
  21 C
  22 C UN-USED ENTRIES REMOVED :
  23 C     "PCOP" "PEXC" "PZER" "PWRT" "DOT4" "IMPU" "IMPULI" "ADD3"
  24 C     "SUB3" "CROSS" "DOT" "SMUL" "NORZ" "PARPER" "PUNIT" "TRAP"
  25 C
  26 C *** ALL ENTRIES RE-WRITTEN AS SUBROUTINES USING ONLY NECESSARY ***
  27 C *** "DOUBLE PRECISION" STMTS. AND ALL SPECIFIC FUNCTIONS HAVE  ***
  28 C *** BEEN CHANGED TO THEIR GENERIC EQUIVALENCES                 ***
  29 C *** NVE 29-MAR-1988 CERN GENEVA ***
  30 C
  31 C ORIGIN : H.FESEFELDT (22-JUNE-1984)
  32 C
  33       SUBROUTINE DEFS(K,L,M)
  34 C
  35 C --- PV-ARRAY ---
  36 #include "geant321/mxgkgh.inc"
  37 #include "geant321/s_blankp.inc"
  38 C
  39       DOUBLE PRECISION A,B
  40 C
  41       MX=M
  42       MY=M+1
  43       MZ=M+2
  44       DO 52 I=1,3
  45       F=PV(I,K)
  46       H=PV(I,L)
  47       PV(I,MY)=F
  48       PV(I,MZ)=H
  49  52   CONTINUE
  50       A=PV(2,MY)*PV(3,MZ)
  51       B=PV(3,MY)*PV(2,MZ)
  52       PV(1,MX)=A-B
  53       A=PV(3,MY)*PV(1,MZ)
  54       B=PV(1,MY)*PV(3,MZ)
  55       PV(2,MX)=A-B
  56       A=PV(1,MY)*PV(2,MZ)
  57       B=PV(2,MY)*PV(1,MZ)
  58       PV(3,MX)=A-B
  59       A=PV(2,MZ)*PV(3,MX)
  60       B=PV(3,MZ)*PV(2,MX)
  61       PV(1,MY)=A-B
  62       A=PV(3,MZ)*PV(1,MX)
  63       B=PV(1,MZ)*PV(3,MX)
  64       PV(2,MY)=A-B
  65       A=PV(1,MZ)*PV(2,MX)
  66       B=PV(2,MZ)*PV(1,MX)
  67       PV(3,MY)=A-B
  68       DO 58 J=MX,MZ
  69       A=0.0
  70       DO 54 I=1,3
  71       A=A+PV(I,J)*PV(I,J)
  72  54   CONTINUE
  73       B=SQRT(A)
  74       IF (B .NE. 0.0) B=1.0/B
  75       DO 56 I=1,3
  76       PV(I,J)=B*PV(I,J)
  77  56   CONTINUE
  78  58   CONTINUE
  79       RETURN
  80       END