[u/mrichter/AliRoot.git] / GEANT321 / gheisha / trac.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:08  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
*-- Author :
C
C *** VARIOUS VECTOR OPERATIONS ***
C
C COPIED FROM F14BLO.PAMLIB 23.4.82
C AUTHOR: V.BLOBEL (UNIVERSITY OF HAMBURG)
C DESYLIB
C
C *** BLANK COMMON REPLACED BY /VECUTY/ TO MATCH GEANT/GHEISHA CODE ***
C *** NOTE THAT P(10,100) HAS BECOME PV(10,200) DUE TO THIS         ***
C
C UN-USED ENTRIES REMOVED :
C     "PCOP" "PEXC" "PZER" "PWRT" "DOT4" "IMPU" "IMPULI" "ADD3"
C     "SUB3" "CROSS" "DOT" "SMUL" "NORZ" "PARPER" "PUNIT" "TRAP"
C
C *** ALL ENTRIES RE-WRITTEN AS SUBROUTINES USING ONLY NECESSARY ***
C *** "DOUBLE PRECISION" STMTS. AND ALL SPECIFIC FUNCTIONS HAVE  ***
C *** BEEN CHANGED TO THEIR GENERIC EQUIVALENCES                 ***
C *** NVE 29-MAR-1988 CERN GENEVA ***
C
C ORIGIN : H.FESEFELDT (22-JUNE-1984)
C
      SUBROUTINE TRAC(K,L,M)
C
C --- PV-ARRAY ---
#include "geant321/mxgkgh.inc"
#include "geant321/s_blankp.inc"
C
      DOUBLE PRECISION B,G(3)
C
      N=L
      DO 62 J=1,3
      B=0.0
      DO 60 I=1,3
      B=B+PV(I,N)*PV(I,K)
 60   CONTINUE
      G(J)=B
      N=N+1
 62   CONTINUE
      DO 64 I=1,3
      PV(I,M)=G(I)
 64   CONTINUE
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:21:08 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 TRAC(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 B,G(3)
	40	C
	41	N=L
	42	DO 62 J=1,3
	43	B=0.0
	44	DO 60 I=1,3
	45	B=B+PV(I,N)*PV(I,K)
	46	60 CONTINUE
	47	G(J)=B
	48	N=N+1
	49	62 CONTINUE
	50	DO 64 I=1,3
	51	PV(I,M)=G(I)
	52	64 CONTINUE
	53	RETURN
	54	END