SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 1 12-Sep-2006 23:52:08 flutil/source.f 1 *$ CREATE SOURCE.FOR 2 *COPY SOURCE 3 * 4 *=== source ===========================================================* 5 * 6 SUBROUTINE SOURCE ( NOMORE ) 7 8 INCLUDE '(DBLPRC)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 9 INCLUDE '(DIMPAR)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 10 INCLUDE '(IOUNIT)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 11 * 12 *----------------------------------------------------------------------* 13 * * 14 * Copyright (C) 1990-2006 by Alfredo Ferrari & Paola Sala * 15 * All Rights Reserved. * 16 * * 17 * * 18 * New source for FLUKA9x-FLUKA200x: * 19 * * 20 * Created on 07 january 1990 by Alfredo Ferrari & Paola Sala * 21 * Infn - Milan * 22 * * 23 * Last change on 03-mar-06 by Alfredo Ferrari * 24 * * 25 * This is just an example of a possible user written source routine. * 26 * note that the beam card still has some meaning - in the scoring the * 27 * maximum momentum used in deciding the binning is taken from the * 28 * beam momentum. Other beam card parameters are obsolete. * 29 * * 30 *----------------------------------------------------------------------* 31 * 32 INCLUDE '(BEAMCM)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 33 INCLUDE '(FHEAVY)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 34 INCLUDE '(FLKSTK)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 2 12-Sep-2006 23:52:08 flutil/source.f 35 INCLUDE '(IOIOCM)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 36 INCLUDE '(LTCLCM)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 37 INCLUDE '(PAPROP)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 38 INCLUDE '(SOURCM)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 39 INCLUDE '(SUMCOU)' ........................1 (1) Warning: Text libraries (modules) are not supported on this system. 40 * 41 LOGICAL LFIRST 42 * 43 SAVE LFIRST 44 DATA LFIRST / .TRUE. / 45 *======================================================================* 46 * * 47 * BASIC VERSION * 48 * * 49 *======================================================================* 50 NOMORE = 0 51 * +-------------------------------------------------------------------* 52 * | First call initializations: 53 IF ( LFIRST ) THEN 54 * | *** The following 3 cards are mandatory *** 55 TKESUM = ZERZER 56 LFIRST = .FALSE. 57 LUSSRC = .TRUE. 58 * | *** User initialization *** 59 END IF 60 * | 61 * +-------------------------------------------------------------------* 62 * Push one source particle to the stack. Note that you could as well 63 * push many but this way we reserve a maximum amount of space in the 64 * stack for the secondaries to be generated 65 * Npflka is the stack counter: of course any time source is called it 66 * must be =0 67 NPFLKA = NPFLKA + 1 68 * Wt is the weight of the particle 69 WTFLK (NPFLKA) = ONEONE ......1 (1) Severe: Undimensioned array or statement function definition out of order 70 WEIPRI = WEIPRI + WTFLK (NPFLKA) 71 * Particle type (1=proton.....). Ijbeam is the type set by the BEAM 72 * card 73 * +-------------------------------------------------------------------* SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 3 12-Sep-2006 23:52:08 flutil/source.f 74 * | (Radioactive) isotope: 75 IF ( IJBEAM .EQ. -2 .AND. LRDBEA ) THEN 76 IARES = IPROA 77 IZRES = IPROZ 78 IISRES = IPROM 79 CALL STISBM ( IARES, IZRES, IISRES ) 80 IJHION = IPROZ * 1000 + IPROA 81 IJHION = IJHION * 100 + KXHEAV 82 IONID = IJHION 83 CALL DCDION ( IONID ) 84 CALL SETION ( IONID ) 85 * | 86 * +-------------------------------------------------------------------* 87 * | Heavy ion: 88 ELSE IF ( IJBEAM .EQ. -2 ) THEN 89 IJHION = IPROZ * 1000 + IPROA 90 IJHION = IJHION * 100 + KXHEAV 91 IONID = IJHION 92 CALL DCDION ( IONID ) 93 CALL SETION ( IONID ) 94 ILOFLK (NPFLKA) = IJHION .........1 (1) Severe: Undimensioned array or statement function definition out of order 95 * | Flag this is prompt radiation 96 LRADDC (NPFLKA) = .FALSE. .........1 (1) Severe: Undimensioned array or statement function definition out of order 97 * | 98 * +-------------------------------------------------------------------* 99 * | Normal hadron: 100 ELSE 101 IONID = IJBEAM 102 ILOFLK (NPFLKA) = IJBEAM .........1 (1) Severe: Undimensioned array or statement function definition out of order 103 * | Flag this is prompt radiation 104 LRADDC (NPFLKA) = .FALSE. .........1 (1) Severe: Undimensioned array or statement function definition out of order 105 END IF 106 * | 107 * +-------------------------------------------------------------------* 108 * From this point ..... 109 * Particle generation (1 for primaries) 110 LOFLK (NPFLKA) = 1 ......1 (1) Severe: Undimensioned array or statement function definition out of order 111 * User dependent flag: SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 4 12-Sep-2006 23:52:08 flutil/source.f 112 LOUSE (NPFLKA) = 0 ......1 (1) Severe: Undimensioned array or statement function definition out of order 113 * User dependent spare variables: 114 DO 100 ISPR = 1, MKBMX1 115 SPAREK (ISPR,NPFLKA) = ZERZER .........1 (1) Severe: Undimensioned array or statement function definition out of order 116 100 CONTINUE 117 * User dependent spare flags: 118 DO 200 ISPR = 1, MKBMX2 119 ISPARK (ISPR,NPFLKA) = 0 .........1 (1) Severe: Undimensioned array or statement function definition out of order 120 200 CONTINUE 121 * Save the track number of the stack particle: 122 ISPARK (MKBMX2,NPFLKA) = NPFLKA ......1 (1) Severe: Undimensioned array or statement function definition out of order 123 NPARMA = NPARMA + 1 124 NUMPAR (NPFLKA) = NPARMA ......1 (1) Severe: Undimensioned array or statement function definition out of order 125 NEVENT (NPFLKA) = 0 ......1 (1) Severe: Undimensioned array or statement function definition out of order 126 DFNEAR (NPFLKA) = +ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order 127 * ... to this point: don't change anything 128 * Particle age (s) 129 AGESTK (NPFLKA) = +ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order 130 AKNSHR (NPFLKA) = -TWOTWO ......1 (1) Severe: Undimensioned array or statement function definition out of order 131 * Group number for "low" energy neutrons, set to 0 anyway 132 IGROUP (NPFLKA) = 0 ......1 (1) Severe: Undimensioned array or statement function definition out of order 133 * Kinetic energy of the particle (GeV) SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 5 12-Sep-2006 23:52:08 flutil/source.f 134 TKEFLK (NPFLKA) = SQRT ( PBEAM**2 + AM (IONID)**2 ) - AM (IONID) ......1 (1) Severe: Undimensioned array or statement function definition out of order 135 * Particle momentum 136 PMOFLK (NPFLKA) = PBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 137 * PMOFLK (NPFLKA) = SQRT ( TKEFLK (NPFLKA) * ( TKEFLK (NPFLKA) 138 * & + TWOTWO * AM (ILOFLK(NPFLKA)) ) ) 139 * Cosines (tx,ty,tz) 140 TXFLK (NPFLKA) = UBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 141 TYFLK (NPFLKA) = VBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 142 TZFLK (NPFLKA) = WBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 143 * TZFLK (NPFLKA) = SQRT ( ONEONE - TXFLK (NPFLKA)**2 144 * & - TYFLK (NPFLKA)**2 ) 145 * Polarization cosines: 146 TXPOL (NPFLKA) = -TWOTWO ......1 (1) Severe: Undimensioned array or statement function definition out of order 147 TYPOL (NPFLKA) = +ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order 148 TZPOL (NPFLKA) = +ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order 149 * Particle coordinates 150 XFLK (NPFLKA) = XBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 151 YFLK (NPFLKA) = YBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 152 ZFLK (NPFLKA) = ZBEAM ......1 (1) Severe: Undimensioned array or statement function definition out of order 153 * Calculate the total kinetic energy of the primaries: don't change 154 IF ( ILOFLK (NPFLKA) .EQ. -2 .OR. ILOFLK (NPFLKA) .GT. 100000 ) 155 & THEN 156 TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA) 157 ELSE IF ( ILOFLK (NPFLKA) .NE. 0 ) THEN SOURCE 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 6 12-Sep-2006 23:52:08 flutil/source.f 158 TKESUM = TKESUM + ( TKEFLK (NPFLKA) + AMDISC (ILOFLK(NPFLKA)) ) 159 & * WTFLK (NPFLKA) 160 ELSE 161 TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA) 162 END IF 163 RADDLY (NPFLKA) = ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order 164 * Here we ask for the region number of the hitting point. 165 * NREG (NPFLKA) = ... 166 * The following line makes the starting region search much more 167 * robust if particles are starting very close to a boundary: 168 CALL GEOCRS ( TXFLK (NPFLKA), TYFLK (NPFLKA), TZFLK (NPFLKA) ) 169 CALL GEOREG ( XFLK (NPFLKA), YFLK (NPFLKA), ZFLK (NPFLKA), 170 & NRGFLK(NPFLKA), IDISC ) 171 * Do not change these cards: 172 CALL GEOHSM ( NHSPNT (NPFLKA), 1, -11, MLATTC ) 173 NLATTC (NPFLKA) = MLATTC ......1 (1) Severe: Undimensioned array or statement function definition out of order 174 CMPATH (NPFLKA) = ZERZER ......1 (1) Severe: Undimensioned array or statement function definition out of order (1) Severe: Error limit exceeded; compilation terminated 175 CALL SOEVSV 176 RETURN 177 *=== End of subroutine Source =========================================* 178 END 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 7 12-Sep-2006 23:52:08 flutil/source.f 179 +---------------------------------------------------+ | KEY TO ADDRESS CODE FORMATS | | ppp-oooooooo - In Psect ppp, Offset oooooooo | | ***-******** - External | | # - Suffix: Also In Registers | | REG-rrrrrrrr - In Register rrrrrrrr | | REG-######## - In Various Registers | | ** - Not Used; Not Allocated | +---------------------------------------------------+ COMPILER OPTIONS BEING USED no -align commons . no -automatic . no -recursive yes -align records . yes -d_lines . yes -assume accuracy_sensitive . no -extend_source . no -pad_source no -assume backslash . yes -f77 . no -assume byterecl . . no -assume dummy_aliases . no -gen_feedback . no -pg yes -assume source_include . no -ident . yes -assume underscore . no -syntax_only . yes -check bounds . no -vms . yes -OSF no -check format . yes -call_shared . no -check output_conversion . no -S . yes -check overflow . . yes -check power . . no -check flawed_pentium . . no -check underflow . -blas nomapped . no -show code . -error_limit 30 . no -show include . -float ieee_float . -convert native yes -show map . -reentrancy none . yes -show single . -fpe0 . -fprm nearest no -show xref . -G 0 . no -stand mia . -g3 . no -synchronous_exceptions no -stand semantic . -granularity quadword . no -stand source_form . -instruction_set floating_point . no -stand syntax . -integer_size 32 . -real_size 32 -double_size 64 yes -warn alignments . -math_library accurate . no -transform_loops no -warn argument_checking . -names lowercase . no -pipeline no -warn declarations . -O4 . -inline speed -unroll 1 yes -warn general . -terminal nostatistics . -speculate none yes -warn informational . . no -warn truncated_source . -arch error . -tune error yes -warn uncalled . . yes -warn uninitialized . . yes -warn unreachable . . no -warn unused . . yes -warn usage . . -I path : /user7/sujoy/fluka1/flukapro/.f,/user7/sujoy/fluka1/flukapro/.for,/user7/sujoy/fluka1/flukapro/.FOR, /user7/sujoy/fluka1/flukapro/,/usr/include/.f,/usr/include/.for,/usr/include/.FOR,/usr/include/ -V filename : source.l -o filename : flutil/source.o -ana filename : none 20-Sep-2006 17:08:09 DIGITAL Fortran 77 V5.2-171 Page 8 Compilation Statistics 12-Sep-2006 23:52:08 flutil/source.f -diag filename : none -feedback file : none COMPILER: DIGITAL Fortran 77 V5.2-171-428BH COMPILATION STATISTICS CPU time: 0.00 seconds Elapsed time: 0.02 seconds Pagefaults: 0 I/O Count: 1