GEANT321/gheisha/setcur.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:59  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       SUBROUTINE SETCUR(NTR)
  13 C
  14 C *** STORAGE OF CURRENT TRACK PARAMETERS ***
  15 C *** NVE 16-MAR-1988 CERN GENEVA ***
  16 C
  17 C ORIGIN : H.FESEFELDT (26-JAN-1984)
  18 C
  19 #include "geant321/s_defcom.inc"
  20       DIMENSION RNDM(1)
  21 C
  22       CALL LENGTX(NTR,P)
  23       AMAS=PV(5,NTR)
  24       AMASQ=AMAS*AMAS
  25       NCH=PV(6,NTR)
  26       TOF=PV(7,NTR)
  27       IPART=IFIX(PV(8,NTR)+0.1)
  28       IF(PV(10,NTR).NE.0.) USERW=PV(10,NTR)
  29       PX=0.
  30       PY=0.
  31       PZ=0.
  32       IF(P.LT.1.E-10) GOTO 4
  33       PX=PV(1,NTR)/P
  34       PY=PV(2,NTR)/P
  35       PZ=PV(3,NTR)/P
  36     4 EN=PV(4,NTR)
  37       EK=EN-ABS(AMAS)
  38       SINL=PZ
  39       COSL=SQRT(ABS(1.-SINL*SINL))
  40       IF(ABS(COSL).LT.1.E-10) GOTO 1
  41       SINP=PY/COSL
  42       COSP=PX/COSL
  43       GOTO 2
  44     1 CALL GRNDM(RNDM,1)
  45       PHI=RNDM(1)*TWPI
  46       SINP=SIN(PHI)
  47       COSP=COS(PHI)
  48     2 IF(NPRT(3).OR.NPRT(4).OR.NPRT(5))
  49      *WRITE(NEWBCD,1001) XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
  50      *USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,LCALO,ICEL,
  51      *SINL,COSL,SINP,COSP
  52       RETURN
  53  1001 FORMAT(1H ,'TRACK PARAMETER CHANGED:',3F8.2,1X,2F7.0,1X,F8.3,1X,
  54      *F3.0,1X,F6.0,1X,3F6.3,1X,F10.0,1X,F5.0/10X,4F8.3,1X,F8.5,1X,6I5,
  55      *4F8.3)
  56       END