* * $Id$ * * $Log$ * Revision 1.1.1.1 1995/10/24 10:20:05 cernlib * Geant * * #include "geant321/pilot.h" *CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani *-- Author : *$ CREATE SIHAEL.FOR *COPY SIHAEL * * *=== sihael ===========================================================* * * SUBROUTINE SIHAEL(KPROJ,EKIN,PLAB,ANUC,SIGELA) #include "geant321/dblprc.inc" #include "geant321/dimpar.inc" #include "geant321/iounit.inc" C*** C HJM 22/10/88 C C CROSS SECTIONS FOR ELASTIC SCATTERING C C INCLUDING - PION/NUCLEON PROTON DATA FROM BERTINI (HETKFA2) C C - ... HIGH-ENERGY APPROXIMATION: C SIGEL/SIGTOT = CONST C C - NUCLEON-NUCLEUS DATA FROM HETKFA2 C*** PARAMETER (NEN=106) PARAMETER (NEA=23) PARAMETER (NNAA=10) DIMENSION EKIHN(NEN),EKIHA(NEA),AMASS(NNAA) DIMENSION SEPIMP(NEN),SEPIPP(NEN),SEPP(NEN),SENP(NEN) DIMENSION SENA(NEA,NNAA),SEPA(NEA,NNAA) DIMENSION TSIG(2) DIMENSION RELTO(14) C #include "geant321/paprop.inc" C*** C KINETIC ENERGIES FOR TABLE LOOK-UP DATA EKIHN / & 0.00D0, 0.02D0, 0.04D0, 0.06D0, 0.08D0, 0.10D0, 0.12D0, 0.14D0, & 0.16D0, 0.18D0, 0.20D0, 0.22D0, 0.24D0, 0.26D0, 0.28D0, 0.30D0, & 0.32D0, 0.34D0, 0.36D0, 0.38D0, 0.40D0, 0.42D0, 0.44D0, 0.46D0, & 0.48D0, 0.50D0, 0.52D0, 0.54D0, 0.56D0, 0.58D0, 0.60D0, 0.62D0, & 0.64D0, 0.66D0, 0.68D0, 0.70D0, 0.72D0, 0.74D0, 0.76D0, 0.78D0, & 0.80D0, 0.82D0, 0.84D0, 0.86D0, 0.88D0, 0.90D0, 0.92D0, 0.94D0, & 0.96D0, 0.98D0, 1.00D0, 1.02D0, 1.04D0, 1.06D0, 1.08D0, 1.10D0, & 1.12D0, 1.14D0, 1.16D0, 1.18D0, 1.20D0, 1.22D0, 1.24D0, 1.26D0, & 1.28D0, 1.30D0, 1.32D0, 1.34D0, 1.36D0, 1.38D0, 1.40D0, 1.42D0, & 1.44D0, 1.46D0, 1.48D0, 1.50D0, 1.52D0, 1.54D0, 1.56D0, 1.58D0, & 1.60D0, 1.62D0, 1.64D0, 1.66D0, 1.68D0, 1.70D0, 1.72D0, 1.74D0, & 1.76D0, 1.78D0, 1.80D0, 1.82D0, 1.84D0, 1.86D0, 1.88D0, 1.90D0, & 1.92D0, 1.94D0, 1.96D0, 1.98D0, 2.00D0, 2.5D0, 3.0D0, 3.5D0, & 5.0D0, 10.0D0/ DATA EKIHA / & 0.015D0, 0.02D0, 0.025D0, 0.03D0, 0.04D0, 0.05D0, 0.06D0, & 0.08D0, 0.10D0, 0.125D0, 0.15D0, 0.175D0, 0.20D0, 0.225D0, & 0.25D0, 0.3D0, 0.4D0, 0.6D0, 1.0D0, 2.0D0, 5.0D0, & 10.0D0, 22.5D0/ DATA AMASS / & 4.D0, 9.D0, 12.D0, 27.D0, 47.9D0, 55.9D0, 63.5D0, 112.4D0, & 207.2D0, 238.1D0/ C------------------------------------------------------------------- C C*** PI(-)-P ELASTIC CROSS SECTION DATA DATA (SEPIMP(IE),IE=1,50) / * 1.250D+00, 1.500D+00, 1.750D+00, 2.450D+00, 3.800D+00, * 6.000D+00, 9.700D+00, 1.500D+01, 2.140D+01, 2.310D+01, * 2.295D+01, 2.070D+01, 1.795D+01, 1.550D+01, 1.360D+01, * 1.230D+01, 1.130D+01, 1.070D+01, 1.050D+01, 1.070D+01, * 1.120D+01, 1.175D+01, 1.235D+01, 1.300D+01, 1.400D+01, * 1.500D+01, 1.600D+01, 1.700D+01, 1.835D+01, 1.970D+01, * 2.050D+01, 1.915D+01, 1.770D+01, 1.650D+01, 1.570D+01, * 1.520D+01, 1.510D+01, 1.525D+01, 1.550D+01, 1.600D+01, * 1.685D+01, 1.800D+01, 2.000D+01, 2.230D+01, 2.475D+01, * 2.635D+01, 2.510D+01, 2.300D+01, 2.140D+01, 2.000D+01/ DATA (SEPIMP(IE),IE=51,106) / * 1.870D+01, 1.750D+01, 1.670D+01, 1.585D+01, 1.505D+01, * 1.440D+01, 1.395D+01, 1.340D+01, 1.299D+01, 1.260D+01, * 1.215D+01, 1.175D+01, 1.140D+01, 1.099D+01, 1.060D+01, * 1.040D+01, 1.010D+01, 9.990D+00, 9.900D+00, 9.750D+00, * 9.600D+00, 9.550D+00, 9.450D+00, 9.350D+00, 9.250D+00, * 9.250D+00, 9.350D+00, 9.650D+00, 9.850D+00, 1.000D+01, * 1.015D+01, 1.030D+01, 1.060D+01, 1.080D+01, 1.095D+01, * 1.100D+01, 1.095D+01, 1.090D+01, 1.070D+01, 1.035D+01, * 1.000D+01, 9.600D+00, 9.050D+00, 8.550D+00, 8.200D+00, * 8.000D+00, 7.850D+00, 7.800D+00, 7.750D+00, 7.700D+00, * 7.650D+00, * 7.600D+00, 7.240D+00, 6.770D+00, 5.840D+00, 4.570D+00/ * *** The previous 5 points have been substituted to the erroneous * *** ones from H.J. Mohring by A. Ferrari C--------------------------------------------------------------------- C C*** PI(+)-P ELASTIC CROSS SECTION DATA DATA (SEPIPP(IE),IE=1,50) / * 1.800D+00, 4.000D+00, 9.900D+00, 2.170D+01, 4.000D+01, * 6.580D+01, 9.680D+01, 1.392D+02, 1.800D+02, 2.000D+02, * 1.655D+02, 1.420D+02, 1.225D+02, 1.032D+02, 8.400D+01, * 6.725D+01, 5.510D+01, 4.725D+01, 4.130D+01, 3.690D+01, * 3.230D+01, 2.885D+01, 2.600D+01, 2.300D+01, 2.090D+01, * 1.875D+01, 1.675D+01, 1.500D+01, 1.340D+01, 1.200D+01, * 1.100D+01, 9.980D+00, 9.200D+00, 8.600D+00, 8.200D+00, * 8.100D+00, 8.100D+00, 8.250D+00, 8.500D+00, 8.750D+00, * 9.000D+00, 9.400D+00, 9.750D+00, 1.000D+01, 1.030D+01, * 1.075D+01, 1.130D+01, 1.200D+01, 1.275D+01, 1.330D+01/ DATA (SEPIPP(IE),IE=51,106) / * 1.350D+01, 1.335D+01, 1.330D+01, 1.330D+01, 1.345D+01, * 1.355D+01, 1.380D+01, 1.400D+01, 1.460D+01, 1.500D+01, * 1.555D+01, 1.625D+01, 1.700D+01, 1.800D+01, 1.875D+01, * 1.920D+01, 1.925D+01, 1.890D+01, 1.830D+01, 1.790D+01, * 1.725D+01, 1.690D+01, 1.640D+01, 1.600D+01, 1.550D+01, * 1.505D+01, 1.475D+01, 1.430D+01, 1.400D+01, 1.365D+01, * 1.335D+01, 1.300D+01, 1.280D+01, 1.250D+01, 1.225D+01, * 1.205D+01, 1.195D+01, 1.175D+01, 1.150D+01, 1.135D+01, * 1.105D+01, 1.095D+01, 1.080D+01, 1.060D+01, 1.030D+01, * 1.020D+01, 1.005D+01, 9.900D+00, 9.800D+00, 9.700D+00, * 9.600D+00, * 7.350D+00, 7.200D+00, 7.000D+00, 5.800D+00, 4.800D+00/ C--------------------------------------------------------------------- C C*** P-P ELASTIC CROSS SECTION DATA DATA (SEPP(IE),IE=1,50) / * 6.750D+02, 1.550D+02, 6.750D+01, 4.420D+01, 3.230D+01, * 2.800D+01, 2.520D+01, 2.370D+01, 2.300D+01, 2.275D+01, * 2.260D+01, 2.260D+01, 2.260D+01, 2.260D+01, 2.270D+01, * 2.280D+01, 2.295D+01, 2.300D+01, 2.310D+01, 2.330D+01, * 2.350D+01, 2.380D+01, 2.395D+01, 2.420D+01, 2.460D+01, * 2.485D+01, 2.500D+01, 2.530D+01, 2.565D+01, 2.600D+01, * 2.620D+01, 2.640D+01, 2.660D+01, 2.675D+01, 2.690D+01, * 2.700D+01, 2.705D+01, 2.710D+01, 2.715D+01, 2.720D+01, * 2.725D+01, 2.725D+01, 2.720D+01, 2.715D+01, 2.710D+01, * 2.700D+01, 2.695D+01, 2.680D+01, 2.670D+01, 2.660D+01/ DATA (SEPP(IE),IE=51,106) / * 2.640D+01, 2.625D+01, 2.605D+01, 2.590D+01, 2.570D+01, * 2.545D+01, 2.525D+01, 2.500D+01, 2.480D+01, 2.470D+01, * 2.450D+01, 2.430D+01, 2.410D+01, 2.395D+01, 2.370D+01, * 2.360D+01, 2.340D+01, 2.325D+01, 2.305D+01, 2.290D+01, * 2.275D+01, 2.270D+01, 2.260D+01, 2.250D+01, 2.230D+01, * 2.225D+01, 2.210D+01, 2.200D+01, 2.195D+01, 2.190D+01, * 2.175D+01, 2.165D+01, 2.150D+01, 2.140D+01, 2.125D+01, * 2.120D+01, 2.105D+01, 2.100D+01, 2.090D+01, 2.075D+01, * 2.065D+01, 2.055D+01, 2.045D+01, 2.030D+01, 2.020D+01, * 2.005D+01, 2.000D+01, 1.995D+01, 1.980D+01, 1.975D+01, * 1.965D+01, * 17.15D+00, 14.45D+00, 13.00D+00, 11.50D+00, 10.50D+00/ C-------------------------------------------------------------------- C C*** N-P ELASTIC CROSS SECTION DATA DATA (SENP(IE),IE=1,50) / * 1.965D+03, 4.750D+02, 2.200D+02, 1.300D+02, 9.180D+01, * 7.300D+01, 6.030D+01, 5.180D+01, 4.680D+01, 4.320D+01, * 4.080D+01, 3.910D+01, 3.760D+01, 3.650D+01, 3.550D+01, * 3.480D+01, 3.415D+01, 3.370D+01, 3.325D+01, 3.290D+01, * 3.275D+01, 3.250D+01, 3.255D+01, 3.275D+01, 3.285D+01, * 3.275D+01, 3.220D+01, 3.150D+01, 3.075D+01, 2.990D+01, * 2.875D+01, 2.775D+01, 2.695D+01, 2.630D+01, 2.590D+01, * 2.565D+01, 2.560D+01, 2.560D+01, 2.560D+01, 2.565D+01, * 2.570D+01, 2.575D+01, 2.578D+01, 2.580D+01, 2.585D+01, * 2.580D+01, 2.575D+01, 2.560D+01, 2.540D+01, 2.505D+01/ DATA (SENP(IE),IE=51,106) / * 2.470D+01, 2.425D+01, 2.375D+01, 2.315D+01, 2.275D+01, * 2.230D+01, 2.200D+01, 2.175D+01, 2.155D+01, 2.145D+01, * 2.130D+01, 2.125D+01, 2.115D+01, 2.105D+01, 2.100D+01, * 2.095D+01, 2.090D+01, 2.080D+01, 2.070D+01, 2.060D+01, * 2.050D+01, 2.045D+01, 2.040D+01, 2.030D+01, 2.025D+01, * 2.020D+01, 2.015D+01, 2.010D+01, 2.005D+01, 2.002D+01, * 2.000D+01, 1.999D+01, 1.990D+01, 1.985D+01, 1.975D+01, * 1.970D+01, 1.965D+01, 1.960D+01, 1.950D+01, 1.945D+01, * 1.940D+01, 1.925D+01, 1.920D+01, 1.915D+01, 1.910D+01, * 1.900D+01, 1.898D+01, 1.895D+01, 1.890D+01, 1.880D+01, * 1.875D+01, * 17.00D+00, 14.40D+00, 12.00D+00, 11.00D+00, 10.00D+00/ C--------------------------------------------------------------------- C C*** N-A ELASTIC CROSS SECTION DATA DATA (SENA(IE,1),IE=1,NEA) / C* NEUTRON - HELIUM * 5.103D-01, 5.157D-01, 5.103D-01, 4.777D-01, 4.072D-01, * 3.420D-01, 2.714D-01, 1.683D-01, 6.700D-02, 6.100D-02, * 5.800D-02, 4.900D-02, 3.800D-02, 3.300D-02, 3.000D-02, * 2.400D-02, 2.300D-02, 2.900D-02, 3.600D-02, 4.100D-02, * 4.000D-02, 3.700D-02, 3.400D-02/ C C* NEUTRON - BERYLLIUM DATA (SENA(IE,2),IE=1,NEA) / * 8.762D-01, 8.856D-01, 8.762D-01, 8.203D-01, 6.991D-01, * 5.873D-01, 4.661D-01, 2.890D-01, 1.401D-01, 1.305D-01, * 1.238D-01, 1.069D-01, 8.495D-02, 7.480D-02, 6.750D-02, * 5.565D-02, 5.230D-02, 6.470D-02, 7.765D-02, 8.722D-02, * 8.440D-02, 7.821D-02, 7.259D-02/ C C* NEUTRON - CARBON DATA (SENA(IE,3),IE=1,NEA) / * 9.200D-01, 9.500D-01, 9.400D-01, 8.800D-01, 7.500D-01, * 6.100D-01, 5.000D-01, 3.700D-01, 1.820D-01, 1.710D-01, * 1.620D-01, 1.410D-01, 1.130D-01, 1.000D-01, 9.000D-02, * 7.500D-02, 7.000D-02, 8.600D-02, 1.020D-01, 1.140D-01, * 1.100D-01, 1.020D-01, 9.500D-02/ C C* NEUTRON - ALUMINUM DATA (SENA(IE,4),IE=1,NEA) / * 1.090D+00, 1.180D+00, 1.240D+00, 1.280D+00, 1.260D+00, * 1.160D+00, 9.300D-01, 6.300D-01, 3.580D-01, 3.450D-01, * 3.350D-01, 2.990D-01, 2.480D-01, 2.220D-01, 2.020D-01, * 1.730D-01, 1.610D-01, 1.920D-01, 2.200D-01, 2.420D-01, * 2.370D-01, 2.220D-01, 2.060D-01/ C C* NEUTRON - TITANIUM DATA (SENA(IE,5),IE=1,NEA) / * 1.029D+00, 9.469D-01, 1.091D+00, 1.284D+00, 1.591D+00, * 1.691D+00, 1.258D+00, 9.241D-01, 5.620D-01, 5.493D-01, * 5.375D-01, 4.907D-01, 4.182D-01, 3.800D-01, 3.484D-01, * 3.038D-01, 2.823D-01, 3.307D-01, 3.720D-01, 4.040D-01, * 3.959D-01, 3.743D-01, 3.517D-01/ C C* NEUTRON - IRON DATA (SENA(IE,6),IE=1,NEA) / * 1.178D+00, 9.793D-01, 1.090D+00, 1.271D+00, 1.650D+00, * 1.799D+00, 1.339D+00, 1.009D+00, 6.223D-01, 6.132D-01, * 6.042D-01, 5.572D-01, 4.812D-01, 4.402D-01, 4.053D-01, * 3.554D-01, 3.304D-01, 3.814D-01, 4.244D-01, 4.603D-01, * 4.523D-01, 4.293D-01, 4.053D-01/ C C* NEUTRON - COPPER DATA (SENA(IE,7),IE=1,NEA) / * 1.386D+00, 1.050D+00, 1.134D+00, 1.302D+00, 1.722D+00, * 1.922D+00, 1.449D+00, 1.103D+00, 6.762D-01, 6.686D-01, * 6.602D-01, 6.131D-01, 5.344D-01, 4.912D-01, 4.541D-01, * 4.004D-01, 3.728D-01, 4.273D-01, 4.725D-01, 5.103D-01, * 5.022D-01, 4.781D-01, 4.524D-01/ C C* NEUTRON - CADMIUM DATA (SENA(IE,8),IE=1,NEA) / * 2.029D+00, 1.537D+00, 1.660D+00, 1.906D+00, 2.520D+00, * 2.812D+00, 2.121D+00, 1.614D+00, 1.014D+00, 1.012D+00, * 1.006D+00, 9.557D-01, 8.607D-01, 8.038D-01, 7.541D-01, * 6.775D-01, 6.334D-01, 7.080D-01, 7.669D-01, 8.156D-01, * 8.074D-01, 7.769D-01, 7.404D-01/ C C* NEUTRON - LEAD DATA (SENA(IE,9),IE=1,NEA) / * 3.050D+00, 2.310D+00, 2.495D+00, 2.865D+00, 3.789D+00, * 4.228D+00, 3.188D+00, 2.426D+00, 1.536D+00, 1.538D+00, * 1.536D+00, 1.488D+00, 1.384D+00, 1.317D+00, 1.256D+00, * 1.153D+00, 1.089D+00, 1.185D+00, 1.255D+00, 1.315D+00, * 1.307D+00, 1.269D+00, 1.224D+00/ C C* NEUTRON - URANIUM DATA (SENA(IE,10),IE=1,NEA) / * 3.346D+00, 2.535D+00, 2.738D+00, 3.143D+00, 4.157D+00, * 4.639D+00, 3.498D+00, 2.662D+00, 1.685D+00, 1.687D+00, * 1.685D+00, 1.632D+00, 1.518D+00, 1.445D+00, 1.378D+00, * 1.265D+00, 1.194D+00, 1.300D+00, 1.377D+00, 1.443D+00, * 1.434D+00, 1.392D+00, 1.343D+00/ C--- ---------------------------------------------------------------- C C*** P-A ELASTIC CROSS SECTION DATA DATA (SEPA(IE,1),IE=1,NEA) / C* PROTON - HELIUM * 8*0.000D+00, 6.700D-02, 6.100D-02, * 5.800D-02, 4.900D-02, 3.800D-02, 3.300D-02, 3.000D-02, * 2.400D-02, 2.300D-02, 2.900D-02, 3.600D-02, 4.100D-02, * 4.000D-02, 3.700D-02, 3.400D-02/ C C* PROTON - BERYLLIUM DATA (SEPA(IE,2),IE=1,NEA) / * 8*0.000D+00, 1.401D-01, 1.305D-01, * 1.238D-01, 1.069D-01, 8.495D-02, 7.480D-02, 6.750D-02, * 5.565D-02, 5.230D-02, 6.470D-02, 7.765D-02, 8.722D-02, * 8.440D-02, 7.821D-02, 7.259D-02/ C C* PROTON - CARBON DATA (SEPA(IE,3),IE=1,NEA) / * 8*0.000D+00, 1.820D-01, 1.710D-01, * 1.620D-01, 1.410D-01, 1.130D-01, 1.000D-01, 9.000D-02, * 7.500D-02, 7.000D-02, 8.600D-02, 1.020D-01, 1.140D-01, * 1.100D-01, 1.020D-01, 9.500D-02/ C C* PROTON - ALUMINUM DATA (SEPA(IE,4),IE=1,NEA) / * 8*0.000D+00, 3.650D-01, 3.540D-01, * 3.420D-01, 3.060D-01, 2.530D-01, 2.260D-01, 2.040D-01, * 1.750D-01, 1.610D-01, 1.900D-01, 2.200D-01, 2.430D-01, * 2.370D-01, 2.220D-01, 2.070D-01/ C C* PROTON - TITANIUM DATA (SEPA(IE,5),IE=1,NEA) / * 8*0.000D+00, 5.828D-01, 5.726D-01, * 5.594D-01, 5.100D-01, 4.310D-01, 3.897D-01, 3.561D-01, * 3.084D-01, 2.829D-01, 3.262D-01, 3.714D-01, 4.066D-01, * 3.985D-01, 3.764D-01, 3.517D-01/ C C* NEUTRON - IRON DATA (SEPA(IE,6),IE=1,NEA) / * 8*0.000D+00, 6.383D-01, 6.313D-01, * 6.212D-01, 5.732D-01, 4.913D-01, 4.483D-01, 4.113D-01, * 3.594D-01, 3.304D-01, 3.764D-01, 4.243D-01, 4.623D-01, * 4.543D-01, 4.313D-01, 4.053D-01/ C C* NEUTRON - COPPER DATA (SEPA(IE,7),IE=1,NEA) / * 8*0.000D+00, 6.950D-01, 6.895D-01, * 6.803D-01, 6.322D-01, 5.471D-01, 5.014D-01, 4.619D-01, * 4.048D-01, 3.728D-01, 4.211D-01, 4.722D-01, 5.135D-01, * 5.051D-01, 4.804D-01, 4.527D-01/ C C* NEUTRON - CADMIUM DATA (SEPA(IE,8),IE=1,NEA) / * 8*0.000D+00, 1.045D+00, 1.043D+00, * 1.036D+00, 9.718D-01, 8.822D-01, 8.211D-01, 7.679D-01, * 6.828D-01, 6.325D-01, 6.951D-01, 7.647D-01, 8.232D-01, * 8.138D-01, 7.935D-01, 7.415D-01/ C C* NEUTRON - LEAD DATA (SEPA(IE,9),IE=1,NEA) / * 8*0.000D+00, 1.589D+00, 1.584D+00, * 1.577D+00, 1.528D+00, 1.417D+00, 1.345D+00, 1.277D+00, * 1.159D+00, 1.086D+00, 1.159D+00, 1.252D+00, 1.331D+00, * 1.320D+00, 1.278D+00, 1.256D+00/ C C* NEUTRON - URANIUM DATA (SEPA(IE,10),IE=1,NEA) / * 8*0.000D+00, 1.743D+00, 1.738D+00, * 1.730D+00, 1.676D+00, 1.554D+00, 1.475D+00, 1.401D+00, * 1.271D+00, 1.191D+00, 1.271D+00, 1.373D+00, 1.460D+00, * 1.448D+00, 1.402D+00, 1.378D+00/ C DATA RELTO / 0.175D0, 6*0.D0, 0.175D0, 4*0.D0, 0.14D0, 0.14D0/ C C-------------------------------------------------------------------- C IF(ANUC.LT.1.5D0) THEN C HADRON-PROTON ELASTIC CROSS SECTIONS IPOL=0 EK1=EKIN IF(EKIN.GT.20.D0) THEN SIGELA=RELTO(KPROJ)*SHPTOT(KPROJ,PLAB) RETURN ELSEIF(EKIN.GT.10.D0) THEN IPOL=1 PO2=20.D0 EK2=SQRT(PO2**2+AM(KPROJ)**2) - AM(KPROJ) SEL2=RELTO(KPROJ)*SHPTOT(KPROJ,PO2) EK1=10.D0 ENDIF C DO 101 IE=1,NEN IF(EK1.LT.EKIHN(IE)) THEN JE1=IE-1 JE2=IE DDEE=EKIHN(JE2) - EKIHN(JE1) GOTO 102 ENDIF 101 CONTINUE JE1=NEN JE2=NEN DDEE=1.D0 102 CONTINUE C**** C PROTON-PROTON IF(KPROJ.EQ.1) THEN S1=SEPP(JE1) S2=SEPP(JE2) C NEUTRON-PROTON ELSEIF(KPROJ.EQ.8) THEN S1=SENP(JE1) S2=SENP(JE2) C PI(+)-PROTON ELSEIF(KPROJ.EQ.13) THEN S1=SEPIPP(JE1) S2=SEPIPP(JE2) C PI(-)-PROTON ELSEIF(KPROJ.EQ.14) THEN S1=SEPIMP(JE1) S2=SEPIMP(JE2) C UNDEFINED ENTRY CONDITIONS ELSE SIGELA=0.D0 RETURN ENDIF C SIGELA=S1 + (S2-S1)*(EK1-EKIHN(JE1))/DDEE C C INTERPOLATION BETWEEN 10/20 GEV IF(IPOL.EQ.1) THEN SEL1=SIGELA SIGELA=SEL1 + (SEL2-SEL1)*(EKIN-EK1)/(EK2-EK1) ENDIF C RETURN C ENDIF C*************************************** C HADRON-NUCLEUS ELASTIC CROSS SECTIONS DO 201 IE=1,NEA IF(EKIN.LT.EKIHA(IE)) THEN JE=IE - 1 GOTO 202 ENDIF 201 CONTINUE IF(EKIN.EQ.EKIHA(NEA)) THEN JE=NEA - 1 ELSE JE=-1 ENDIF 202 CONTINUE C DO 203 IA=1,NNAA IF(ANUC.LT.AMASS(IA)) THEN JA=IA - 1 GOTO 204 ENDIF 203 CONTINUE IF(ANUC.EQ.AMASS(NNAA)) THEN JA=NNAA - 1 ELSE JA=-1 ENDIF 204 CONTINUE C IF (JA) 230,220,210 210 IF (JE) 240,250,211 211 TEMP1=ANUC/AMASS(JA) TEMP2=LOG(AMASS(JA+1)/AMASS(JA)) KE=JE DO 212 I=1,2 IF(KPROJ.EQ.8) THEN SLOW=SENA(KE,JA) POWER=LOG(SENA(KE,JA+1)/SLOW)/TEMP2 ELSE SLOW=SEPA(KE,JA) POWER=LOG(SEPA(KE,JA+1)/SLOW)/TEMP2 ENDIF TSIG(I)=SLOW*TEMP1**POWER KE=KE+1 212 CONTINUE C 213 SIGELA=TSIG(1) * + (EKIN-EKIHA(JE))*(TSIG(2)-TSIG(1)) * /(EKIHA(JE+1)-EKIHA(JE)) SIGELA=SIGELA * 1E3 RETURN C* C A IS LESS THAN A MIN 220 JA=1 TEMP1= (ANUC/AMASS(JA)) **0.6666666666666667D0 221 IF (JE) 260,270,222 222 IF(KPROJ.EQ.8) THEN TSIG(1) = SENA(JE,JA) * TEMP1 TSIG(2) = SENA(JE+1,JA) *TEMP1 ELSE TSIG(1) = SEPA(JE,JA) * TEMP1 TSIG(2) = SEPA(JE+1,JA) *TEMP1 ENDIF GO TO 213 C* C A IS GREATER THAN A MAX 230 JA=NNAA TEMP1= (ANUC/AMASS(JA))**0.6666666666666667D0 GO TO 221 C* C EKIN LT. EMIN 250 JE=1 251 TEMP1=ANUC/AMASS(JA) TEMP2=LOG(AMASS(JA+1)/AMASS(JA)) IF(KPROJ.EQ.8) THEN SLOW=SENA(JE,JA) POWER=LOG(SENA(JE,JA+1)/SLOW)/TEMP2 ELSE SLOW=SEPA(JE,JA) POWER=LOG(SEPA(JE,JA+1)/SLOW)/TEMP2 ENDIF SIGELA=SLOW*TEMP1**POWER SIGELA=SIGELA * 1.D+03 RETURN C 270 JE=1 271 IF(KPROJ.EQ.8) THEN SIGELA=SENA(JE,JA)*TEMP1 ELSE SIGELA=SEPA(JE,JA)*TEMP1 ENDIF SIGELA=SIGELA * 1.D+03 RETURN C* C EKIN GT. EMAX 240 JE=NEA GO TO 251 260 JE=NEA GO TO 271 END