*=== Cf252 neutron source ===========================================================* * SUBROUTINE SOURCE ( NOMORE ) INCLUDE '(DBLPRC)' INCLUDE '(DIMPAR)' INCLUDE '(IOUNIT)' * INCLUDE '(BEAMCM)' INCLUDE '(FHEAVY)' INCLUDE '(FLKSTK)' INCLUDE '(IOIOCM)' INCLUDE '(LTCLCM)' INCLUDE '(PAPROP)' INCLUDE '(SOURCM)' INCLUDE '(SUMCOU)' * LOGICAL LFIRST * SAVE LFIRST DATA LFIRST / .TRUE. / *======================================================================* NOMORE = 0 * +-------------------------------------------------------------------* * | First call initializations: IF ( LFIRST ) THEN * | *** The following 3 cards are mandatory *** TKESUM = ZERZER LFIRST = .FALSE. LUSSRC = .TRUE. * | *** User initialization *** c*****cf252 neutron source if(FLRNDM.lt.3.09152E-10) then ENK = 4.14E-10 IF(FLRNDM.ge.3.09152E-10 .and. FLRNDM.lt.1.13788E-08) ENK = 1.00E-09 IF(FLRNDM.ge.1.13788E-08 .and. FLRNDM.lt.1.38031E-07) ENK = 1.00E-08 IF(FLRNDM.ge.1.38031E-07 .and. FLRNDM.lt.4.13276E-07) ENK = 5.00E-08 IF(FLRNDM.ge.4.13276E-07 .and. FLRNDM.lt.1.19314E-06) ENK = 1.00E-07 if(FLRNDM.ge.1.19314E-06 .and. FLRNDM.lt.3.39709E-06) ENK = 2.00E-07 IF(FLRNDM.ge.3.39709E-06 .and. FLRNDM.lt.7.91470E-06) ENK = 4.00E-07 IF(FLRNDM.ge.7.91470E-06 .and. FLRNDM.lt.1.35792E-05) ENK = 7.00E-07 IF(FLRNDM.ge.1.35792E-05 .and. FLRNDM.lt.6.85284E-05) ENK = 1.00E-06 IF(FLRNDM.ge.6.85284E-05 .and. FLRNDM.lt.1.96178E-04) ENK = 3.00E-06 IF(FLRNDM.ge.1.96178E-04 .and. FLRNDM.lt.4.25549E-04) ENK = 6.00E-06 IF(FLRNDM.ge.4.25549E-04 .and. FLRNDM.lt.1.19743E-03) ENK = 1.00E-05 IF(FLRNDM.ge.1.19743E-03 .and. FLRNDM.lt.3.36150E-03) ENK = 2.00E-05 IF(FLRNDM.ge.3.36150E-03 .and. FLRNDM.lt.6.15384E-03) ENK = 4.00E-05 IF(FLRNDM.ge.6.15384E-03 .and. FLRNDM.lt.9.43484E-03) ENK = 6.00E-05 IF(FLRNDM.ge.9.43484E-03 .and. FLRNDM.lt.1.31048E-02) ENK = 8.00E-05 IF(FLRNDM.ge.1.31048E-02 .and. FLRNDM.lt.2.35760E-02) ENK = 1.00E-04 IF(FLRNDM.ge.2.35760E-02 .and. FLRNDM.lt.3.56429E-02) ENK = 1.50E-04 IF(FLRNDM.ge.3.56429E-02 .and. FLRNDM.lt.4.89066E-02) ENK = 2.00E-04 IF(FLRNDM.ge.4.89066E-02 .and. FLRNDM.lt.6.30677E-02) ENK = 2.50E-04 IF(FLRNDM.ge.6.30677E-02 .and. FLRNDM.lt.7.79270E-02) ENK = 3.00E-04 IF(FLRNDM.ge.7.79270E-02 .and. FLRNDM.lt.9.33846E-02) ENK = 3.50E-04 IF(FLRNDM.ge.9.33846E-02 .and. FLRNDM.lt.1.09341E-01) ENK = 4.00E-04 IF(FLRNDM.ge.1.09341E-01 .and. FLRNDM.lt.1.25596E-01) ENK = 4.50E-04 IF(FLRNDM.ge.1.25596E-01 .and. FLRNDM.lt.1.42151E-01) ENK = 5.00E-04 IF(FLRNDM.ge.1.42151E-01 .and. FLRNDM.lt.1.58905E-01) ENK = 5.50E-04 IF(FLRNDM.ge.1.58905E-01 .and. FLRNDM.lt.1.92612E-01) ENK = 6.00E-04 IF(FLRNDM.ge.1.92612E-01 .and. FLRNDM.lt.2.26420E-01) ENK = 7.00E-04 IF(FLRNDM.ge.2.26420E-01 .and. FLRNDM.lt.2.60027E-01) ENK = 8.00E-04 IF(FLRNDM.ge.2.60027E-01 .and. FLRNDM.lt.2.93236E-01) ENK = 9.00E-04 IF(FLRNDM.ge.2.93236E-01 .and. FLRNDM.lt.3.57660E-01) ENK = 1.00E-03 IF(FLRNDM.ge.3.57660E-01 .and. FLRNDM.lt.4.18692E-01) ENK = 1.20E-03 IF(FLRNDM.ge.4.18692E-01 .and. FLRNDM.lt.4.75835E-01) ENK = 1.40E-03 IF(FLRNDM.ge.4.75835E-01 .and. FLRNDM.lt.5.28790E-01) ENK = 1.60E-03 IF(FLRNDM.ge.5.28790E-01 .and. FLRNDM.lt.5.77457E-01) ENK = 1.80E-03 IF(FLRNDM.ge.5.77457E-01 .and. FLRNDM.lt.6.42778E-01) ENK = 2.00E-03 IF(FLRNDM.ge.6.42778E-01 .and. FLRNDM.lt.6.99322E-01) ENK = 2.30E-03 IF(FLRNDM.ge.6.99322E-01 .and. FLRNDM.lt.7.62449E-01) ENK = 2.60E-03 IF(FLRNDM.ge.7.62449E-01 .and. FLRNDM.lt.8.24379E-01) ENK = 3.00E-03 IF(FLRNDM.ge.8.24379E-01 .and. FLRNDM.lt.8.71051E-01) ENK = 3.50E-03 IF(FLRNDM.ge.8.71051E-01 .and. FLRNDM.lt.9.05856E-01) ENK = 4.00E-03 IF(FLRNDM.ge.9.05856E-01 .and. FLRNDM.lt.9.31585E-01) ENK = 4.50E-03 IF(FLRNDM.ge.9.31585E-01 .and. FLRNDM.lt.9.64495E-01) ENK = 5.00E-03 IF(FLRNDM.ge.9.64495E-01 .and. FLRNDM.lt.9.81847E-01) ENK = 6.00E-03 IF(FLRNDM.ge.9.81847E-01 .and. FLRNDM.lt.9.90833E-01) ENK = 7.00E-03 IF(FLRNDM.ge.9.90833E-01 .and. FLRNDM.lt.9.95430E-01) ENK = 8.00E-03 IF(FLRNDM.ge.9.95430E-01 .and. FLRNDM.lt.9.97754E-01) ENK = 9.00E-03 IF(FLRNDM.ge.9.97754E-01 .and. FLRNDM.lt.9.98921E-01) ENK = 1.00E-02 IF(FLRNDM.ge.9.98921E-01 .and. FLRNDM.lt.9.99502E-01) ENK = 1.10E-02 IF(FLRNDM.ge.9.99502E-01 .and. FLRNDM.lt.9.99789E-01) ENK = 1.20E-02 IF(FLRNDM.ge.9.99789E-01 .and. FLRNDM.lt.9.99931E-01) ENK = 1.30E-02 IF(FLRNDM.ge.9.99931E-01 .and. FLRNDM.lt.1.00000E+00) ENK = 1.40E-02 END IF * | * Npflka is the stack counter: of course any time source is called it * must be =0 NPFLKA = NPFLKA + 1 * Wt is the weight of the particle WTFLK (NPFLKA) = ONEONE WEIPRI = WEIPRI + WTFLK (NPFLKA) * Particle type (1=proton.....). Ijbeam is the type set by the BEAM * card * +-------------------------------------------------------------------* * | (Radioactive) isotope: IF ( IJBEAM .EQ. -2 .AND. LRDBEA ) THEN IARES = IPROA IZRES = IPROZ IISRES = IPROM CALL STISBM ( IARES, IZRES, IISRES ) IJHION = IPROZ * 1000 + IPROA IJHION = IJHION * 100 + KXHEAV IONID = IJHION CALL DCDION ( IONID ) CALL SETION ( IONID ) * | * +-------------------------------------------------------------------* * | Heavy ion: ELSE IF ( IJBEAM .EQ. -2 ) THEN IJHION = IPROZ * 1000 + IPROA IJHION = IJHION * 100 + KXHEAV IONID = IJHION CALL DCDION ( IONID ) CALL SETION ( IONID ) ILOFLK (NPFLKA) = IJHION * | Flag this is prompt radiation LRADDC (NPFLKA) = .FALSE. * | * +-------------------------------------------------------------------* * | Normal hadron: ELSE IONID = IJBEAM ILOFLK (NPFLKA) = IJBEAM * | Flag this is prompt radiation LRADDC (NPFLKA) = .FALSE. END IF * | * +-------------------------------------------------------------------* * From this point ..... * Particle generation (1 for primaries) LOFLK (NPFLKA) = 1 * User dependent flag: LOUSE (NPFLKA) = 0 * User dependent spare variables: DO 100 ISPR = 1, MKBMX1 SPAREK (ISPR,NPFLKA) = ZERZER 100 CONTINUE * User dependent spare flags: DO 200 ISPR = 1, MKBMX2 ISPARK (ISPR,NPFLKA) = 0 200 CONTINUE * Save the track number of the stack particle: ISPARK (MKBMX2,NPFLKA) = NPFLKA NPARMA = NPARMA + 1 NUMPAR (NPFLKA) = NPARMA NEVENT (NPFLKA) = 0 DFNEAR (NPFLKA) = +ZERZER * ... to this point: don't change anything * Particle age (s) AGESTK (NPFLKA) = +ZERZER AKNSHR (NPFLKA) = -TWOTWO * Group number for "low" energy neutrons, set to 0 anyway IGROUP (NPFLKA) = 0 * Kinetic energy of the particle (GeV) TKEFLK (NPFLKA) = SQRT ( PBEAM**2 + AM (IONID)**2 ) - AM (IONID) * Particle momentum PMOFLK (NPFLKA) = PBEAM * PMOFLK (NPFLKA) = SQRT ( TKEFLK (NPFLKA) * ( TKEFLK (NPFLKA) * & + TWOTWO * AM (IONID) ) ) * Cosines (tx,ty,tz) TXFLK (NPFLKA) = UBEAM TYFLK (NPFLKA) = VBEAM TZFLK (NPFLKA) = WBEAM * TZFLK (NPFLKA) = SQRT ( ONEONE - TXFLK (NPFLKA)**2 * & - TYFLK (NPFLKA)**2 ) * Polarization cosines: TXPOL (NPFLKA) = -TWOTWO TYPOL (NPFLKA) = +ZERZER TZPOL (NPFLKA) = +ZERZER * Particle coordinates XFLK (NPFLKA) = XBEAM YFLK (NPFLKA) = YBEAM ZFLK (NPFLKA) = ZBEAM * Calculate the total kinetic energy of the primaries: don't change IF ( ILOFLK (NPFLKA) .EQ. -2 .OR. ILOFLK (NPFLKA) .GT. 100000 ) & THEN TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA) ELSE IF ( ILOFLK (NPFLKA) .NE. 0 ) THEN TKESUM = TKESUM + ( TKEFLK (NPFLKA) + AMDISC (ILOFLK(NPFLKA)) ) & * WTFLK (NPFLKA) ELSE TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA) END IF RADDLY (NPFLKA) = ZERZER * Here we ask for the region number of the hitting point. * NREG (NPFLKA) = ... * The following line makes the starting region search much more * robust if particles are starting very close to a boundary: CALL GEOCRS ( TXFLK (NPFLKA), TYFLK (NPFLKA), TZFLK (NPFLKA) ) CALL GEOREG ( XFLK (NPFLKA), YFLK (NPFLKA), ZFLK (NPFLKA), & NRGFLK(NPFLKA), IDISC ) * Do not change these cards: CALL GEOHSM ( NHSPNT (NPFLKA), 1, -11, MLATTC ) NLATTC (NPFLKA) = MLATTC CMPATH (NPFLKA) = ZERZER CALL SOEVSV RETURN *=== End of subroutine Source =========================================* END