| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1995/10/24 10:20:04 cernlib |
| 6 | * Geant |
| 7 | * |
| 8 | * |
| 9 | #include "geant321/pilot.h" |
| 10 | *CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani |
| 11 | *-- Author : |
| 12 | *$ CREATE SIGEL.FOR |
| 13 | *COPY SIGEL |
| 14 | * |
| 15 | *=== sigel ============================================================* |
| 16 | * |
| 17 | SUBROUTINE SIGEL ( IT, AA, EKIN, POO, SEL, ZL ) |
| 18 | |
| 19 | #include "geant321/dblprc.inc" |
| 20 | #include "geant321/dimpar.inc" |
| 21 | #include "geant321/iounit.inc" |
| 22 | C******************************************************************** |
| 23 | C |
| 24 | C Slightly changed on 11 february 1991 by Alfredo Ferrari |
| 25 | C (The kinetic energy has been added to the input variables, |
| 26 | C a check is made on the minimum kinetic energy to have a |
| 27 | C an elastic scattering with the present coding, sigmabar, |
| 28 | C xsi, xsibar, omega, omegabar have been added with very |
| 29 | C rough correspondence to the existing particles) |
| 30 | C |
| 31 | C VERSION BY J. RANFT |
| 32 | C LEIPZIG |
| 33 | C LAST CHANGE 18. JULY 92 BY A. FERRARI |
| 34 | C INFN - MILAN |
| 35 | C |
| 36 | C |
| 37 | C THIS IS A SUBROUTINE OF FLUKA82 TO GIVE ELASTIC SCATTERING |
| 38 | C LENGTH AND CROSS SECTION |
| 39 | C |
| 40 | C INPUT VARIABLES: |
| 41 | C IT = PARTICLE TYPE |
| 42 | C AA = ATOMIC WEIGHT OF THE NUCLEUS |
| 43 | C EKIN = PARTICLE KINETIC ENERGY |
| 44 | C POO = PARTICLE MOMENTUM IN GEV/C |
| 45 | C |
| 46 | C OUTPUT VARIABLES: |
| 47 | C SEL = ELASTIC CROSS SECTION IN MB |
| 48 | C ZL = INTERACTION LENGTH IN G/CM**2 |
| 49 | C |
| 50 | C OTHER IMPORTANT VARIABLES: |
| 51 | C SIG = PROTON/NUCLEI CROSS SECTIONS |
| 52 | C SEG = PION/NUCLEI CROSS SECTIONS |
| 53 | C P = MOMENTUMS FOR WHICH THE CROSS SECTIONS ARE GIVEN IN |
| 54 | C SIG AND SEG |
| 55 | C A = NUCLEI FOR WHICH THE CROSS SECTIONS ARE GIVEN IN |
| 56 | C SIG AND SEG |
| 57 | C PLAB = MOMENTUMS FOR WHICH THE TOTAL CROSS SECTIONS ARE |
| 58 | C GIVEN IN SITO |
| 59 | C SITO = TOTAL HADRON NUCLEON CROSS SECTIONS FOR NUCLEONS, |
| 60 | C PIONS, KAONS AND ANTI-NUCLEONS. |
| 61 | C ALP = EXPONENT OF THE PARAMETRIZATION FOR ANTI-PROTONS, |
| 62 | C RANTI-NEUTRONS AND KAONS |
| 63 | C BET = MULTIPLIER OF PARAMETRIZATION FOR ANTI-PROTONS, |
| 64 | C ANTI-NEUTRONS AND KAONS |
| 65 | C |
| 66 | C NOTE1: PRESENTLY CROSS SECTIONS ARE ASSUMED TO BE CONSTANT |
| 67 | C ABOVE 10.0 GEV/C FOR ALL PARTICLES AND |
| 68 | C BELOW 0.3 GEV/C FOR NUCLEONS AND BELOW 0.13 GEV/C FOR PIONS |
| 69 | C |
| 70 | C NOTE2: FOR HADRONS OTHER THAN (1=PROTON,2=ANTI PROTON,8= |
| 71 | C NEUTRON,9=ANTI NEUTRON,13=POSITIVE PION,14=NEGATIVE PION,15= |
| 72 | C POSITIVE KAON,16=NEGATIVE KAON,24=NEUTRAL KAON,25=NEUTRAL ANTI |
| 73 | C KAON) SEE TABLE ITT TO SEE THE CORRESPONDANCE |
| 74 | C |
| 75 | C NOTE3: FOR LEPTONS AND PHOTONS PRACTICALLY ZERO CROSS SECTION |
| 76 | C IS RETURNED. |
| 77 | C |
| 78 | C******************************************************************** |
| 79 | C |
| 80 | #include "geant321/paprop.inc" |
| 81 | PARAMETER (AVOGMB=AVOGAD*1.D-27) |
| 82 | C-------------------------------------------------------------------- |
| 83 | DIMENSION SIG(13,9),SEG(16,9),P(16),A(9),ITT(39) |
| 84 | DIMENSION PLAB(19),SITO(19,4),ALP(3),BET(3) |
| 85 | DIMENSION REA(9,9),STOT(9) |
| 86 | SAVE A, P, SIG, SEG, ITT, SITO, PLAB, ALP, BET, STOT, REA |
| 87 | DATA A/9.D0,12.D0,27.D0,47.9D0,55.9D0,63.5D0,112.4D0, |
| 88 | &207.2D0,238.1D0/ |
| 89 | DATA P/.13D0,.19D0,.25D0,.3D0,.4D0,.5D0,.6D0,.8D0,1.D0, |
| 90 | &1.5D0,2.D0,3.D0,4.D0,5.D0,6.D0,10.D0/ |
| 91 | DATA SIG/ 485.D0,223.D0,112.D0,82.D0,66.D0,78.D0,96.D0,102.D0, |
| 92 | &100.D0,98.D0,95.D0,90.D0,79.D0, |
| 93 | (680.D0,348.D0,175.D0,103.D0,84.D0,87.D0,106.D0,112.D0,111.D0, |
| 94 | &108.D0,107.D0,105.D0,101.D0, |
| 95 | (1200.D0,738.D0,387.D0,196.D0,191.D0,200.D0,248.D0,264.D0, |
| 96 | &264.D0,257.D0,252.D0,247.D0,228.D0, |
| 97 | (1658.D0,1110.D0,635.D0,364.D0,332.D0,356.D0,404.D0,408.D0, |
| 98 | &407.D0,404.D0,398.D0,396.D0,384.D0, |
| 99 | (1730.D0,1270.D0,725.D0,400.D0,375.D0,412.D0,495.D0,505.D0, |
| 100 | &495.D0,492.D0,487.D0,485.D0,475.D0, |
| 101 | (1875.D0,1470.D0,835.D0,480.D0,450.D0,450.D0,535.D0, |
| 102 | &580.D0,555.D0,540.D0,535.D0,530.D0, |
| 103 | (525.D0,2040.D0,2160.D0,1335.D0,850.D0,740.D0,760.D0,880.D0, |
| 104 | &905.D0,860.D0,840.D0,820.D0,815.D0,800.D0, |
| 105 | (2340.D0,2980.D0,2270.D0,1450.D0,1230.D0,1230.D0, |
| 106 | &1380.D0,1420.D0,1410.D0,1380.D0,1360.D0, |
| 107 | (1350.D0,1320.D0,2680.D0,3220.D0,2530.D0,1630.D0,1420.D0,1450.D0, |
| 108 | &1570.D0,1600.D0,1590.D0,1575.D0,1560.D0,1550.D0,1540.D0/ |
| 109 | DATA SEG/24.D0,128.D0,249.D0,256.D0,202.D0,124.D0,73.D0,60.D0, |
| 110 | &64.D0,69.D0,62.D0,50.D0,44.D0,42.D0,42.D0,41.D0,21.D0,156.D0, |
| 111 | (273.D0,280.D0,220.D0,212.D0,94.D0,80.D0,82.D0,85.D0,80.D0,73.D0, |
| 112 | (69.D0,67.D0,66.D0,64.D0,56.D0,296.D0,560.D0,574.D0,467.D0,350.D0, |
| 113 | &235.D0,210.D0,210.D0,200.D0,190.D0,183.D0,176.D0,170.D0,165.D0, |
| 114 | (155.D0,100.D0,500.D0,895.D0,880.D0,690.D0,520.D0,378.D0, |
| 115 | (355.D0,384.D0,373.D0,352.D0,320.D0,300.D0,288.D0,280.D0, |
| 116 | &262.D0,75.D0,500.D0,965.D0,990.D0,775.D0,525.D0,410.D0,410.D0, |
| 117 | (433.D0,440.D0,425.D0,395.D0,374.D0,355.D0,340.D0,303.D0,125.D0, |
| 118 | (570.D0,1025.D0,1100.D0,825.D0,575.D0,418.D0,458.D0,500.D0, |
| 119 | &480.D0,460.D0,440.D0,422.D0,400.D0,384.D0,355.D0,300.D0,880.D0, |
| 120 | (1480.D0,1550.D0,1380.D0,940.D0,710.D0,720.D0,810.D0,760.D0, |
| 121 | (740.D0,700.D0,665.D0,645.D0,620.D0,570.D0,550.D0,1475.D0, |
| 122 | &2250.D0,2350.D0,1850.D0,1500.D0, |
| 123 | (1120.D0,1210.D0,1480.D0,1440.D0,1400.D0,1320.D0, |
| 124 | &1250.D0,1210.D0,1170.D0,1065.D0,540.D0, |
| 125 | (1300.D0,2220.D0,2560.D0,1980.D0,1650.D0,1160.D0, |
| 126 | &1360.D0,1600.D0,1560.D0,1510.D0,1410.D0, |
| 127 | (1350.D0,1300.D0,1270.D0,1200.D0/ |
| 128 | C DATA ITT/1,7,0,0,0,0,0,2,8,0,0,9,3,4,6,5,1,2,9,1,1,1,3,9,10, |
| 129 | DATA ITT/1,7,0,0,0,0,0,2,8,0,0,9,3,4,6,5,2,8,9,1,1,2,3,9,10, |
| 130 | & 3,0,0,0,0,7,2,7,2,8,1,7,1,7/ |
| 131 | DATA PLAB/.3D0,.4D0,.5D0,.6D0,.7D0,.8D0,.9D0,1.D0,1.1D0, |
| 132 | &1.2D0,1.3D0,1.4D0,1.5D0,2.D0,3.D0,4.D0, |
| 133 | *5.D0,6.D0,10.D0/ |
| 134 | DATA SITO/66.8D0,63.6D0,40.35D0,31.25D0,31.1D0, |
| 135 | *35.1D0,36.7D0,44.15D0,38.3D0,33.25D0, |
| 136 | *29.75D0,29.3D0,29.95D0,26.55D0,24.6D0,22.95D0, |
| 137 | *22.75D0,22.95D0,21.55D0, |
| 138 | *12.5D0,14.1D0,13.5D0,12.75D0,12.85D0,13.9D0,15.6D0, |
| 139 | *17.25D0,18.9D0,19.5D0,18.95D0,18.85D0, |
| 140 | *18.45D0,18.2D0,17.5D0,17.7D0,17.5D0,17.25D0,17.4D0, |
| 141 | *39.65D0,38.75D0,26.9D0,22.D0,22.D0,24.5D0,26.15D0,30.7D0,28.6D0, |
| 142 | &26.4D0,24.35D0,24.1D0,24.2D0 |
| 143 | (,22.4D0,21.05D0,20.3D0,20.1D0,20.1D0,19.5D0, |
| 144 | (280.D0,199.7D0,171.1D0,154.3D0,140.D0,130.D0,116.8D0,117.4D0, |
| 145 | &111.6D0,109.D0,106.5D0, |
| 146 | (102.8D0,100.D0,90.2D0,76.7D0,68.D0,62.8D0,60.7D0,56.D0/ |
| 147 | DATA ALP/0.823D0,0.843D0,0.630D0/ |
| 148 | DATA BET/1.26D0,1.31D0,0.90D0/ |
| 149 | DATA STOT /15.D0,20.D0,30.D0,40.D0,60.D0,80.D0, |
| 150 | &100.D0,150.D0,200.D0/ |
| 151 | DATA REA / .20D0,.23D0,.27D0,.30D0,.35D0,.40D0,.47D0,.55D0,.60D0, |
| 152 | 2 .22D0,.26D0,.31D0,.35D0,.40D0,.45D0,.51D0,.59D0,.63D0, |
| 153 | 3 .24D0,.29D0,.36D0,.42D0,.50D0,.56D0,.60D0,.66D0,.68D0, |
| 154 | 4 .26D0,.32D0,.42D0,.49D0,.58D0,.63D0,.66D0,.71D0,.72D0, |
| 155 | 5 .27D0,.33D0,.44D0,.51D0,.61D0,.65D0,.68D0,.72D0,.74D0, |
| 156 | 6 .28D0,.35D0,.46D0,.53D0,.63D0,.66D0,.69D0,.73D0,.745D0, |
| 157 | 7 .35D0,.42D0,.53D0,.62D0,.69D0,.72D0,.74D0,.77D0,.78D0, |
| 158 | 8 .42D0,.51D0,.62D0,.69D0,.75D0,.77D0,.79D0,.81D0,.82D0, |
| 159 | 9 .44D0,.53D0,.64D0,.70D0,.76D0,.78D0,.80D0,.81D0,.82D0 / |
| 160 | C |
| 161 | C |
| 162 | C |
| 163 | SEL = AZRZRZ |
| 164 | ZL = AINFNT |
| 165 | IF(AA.LT.0.99D0)RETURN |
| 166 | IPOL=0 |
| 167 | PO=POO |
| 168 | EKE=EKIN |
| 169 | * Set a very large kinetic energy for the call to Nizl to bypass |
| 170 | * any check on inelastic events thresholds |
| 171 | EKINFN=AINFNT |
| 172 | IIT=ITT(IT) |
| 173 | IF (IIT.EQ.0) RETURN |
| 174 | C--------------------------------------------------------- |
| 175 | C** ELASTIC SCATTERING ON PROTONS |
| 176 | C HJM 10/88 REASONABLE FOR P, N, PI+/- |
| 177 | C** |
| 178 | IF((AA.LT.1.5D0).AND. (IT.EQ.1.OR.IT.EQ.8.OR.IT.EQ.13 |
| 179 | * .OR.IT.EQ.14.OR.IT.EQ.2.OR.IT.EQ.9)) THEN |
| 180 | C** EKE=SQRT(PO**2+AM(IT)**2) - AM(IT) |
| 181 | * Return if kinetic energy is below 15 MeV (A. Ferrari) |
| 182 | IF ( EKE .LT. 0.015D+00 ) RETURN |
| 183 | IF ( IT .EQ. 9 ) THEN |
| 184 | IJT = 1 |
| 185 | ELSE IF ( IT .EQ. 2 ) THEN |
| 186 | IJT = 8 |
| 187 | ELSE |
| 188 | IJT = IT |
| 189 | END IF |
| 190 | CALL SIHAEL(IJT,EKE,PO,AA,SEL) |
| 191 | GOTO 124 |
| 192 | END IF |
| 193 | C** |
| 194 | C NEUTRON-NUCLEUS ELASTIC SCATTERING |
| 195 | C DATA FROM HETKFA2 FOR EKIN .GT. 15 MEV |
| 196 | C FOR PLOTS SEE |
| 197 | C P. CLOTH ET AL., |
| 198 | C HERMES - A MC PROGRAM SYSTEM ... |
| 199 | C JUEL-2203 (MAY 1988) |
| 200 | C |
| 201 | * IF((IT.EQ.8.OR.IT.EQ.1.OR.IT.EQ.2.OR.IT.EQ.9).AND.PO.LT.20.D0) |
| 202 | * & THEN |
| 203 | IF(IT.EQ.8.AND.PO.LT.20.D0)THEN |
| 204 | * Return if kinetic energy is below 15 MeV (A. Ferrari) |
| 205 | IF ( EKE .LT. 0.015D+00 ) RETURN |
| 206 | IF ( IT .EQ. 9 ) THEN |
| 207 | IJT = 1 |
| 208 | ELSE IF ( IT .EQ. 2 ) THEN |
| 209 | IJT = 8 |
| 210 | ELSE |
| 211 | IJT = IT |
| 212 | END IF |
| 213 | IF(PO.GT.10.D0) THEN |
| 214 | IPOL=1 |
| 215 | PO=10.D0 |
| 216 | EKE=SQRT(PO**2+AM(IT)**2) - AM(IT) |
| 217 | END IF |
| 218 | C** EKE=SQRT(PO**2+AM(IT)**2) - AM(IT) |
| 219 | CALL SIHAEL(IJT,EKE,PO,AA,SEL) |
| 220 | IF(IPOL.EQ.1) GOTO 210 |
| 221 | GOTO 124 |
| 222 | ENDIF |
| 223 | IF ( EKE .LT. 0.020D+00 ) RETURN |
| 224 | C----------------------------------------------------------- |
| 225 | C |
| 226 | C |
| 227 | C******************************************************************** |
| 228 | C CALCULATE THE NEW PARTICLE NUMBER IIT: 1=P,2=N,3=PI+,4=PI-, |
| 229 | C 5=K-,6=K+,7=P BAR,8=N BAR,9=K ZERO ,10=K ZERO BAR |
| 230 | C******************************************************************** |
| 231 | C |
| 232 | IF((IIT.EQ.7).OR.(IIT.EQ.8)) GOTO 200 |
| 233 | IF (PO.GT.20.D0) GOTO 200 |
| 234 | IF(PO.LE.10.D0) GOTO 30 |
| 235 | PO=10.D0 |
| 236 | IPOL=1 |
| 237 | 30 CONTINUE |
| 238 | IF(IIT.LE.4) GO TO 10 |
| 239 | C |
| 240 | C******************************************************************** |
| 241 | C MOMENTUM INDEX K FOR KAONS ANTI KAONS AND ANTI NUCLEONS |
| 242 | C******************************************************************** |
| 243 | C |
| 244 | DO 3 K=1,19 |
| 245 | IF(PO.LE.PLAB(K)) GO TO 40 |
| 246 | 3 CONTINUE |
| 247 | K=19 |
| 248 | 40 GO TO 7 |
| 249 | C |
| 250 | C******************************************************************** |
| 251 | C CALCULATE THE MOMENTUM INDEX K FOR NUCLEONS AND PIONS |
| 252 | C CALCULATE THE MASS INDEX J OF THE NUCLEUS |
| 253 | C******************************************************************** |
| 254 | C |
| 255 | 10 CONTINUE |
| 256 | DO 22 K=1,16 |
| 257 | IF(PO.LE.P(K)) GO TO 23 |
| 258 | 22 CONTINUE |
| 259 | K=16 |
| 260 | 23 CONTINUE |
| 261 | DO 5 I=2,8 |
| 262 | IF(AA.LE.A(I)) GO TO 6 |
| 263 | GO TO 5 |
| 264 | 6 CONTINUE |
| 265 | J=I-1 |
| 266 | GO TO 7 |
| 267 | 5 CONTINUE |
| 268 | J=8 |
| 269 | C |
| 270 | C******************************************************************** |
| 271 | C SELECT THE FORMULEI TO BE USED FOR DIFFERENT PARTICLE TYPES |
| 272 | C******************************************************************** |
| 273 | C |
| 274 | 7 CONTINUE |
| 275 | C P , N ,PI+,PI-,K- ,K+ ,AP ,AN ,K0 ,AK0 |
| 276 | GO TO (101,101,113,113,116,115,102,109,115,116),IIT |
| 277 | C******************** PROTONS,NEUTRONS,OTHERS |
| 278 | 101 K=K-3 |
| 279 | IF(K.LT.1) K=1 |
| 280 | ALOGA=LOG(A(J+1)/A(J)) |
| 281 | AAA=AA/A(J) |
| 282 | SI1=SIG(K,J)* AAA **(LOG(SIG(K,J+1)/SIG(K,J))/ALOGA) |
| 283 | IF(K.EQ.1) GO TO 2000 |
| 284 | KK=K-1 |
| 285 | SI2=SIG(KK,J)* AAA **(LOG(SIG(KK,J+1)/SIG(KK,J))/ALOGA) |
| 286 | K=K+3 |
| 287 | KK=KK+3 |
| 288 | SI=SI1+(PO-P(K))*(SI2-SI1)/(P(KK)-P(K)) |
| 289 | C |
| 290 | SEL=SI |
| 291 | C |
| 292 | GO TO 121 |
| 293 | C******************** CHARGED PIONS |
| 294 | 113 CONTINUE |
| 295 | ALOGA=LOG(A(J+1)/A(J)) |
| 296 | AAA=AA/A(J) |
| 297 | SI1=SEG(K,J)* AAA **(LOG(SEG(K,J+1)/SEG(K,J))/ALOGA) |
| 298 | IF(K.EQ.1) GO TO 2000 |
| 299 | KK=K-1 |
| 300 | SI2=SEG(KK,J)* AAA **(LOG(SEG(KK,J+1)/SEG(KK,J))/ALOGA) |
| 301 | SI=SI1+(PO-P(K))*(SI2-SI1)/(P(KK)-P(K)) |
| 302 | C |
| 303 | SEL=SI |
| 304 | C |
| 305 | GO TO 121 |
| 306 | C******************** K-,K ZERO BAR |
| 307 | 116 CONTINUE |
| 308 | IA=1 |
| 309 | IS=1 |
| 310 | GO TO 122 |
| 311 | C******************** K+, K ZERO |
| 312 | 115 CONTINUE |
| 313 | IA=2 |
| 314 | IS=2 |
| 315 | GO TO 122 |
| 316 | C******************** P BAR |
| 317 | 102 CONTINUE |
| 318 | C******************** N BAR |
| 319 | 109 CONTINUE |
| 320 | C |
| 321 | PO=POO |
| 322 | GOTO 200 |
| 323 | C |
| 324 | C |
| 325 | C******************************************************************** |
| 326 | C KAONS, ANTI KAONS |
| 327 | C******************************************************************** |
| 328 | C |
| 329 | 122 KK=K-1 |
| 330 | IF(K.EQ.1) GO TO 140 |
| 331 | PKK=PLAB(KK) |
| 332 | SIKK=SITO(KK,IS) |
| 333 | SI=(SITO(K,IS)-SIKK)*(PO-PKK)/(PLAB(K)-PKK)+SIKK |
| 334 | GO TO 141 |
| 335 | 140 SI=SITO(K,IS) |
| 336 | 141 SI1=SI |
| 337 | SI=BET(IA)*SI*AA**ALP(IA) |
| 338 | IV=IT |
| 339 | IF(IV.NE.24)GO TO 150 |
| 340 | IV=15 |
| 341 | SI=SI*2.06D0 |
| 342 | GO TO 151 |
| 343 | 150 IF(IV.EQ.25) IV=16 |
| 344 | 151 CALL NIZL(IV,AA,EKINFN,PO,SINEL,ZLIN) |
| 345 | C |
| 346 | SEL=SI-SINEL |
| 347 | IF(IPOL.EQ.1) GOTO 210 |
| 348 | GOTO 121 |
| 349 | C |
| 350 | C******************************************************************** |
| 351 | C AND NOW THE SCATTERING LENGTH IN G/CM**2 |
| 352 | C******************************************************************** |
| 353 | C |
| 354 | 121 CONTINUE |
| 355 | IF(IPOL.EQ.1) GOTO 210 |
| 356 | 124 CONTINUE |
| 357 | C |
| 358 | IF (SEL.LT.ANGLGB) THEN |
| 359 | SEL = AZRZRZ |
| 360 | ZL = AINFNT |
| 361 | ELSE |
| 362 | ZL=AA/(AVOGMB*SEL) |
| 363 | END IF |
| 364 | RETURN |
| 365 | C |
| 366 | C******************************************************************** |
| 367 | C WE ARE IN THE LOWEST MOMENTUM BIN |
| 368 | C******************************************************************** |
| 369 | C |
| 370 | 2000 CONTINUE |
| 371 | SI=SI1 |
| 372 | SEL=SI |
| 373 | GO TO 121 |
| 374 | C*** |
| 375 | C ENTRY FOR SMOOTHING OF SIGEL BETWEEN 10. AND 20. GEV/C |
| 376 | C*** |
| 377 | 210 CONTINUE |
| 378 | PO=20.D0 |
| 379 | C*** |
| 380 | C APPROXIMATION FOR HIGH ENERGIES |
| 381 | C*** |
| 382 | 200 CONTINUE |
| 383 | C |
| 384 | IT1=IT |
| 385 | IF((IT.EQ.2).OR.(IT.EQ.9)) IT1=1 |
| 386 | C |
| 387 | STO=SHPTOT(IT1,PO) |
| 388 | C |
| 389 | C MASS NUMBER INDEX |
| 390 | C*** |
| 391 | DO 201 IA=2,8 |
| 392 | IF(AA.GT.A(IA)) GOTO 201 |
| 393 | JA=IA-1 |
| 394 | GOTO 202 |
| 395 | 201 CONTINUE |
| 396 | JA=8 |
| 397 | 202 CONTINUE |
| 398 | C*** |
| 399 | C SIGTOT INDEX |
| 400 | C*** |
| 401 | DO 203 IS=2,8 |
| 402 | IF(STO.GT.STOT(IS)) GOTO 203 |
| 403 | JS=IS-1 |
| 404 | GOTO 204 |
| 405 | 203 CONTINUE |
| 406 | JS=8 |
| 407 | 204 CONTINUE |
| 408 | C |
| 409 | DA1=A(JA+1)-A(JA) |
| 410 | DA2=AA - A(JA) |
| 411 | RR=REA(JS,JA) |
| 412 | R1=RR + DA2*(REA(JS,JA+1)-RR)/DA1 |
| 413 | RR=REA(JS+1,JA) |
| 414 | R2=RR + DA2*(REA(JS+1,JA+1)-RR)/DA1 |
| 415 | RACT=R1 + (STO-STOT(JS))*(R2-R1)/(STOT(JS+1)-STOT(JS)) |
| 416 | C |
| 417 | CALL NIZL(IT,AA,EKINFN,PO,SINEL1,ZLIN) |
| 418 | SEL1=RACT*SINEL1 |
| 419 | IF(IPOL.EQ.1) GOTO 211 |
| 420 | SEL=SEL1 |
| 421 | GOTO 124 |
| 422 | C |
| 423 | 211 CONTINUE |
| 424 | SEL=SEL + (SEL1-SEL)*(POO-10.D0)/10.D0 |
| 425 | GOTO 124 |
| 426 | C |
| 427 | C |
| 428 | C******************************************************************** |
| 429 | C FORMATS |
| 430 | C******************************************************************** |
| 431 | C |
| 432 | 1000 FORMAT(' WARNING AT CALL SIGEL ',I5) |
| 433 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame