| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1995/10/24 10:22:04 cernlib |
| 6 | * Geant |
| 7 | * |
| 8 | * |
| 9 | #include "geant321/pilot.h" |
| 10 | *CMZ : 3.21/02 29/03/94 15.41.46 by S.Giani |
| 11 | *-- Author : |
| 12 | *$ CREATE SIGFER.FOR |
| 13 | *COPY SIGFER |
| 14 | * |
| 15 | *=== sigfer ===========================================================* |
| 16 | * |
| 17 | SUBROUTINE SIGFER ( KP, EKIN, POO, LFERMI ) |
| 18 | |
| 19 | #include "geant321/dblprc.inc" |
| 20 | #include "geant321/dimpar.inc" |
| 21 | #include "geant321/iounit.inc" |
| 22 | * |
| 23 | *----------------------------------------------------------------------* |
| 24 | *----------------------------------------------------------------------* |
| 25 | * |
| 26 | #include "geant321/nucdat.inc" |
| 27 | #include "geant321/nucgeo.inc" |
| 28 | #include "geant321/paprop.inc" |
| 29 | LOGICAL LFERMI |
| 30 | * |
| 31 | IF ( LFERMI ) THEN |
| 32 | EKEWLL = EKIN + VPRBIM |
| 33 | EEMAX = EKEWLL + EKFBIM + AMNUCL (ITNCMX) + AM (KP) |
| 34 | PPRWLL = SQRT ( EKEWLL * ( EKEWLL + 2.D+00 * AM (KP) ) ) |
| 35 | IF ( PFRBIM .LT. PPRWLL ) THEN |
| 36 | PPMAX = PPRWLL + PFRBIM |
| 37 | PPMIN = PPRWLL - PFRBIM |
| 38 | UMO2 = ( EEMAX + PPMAX ) * ( EEMAX - PPMAX ) |
| 39 | EKEMIN = 0.5D+00 * ( UMO2 - AM (KP)**2 - AMNUSQ (ITNCMX) ) |
| 40 | & / AMNUCL (ITNCMX) - AM (KP) |
| 41 | EKEMIN = MIN ( EKIN, EKEMIN ) |
| 42 | TMPEKI = 0.1666D+00 * EKIN |
| 43 | EKEMIN = MAX ( EKEMIN, TMPEKI ) |
| 44 | ELSE |
| 45 | EKEMIN = MAX ( 0.005D+00, 0.1666D+00 * EKIN ) |
| 46 | PPMIN = 0.D+00 |
| 47 | END IF |
| 48 | PPRMIN = SQRT ( EKEMIN * ( EKEMIN + 2.D+00 * AM (KP) ) ) |
| 49 | UMO2 = ( EEMAX + PPMIN ) * ( EEMAX - PPMIN ) |
| 50 | EKEMAX = 0.5D+00 * ( UMO2 - AM (KP)**2 - AMNUSQ (ITNCMX) ) |
| 51 | & / AMNUCL (ITNCMX) - AM (KP) |
| 52 | PPRMAX = SQRT ( EKEMAX * ( EKEMAX + 2.D+00 * AM (KP) ) ) |
| 53 | ELSE |
| 54 | EKEMIN = EKIN |
| 55 | PPRMIN = POO |
| 56 | EKEMAX = EKIN |
| 57 | PPRMAX = POO |
| 58 | END IF |
| 59 | * |
| 60 | 50 CONTINUE |
| 61 | GO TO ( 100, 200, 300, 400, 500, 600, 700, 800, 900, |
| 62 | & 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, |
| 63 | & 1900, 2000, 2100, 2200, 2300, 2400, 2500, 2600, 2700, |
| 64 | & 2800, 2900, 3000, 3100, 3200, 3300, 3400, 3500, 3600, |
| 65 | & 3700, 3800, 3900 ), KP |
| 66 | STOP 'GEO-KP' |
| 67 | 100 CONTINUE |
| 68 | IF ( EKEMIN .LE. 0.700D+00 ) THEN |
| 69 | BETAPR = PPRMIN / ( EKEMIN + AM (KP) ) |
| 70 | IF ( EKEMIN .LE. 0.04D+00 ) THEN |
| 71 | SIGMAN = 3.D+03 * PI / ( 1.206D+03 * EKEMIN + ( -1.86D+00 |
| 72 | & + 0.09415D+03 * EKEMIN + 0.0001306D+06 * EKEMIN**2 |
| 73 | & )**2 ) + 1.D+03 * PI / ( 1.206D+03 * EKEMIN |
| 74 | & + ( 0.4223D+00 + 0.13D+03 * EKEMIN )**2 ) |
| 75 | IF ( EKEMIN .LT. 0.02D+00 ) THEN |
| 76 | SIGMAP = 0.3333333333333333D+00 * SIGMAN |
| 77 | ELSE |
| 78 | SIGMAP = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR |
| 79 | & + 42.9D+00 |
| 80 | END IF |
| 81 | ELSE |
| 82 | SIGMAN = 34.10D+00 / BETAPR**2 - 82.2D+00 / BETAPR |
| 83 | & + 82.2D+00 |
| 84 | SIGMAP = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR |
| 85 | & + 42.9D+00 |
| 86 | END IF |
| 87 | ELSE |
| 88 | STOP 'Sigfer: EKE' |
| 89 | END IF |
| 90 | GO TO 4000 |
| 91 | 200 CONTINUE |
| 92 | GO TO 4000 |
| 93 | 300 CONTINUE |
| 94 | GO TO 4000 |
| 95 | 400 CONTINUE |
| 96 | GO TO 4000 |
| 97 | 500 CONTINUE |
| 98 | GO TO 4000 |
| 99 | 600 CONTINUE |
| 100 | GO TO 4000 |
| 101 | 700 CONTINUE |
| 102 | SIGMAN = 0.D+00 |
| 103 | SIGMAP = 0.D+00 |
| 104 | GO TO 4000 |
| 105 | 800 CONTINUE |
| 106 | IF ( EKEMIN .LE. 0.700D+00 ) THEN |
| 107 | BETAPR = PPRMIN / ( EKEMIN + AM (KP) ) |
| 108 | IF ( EKEMIN .LE. 0.04D+00 ) THEN |
| 109 | SIGMAP = 3.D+03 * PI / ( 1.206D+03 * EKEMIN + ( -1.86D+00 |
| 110 | & + 0.09415D+03 * EKEMIN + 0.0001306D+06 * EKEMIN**2 |
| 111 | & )**2 ) + 1.D+03 * PI / ( 1.206D+03 * EKEMIN |
| 112 | & + ( 0.4223D+00 + 0.13D+03 * EKEMIN )**2 ) |
| 113 | IF ( EKEMIN .LT. 0.02D+00 ) THEN |
| 114 | SIGMAN = 0.3333333333333333D+00 * SIGMAP |
| 115 | ELSE |
| 116 | SIGMAN = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR |
| 117 | & + 42.9D+00 |
| 118 | END IF |
| 119 | ELSE |
| 120 | SIGMAP = 34.10D+00 / BETAPR**2 - 82.2D+00 / BETAPR |
| 121 | & + 82.2D+00 |
| 122 | SIGMAN = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR |
| 123 | & + 42.9D+00 |
| 124 | END IF |
| 125 | ELSE |
| 126 | STOP 'Sigfer: EKE' |
| 127 | END IF |
| 128 | GO TO 4000 |
| 129 | 900 CONTINUE |
| 130 | GO TO 4000 |
| 131 | 1000 CONTINUE |
| 132 | GO TO 4000 |
| 133 | 1100 CONTINUE |
| 134 | GO TO 4000 |
| 135 | 1200 CONTINUE |
| 136 | GO TO 4000 |
| 137 | 1300 CONTINUE |
| 138 | GO TO 4000 |
| 139 | 1400 CONTINUE |
| 140 | GO TO 4000 |
| 141 | 1500 CONTINUE |
| 142 | GO TO 4000 |
| 143 | 1600 CONTINUE |
| 144 | GO TO 4000 |
| 145 | 1700 CONTINUE |
| 146 | GO TO 4000 |
| 147 | 1800 CONTINUE |
| 148 | GO TO 4000 |
| 149 | 1900 CONTINUE |
| 150 | GO TO 4000 |
| 151 | 2000 CONTINUE |
| 152 | GO TO 4000 |
| 153 | 2100 CONTINUE |
| 154 | GO TO 4000 |
| 155 | 2200 CONTINUE |
| 156 | GO TO 4000 |
| 157 | 2300 CONTINUE |
| 158 | GO TO 4000 |
| 159 | 2400 CONTINUE |
| 160 | GO TO 4000 |
| 161 | 2500 CONTINUE |
| 162 | GO TO 4000 |
| 163 | 2600 CONTINUE |
| 164 | GO TO 4000 |
| 165 | 2700 CONTINUE |
| 166 | GO TO 4000 |
| 167 | 2800 CONTINUE |
| 168 | GO TO 4000 |
| 169 | 2900 CONTINUE |
| 170 | GO TO 4000 |
| 171 | 3000 CONTINUE |
| 172 | GO TO 4000 |
| 173 | 3100 CONTINUE |
| 174 | GO TO 4000 |
| 175 | 3200 CONTINUE |
| 176 | GO TO 4000 |
| 177 | 3300 CONTINUE |
| 178 | GO TO 4000 |
| 179 | 3400 CONTINUE |
| 180 | GO TO 4000 |
| 181 | 3500 CONTINUE |
| 182 | GO TO 4000 |
| 183 | 3600 CONTINUE |
| 184 | GO TO 4000 |
| 185 | 3700 CONTINUE |
| 186 | GO TO 4000 |
| 187 | 3800 CONTINUE |
| 188 | GO TO 4000 |
| 189 | 3900 CONTINUE |
| 190 | GO TO 4000 |
| 191 | 4000 CONTINUE |
| 192 | SIGMAP = 0.1D+00 * SIGMAP |
| 193 | SIGMAN = 0.1D+00 * SIGMAN |
| 194 | RETURN |
| 195 | *=== End of subroutine sigfer =========================================* |
| 196 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame