GEANT321/gphys/gmols.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:20  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:21:27  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 #if defined(CERNLIB_VER314)
  14 *CMZ :  3.21/02 29/03/94  15.41.22  by  S.Giani
  15 *-- Author :
  16       SUBROUTINE GMOLS (OMEGA,CHIC,COSTH,SINTH)
  17 C.
  18 C.    ******************************************************************
  19 C.    *                                                                *
  20 C.    *  Generation of multiple scattering according to                *
  21 C.    *  Moliere theory corrected for finite angle scattering          *
  22 C.    *                                                                *
  23 C.    *  evolved from Cern library program MLR                         *
  24 C.    *                                                                *
  25 C.    *  OMEGA & CHIC are number of scatterings and critical angle     *
  26 C.    *  of the medium for a given incident particle                   *
  27 C.    *                                                                *
  28 C.    *  COSTH and SINTH are the cosine and sine of the generated      *
  29 C.    *  scattering angle between 0 and 180 degrees                    *
  30 C.    *                                                                *
  31 C.    * THRED(NA)=reduced angles of Moliere theory                     *
  32 C.    *                                                                *
  33 C.    * F0I(NA),F1I(NA),F2I(NA)= integrale of Moliere functions        *
  34 C.    *                                                                *
  35 C.    *  4 point continued fraction interpolation is used to invert    *
  36 C.    *  the total distribution function integral                      *
  37 C.    *                                                                *
  38 C.    * XINT= argument value                                           *
  39 C.    * ARG= argument values of the table (arg,val)                    *
  40 C.    * VAL= function values of the table (arg,val)                    *
  41 C.    * THRI= the resulting interpolated function value                *
  42 C.    *                                                                *
  43 C.    *    ==>Called by : GMOLIE                                       *
  44 C.    *         Author M.S. Dixit NRCC Ottawa    *********             *
  45 C.    *                                                                *
  46 C.    ******************************************************************
  47 C.
  48       DIMENSION TINT(40),ARG(4),VAL(4),THRED(40),F0I(40),F1I(40),F2I(40)
  49       DIMENSION RNDM(1)
  50       SAVE TINT
  51       DATA TINT(1)/0./
  52       DATA THRED/
  53      *   0.00, 0.10, 0.20, 0.30
  54      *,  0.40, 0.50, 0.60, 0.70
  55      *,  0.80, 0.90, 1.00, 1.10
  56      *,  1.20, 1.30, 1.40, 1.50
  57      *,  1.60, 1.70, 1.80, 1.90
  58      *,  2.00, 2.20, 2.40, 2.60
  59      *,  2.80, 3.00, 3.20, 3.40
  60      *,  3.60, 3.80, 4.00, 5.00
  61      *,  6.00, 7.00, 8.00, 9.00
  62      *, 10.00,11.00,12.00,13.00/
  63       DATA F0I/
  64      *  0.000000E+00 ,0.995016E-02 ,0.392106E-01 ,0.860688E-01
  65      * ,0.147856E+00 ,0.221199E+00 ,0.302324E+00 ,0.387374E+00
  66      * ,0.472708E+00 ,0.555142E+00 ,0.632121E+00 ,0.701803E+00
  67      * ,0.763072E+00 ,0.815480E+00 ,0.859142E+00 ,0.894601E+00
  68      * ,0.922695E+00 ,0.944424E+00 ,0.960836E+00 ,0.972948E+00
  69      * ,0.981684E+00 ,0.992093E+00 ,0.996849E+00 ,0.998841E+00
  70      * ,0.999606E+00 ,0.999877E+00 ,0.999964E+00 ,0.999990E+00
  71      * ,0.999998E+00 ,0.999999E+00 ,0.100000E+01 ,0.100000E+01
  72      * ,0.100000E+01 ,0.100000E+01 ,0.100000E+01 ,0.100000E+01
  73      * ,1.,1.,1.,1./
  74       DATA F1I/
  75      *  0.000000E+00,0.414985E-02,0.154894E-01,0.310312E-01
  76      * ,0.464438E-01,0.569008E-01,0.580763E-01,0.468264E-01
  77      * ,0.217924E-01,-0.163419E-01,-0.651205E-01,-0.120503E+00
  78      * ,-0.178272E+00,-0.233580E+00,-0.282442E+00,-0.321901E+00
  79      * ,-0.350115E+00,-0.366534E+00,-0.371831E+00,-0.367378E+00
  80      * ,-0.354994E+00,-0.314803E+00,-0.266539E+00,-0.220551E+00
  81      * ,-0.181546E+00,-0.150427E+00,-0.126404E+00,-0.107830E+00
  82      * ,-0.933106E-01,-0.817375E-01,-0.723389E-01,-0.436650E-01
  83      * ,-0.294700E-01,-0.212940E-01,-0.161406E-01,-0.126604E-01
  84      * ,-0.102042E-01,-0.840465E-02,-0.704261E-02,-0.598886E-02/
  85       DATA F2I/
  86      *  0.0,0.121500E-01,0.454999E-01,0.913000E-01
  87      * ,0.137300E+00,0.171400E+00,0.183900E+00,0.170300E+00
  88      * ,0.132200E+00,0.763000E-01,0.126500E-01,-0.473500E-01
  89      * ,-0.936000E-01,-0.119750E+00,-0.123450E+00,-0.106300E+00
  90      * ,-0.732800E-01,-0.312400E-01,0.128450E-01,0.528800E-01
  91      * ,0.844100E-01,0.114710E+00,0.106200E+00,0.765830E-01
  92      * ,0.435800E-01,0.173950E-01,0.695001E-03,-0.809500E-02
  93      * ,-0.117355E-01,-0.125449E-01,-0.120280E-01,-0.686530E-02
  94      * ,-0.385275E-02,-0.231115E-02,-0.147056E-02,-0.982480E-03
  95      * ,-0.682440E-03,-0.489715E-03,-0.361190E-03,-0.272582E-03/
  96 *
  97 *     ------------------------------------------------------------------
  98 *
  99       CNST=LOG(OMEGA)
 100       IF(CNST.LE.1.)GO TO 190
 101       B=5.
 102       DO 20 L=1,10
 103          IF(ABS(B).LT.1.E-10)THEN
 104             B=1.E-10
 105          ENDIF
 106          DB=-(B-LOG(ABS(B))-CNST)/(1.-1./B)
 107          B=B+DB
 108          IF(ABS(DB).LE.0.0001)GO TO 30
 109   20  CONTINUE
 110       GO TO 190
 111   30  CONTINUE
 112       IF(B.LE.0.)GO TO 190
 113       BSQ=B*B
 114   31  CONTINUE
 115       CALL GRNDM(RNDM,1)
 116       XINT=RNDM(1)
 117       DO 50 NA=2,40
 118          TINT(NA)=F0I(NA)+F1I(NA)/B+F2I(NA)/BSQ
 119          S=XINT-TINT(NA)
 120          IF(S.LE.0.)GO TO 60
 121   50  CONTINUE
 122       GO TO 180
 123   60  CONTINUE
 124       IF(NA.GE.40)THEN
 125          NA=39
 126       ELSE
 127          TINT(NA+1)=F0I(NA+1)+F1I(NA+1)/B+F2I(NA+1)/BSQ
 128       ENDIF
 129       IF(NA.LE.2)THEN
 130          NA=3
 131          TINT(4)=F0I(4)+F1I(4)/B+F2I(4)/BSQ
 132       ENDIF
 133       NA3=NA-3
 134       DO 70 M=1,4
 135          NA3M=NA3+M
 136          ARG(M)=TINT(NA3M)
 137          VAL(M)=THRED(NA3M)**2
 138    70 CONTINUE
 139       F=THRED(NA)/50.
 140       CALL GMOL4(THRI,XINT,VAL,ARG,F,IER)
 141  200  CONTINUE
 142       TH=CHIC*SQRT(ABS(B*THRI))
 143       IF(TH.GT.3.141593)GO TO 31
 144       SINTH=SIN(TH)
 145       CALL GRNDM(RNDM,1)
 146       TEST=TH*(RNDM(1))**2
 147       IF(TEST.GT.SINTH)GO TO 31
 148       COSTH=COS(TH)
 149       RETURN
 150  180  CONTINUE
 151       TMP=1.-(1.-B*(1.-XINT))**5
 152       IF(TMP.LE.0.)GO TO 31
 153       THRI=5./TMP
 154       GO TO 200
 155  190  CONTINUE
 156       COSTH=1.
 157       SINTH=0.
 158 *
 159       END
 160 #else
 161       SUBROUTINE GMOLS_DUMMY
 162       END
 163 #endif